--- a/TestCase.st Wed Aug 10 00:08:34 2011 +0200
+++ b/TestCase.st Wed Aug 10 00:09:25 2011 +0200
@@ -1,14 +1,14 @@
"{ Package: 'stx:goodies/sunit' }"
TestAsserter subclass:#TestCase
- instanceVariableNames:'testSelector'
- classVariableNames:''
- poolDictionaries:''
- category:'SUnit-Base'
+ instanceVariableNames:'testSelector'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Base'
!
TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsPassedTests lastTestRunsFailedTests
- lastTestRunsErrorTests'
+ lastTestRunsErrorTests'
"
No other class instance variables are inherited by this class.
@@ -40,22 +40,22 @@
debug: aSymbol
- ^(self selector: aSymbol) debug
+ ^(self selector: aSymbol) debug
!
run: aSymbol
- ^(self selector: aSymbol) run
+ ^(self selector: aSymbol) run
!
selector: aSymbol
- ^self new setTestSelector: aSymbol
+ ^self new setTestSelector: aSymbol
!
suite
- ^self buildSuite
+ ^self buildSuite
! !
!TestCase class methodsFor:'accessing'!
@@ -77,9 +77,9 @@
forgetLastTestRunResult
lastTestRunResultOrNil ~~ nil ifTrue:[
- lastTestRunResultOrNil := nil.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := nil.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:40:07 / cg"
@@ -99,11 +99,11 @@
| result |
result := TestResult new.
lastTestRunsPassedTests ? #() do:
- [:selector|result passed add: (self selector: selector)].
+ [:selector|result passed add: (self selector: selector)].
lastTestRunsFailedTests ? #() do:
- [:selector|result failures add: (self selector: selector)].
+ [:selector|result failures add: (self selector: selector)].
lastTestRunsErrorTests ? #() do:
- [:selector|result errors add: (self selector: selector)].
+ [:selector|result errors add: (self selector: selector)].
"Created: / 15-03-2010 / 19:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -113,7 +113,7 @@
!
lookupHierarchyRoot
- ^TestCase
+ ^TestCase
!
rememberErrorTest:selector
@@ -121,7 +121,7 @@
| emitChange |
lastTestRunsErrorTests isNil ifTrue:[
- lastTestRunsErrorTests := Set new.
+ lastTestRunsErrorTests := Set new.
].
emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
@@ -141,7 +141,7 @@
| emitChange |
lastTestRunsFailedTests isNil ifTrue:[
- lastTestRunsFailedTests := Set new.
+ lastTestRunsFailedTests := Set new.
].
emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
@@ -158,9 +158,9 @@
rememberFailedTestRun
lastTestRunResultOrNil ~~ false ifTrue:[
- lastTestRunResultOrNil := false.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := false.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:00:42 / cg"
@@ -175,7 +175,7 @@
rememberFailedTestsFromResult:result
(result failures union:result errors) do:[:eachFailedTest |
- self rememberFailedTest:(eachFailedTest selector).
+ self rememberFailedTest:(eachFailedTest selector).
].
"Created: / 05-08-2006 / 12:45:01 / cg"
@@ -187,7 +187,7 @@
| emitChange |
lastTestRunsPassedTests isNil ifTrue:[
- lastTestRunsPassedTests := Set new.
+ lastTestRunsPassedTests := Set new.
].
emitChange := (self removeSelector: selector from: lastTestRunsFailedTests).
@@ -204,10 +204,10 @@
rememberPassedTestRun
lastTestRunResultOrNil ~~ true ifTrue:[
- lastTestRunResultOrNil := true.
- "/lastTestRunsFailedTests := nil.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := true.
+ "/lastTestRunsFailedTests := nil.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:01:22 / cg"
@@ -216,7 +216,7 @@
rememberPassedTestsFromResult:result
(result passed) do:[:eachPassedTest |
- self rememberPassedTest:(eachPassedTest selector).
+ self rememberPassedTest:(eachPassedTest selector).
].
"Created: / 06-08-2006 / 10:29:47 / cg"
@@ -225,7 +225,7 @@
resources
- ^#()
+ ^#()
!
shouldFork
@@ -236,7 +236,7 @@
!
sunitVersion
- ^'4.0'
+ ^'4.0'
!
testSelectorError:selector
@@ -261,32 +261,32 @@
!TestCase class methodsFor:'building suites'!
buildSuite
- | suite |
- ^self isAbstract
- ifTrue:
- [suite := self suiteClass named: self name asString.
- self allSubclasses
- do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
- suite]
- ifFalse: [self buildSuiteFromSelectors]
+ | suite |
+ ^self isAbstract
+ ifTrue:
+ [suite := self suiteClass named: self name asString.
+ self allSubclasses
+ do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
+ suite]
+ ifFalse: [self buildSuiteFromSelectors]
!
buildSuiteFromMethods: testMethods
- ^testMethods
- inject: (self suiteClass named: self name asString)
- into: [:suite :selector |
- suite
- addTest: (self selector: selector);
- yourself]
+ ^testMethods
+ inject: (self suiteClass named: self name asString)
+ into: [:suite :selector |
+ suite
+ addTest: (self selector: selector);
+ yourself]
!
buildSuiteFromSelectors
- ^self buildSuiteFromMethods: self allTestSelectors
+ ^self buildSuiteFromMethods: self allTestSelectors
!
suiteClass
- ^TestSuite
+ ^TestSuite
! !
!TestCase class methodsFor:'misc ui support'!
@@ -300,10 +300,10 @@
lastResult := self lastTestRunResultOrNil.
lastResult == true ifTrue:[
- ^ #testCasePassedIcon
+ ^ #testCasePassedIcon
].
lastResult == false ifTrue:[
- ^ #testCaseFailedIcon
+ ^ #testCaseFailedIcon
].
^ #testCaseClassIcon
! !
@@ -316,8 +316,8 @@
true iff selector was really added"
^(collection includes: selector)
- ifTrue:[false]
- ifFalse:[collection add: selector. true]
+ ifTrue:[false]
+ ifFalse:[collection add: selector. true]
"Created: / 15-03-2010 / 18:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-04-2010 / 23:19:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -338,16 +338,16 @@
collection ifNil:[^false]." trivial case "
^(collection includes: selector)
- ifTrue:[collection remove: selector. true]
- ifFalse:[false]
+ ifTrue:[collection remove: selector. true]
+ ifFalse:[false]
"Created: / 15-03-2010 / 18:05:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testSelectors
- "The API method is allTestSelectors which now includes #shouldInheritSelectors and so handles all cases. Unlike that method, this does not guarantee to return a sorted ordered collection."
+ "The API method is allTestSelectors which now includes #shouldInheritSelectors and so handles all cases. Unlike that method, this does not guarantee to return a sorted ordered collection."
- ^self sunitSelectors select: [:each | 'test*' sunitMatch: each]
+ ^self sunitSelectors select: [:each | 'test*' sunitMatch: each]
! !
!TestCase class methodsFor:'quick testing'!
@@ -386,9 +386,9 @@
rememberResult:result
result hasPassed ifTrue:[
- self rememberPassedTestRun
+ self rememberPassedTestRun
] ifFalse:[
- self rememberFailedTestRunWithResult:result
+ self rememberFailedTestRunWithResult:result
].
"Created: / 05-08-2006 / 12:33:08 / cg"
@@ -405,23 +405,23 @@
!
shouldInheritSelectors
- "I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass. If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."
+ "I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass. If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."
- ^self ~~ self lookupHierarchyRoot
- and: [self superclass isAbstract
- or: [self testSelectors isEmpty]]
+ ^self ~~ self lookupHierarchyRoot
+ and: [self superclass isAbstract
+ or: [self testSelectors isEmpty]]
! !
!TestCase methodsFor:'accessing'!
resources
- "We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical. Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought. If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate."
+ "We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical. Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought. If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate."
- ^self class resources
+ ^self class resources
!
selector
- ^testSelector
+ ^testSelector
!
shouldFork
@@ -442,7 +442,7 @@
unfinished
- "indicates an unfinished test"
+ "indicates an unfinished test"
! !
!TestCase methodsFor:'assertions'!
@@ -457,9 +457,9 @@
done := false.
semaphore := Semaphore new.
process := [
- aBlock value.
- done := true.
- semaphore signal
+ aBlock value.
+ done := true.
+ semaphore signal
] fork.
semaphore waitWithTimeout: aNumber.
process terminate.
@@ -507,33 +507,33 @@
!TestCase methodsFor:'dependencies'!
addDependentToHierachy: anObject
- "an empty method. for Composite compability with TestSuite"
+ "an empty method. for Composite compability with TestSuite"
!
removeDependentFromHierachy: anObject
- "an empty method. for Composite compability with TestSuite"
+ "an empty method. for Composite compability with TestSuite"
! !
!TestCase methodsFor:'deprecated'!
should: aBlock
- self assert: aBlock value
+ self assert: aBlock value
!
should: aBlock description: aString
- self assert: aBlock value description: aString
+ self assert: aBlock value description: aString
!
shouldnt: aBlock
- self deny: aBlock value
+ self deny: aBlock value
!
shouldnt: aBlock description: aString
- self deny: aBlock value description: aString
+ self deny: aBlock value description: aString
!
signalFailure: aString
- TestResult failure sunitSignalWith: aString.
+ TestResult failure sunitSignalWith: aString.
! !
!TestCase methodsFor:'printing'!
@@ -546,15 +546,15 @@
!
name
- ^ self class name.
+ ^ self class name.
!
printOn: aStream
- aStream
- nextPutAll: self class printString;
- nextPutAll: '>>#';
- nextPutAll: testSelector
+ aStream
+ nextPutAll: self class printString;
+ nextPutAll: '>>#';
+ nextPutAll: testSelector
! !
!TestCase methodsFor:'private'!
@@ -569,11 +569,11 @@
"/ do: [:ex | ^true]]
"/ on: TestResult exError
"/ do: [:ex | ^false].
- [aBlock value]
- on: anExceptionalEvent
- do: [:ex | ^true].
+ [aBlock value]
+ on: anExceptionalEvent
+ do: [:ex | ^true].
- ^false.
+ ^false.
!
performTest
@@ -581,7 +581,7 @@
!
setTestSelector: aSymbol
- testSelector := aSymbol
+ testSelector := aSymbol
!
signalFailure:aString resumable:isResumable
@@ -590,14 +590,14 @@
<resource: #skipInDebuggersWalkBack>
isResumable ifTrue:[
- TestResult resumableFailure
- raiseRequestWith:nil
- errorString:aString
- in:thisContext sender sender
+ TestResult resumableFailure
+ raiseRequestWith:nil
+ errorString:aString
+ in:thisContext sender sender
] ifFalse:[
- TestResult failure
- raiseErrorString:aString
- in:thisContext sender sender
+ TestResult failure
+ raiseErrorString:aString
+ in:thisContext sender sender
].
"Modified: / 06-08-2006 / 22:55:55 / cg"
@@ -606,9 +606,9 @@
signalUnavailableResources
self resources do:[:res |
- res isAvailable ifFalse:[
- ^ res signalInitializationError
- ]
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
].
! !
@@ -643,28 +643,28 @@
!
debugAsFailure
- | semaphore |
- semaphore := Semaphore new.
- [semaphore wait. TestResource resetResources: self resources] fork.
- (self class selector: testSelector) runCaseAsFailure: semaphore.
+ | semaphore |
+ semaphore := Semaphore new.
+ [semaphore wait. TestResource resetResources: self resources] fork.
+ (self class selector: testSelector) runCaseAsFailure: semaphore.
!
debugUsing:aSymbol
self signalUnavailableResources.
[
- "/ used to be:
- "/ (self class selector:testSelector) perform:aSymbol
- "/ which is bad for subclasses which need more arguments.
- "/ why not use:
- "/ self copy perform:aSymbol
- "/ or even
- "/ self perform:aSymbol
- "/ (self class selector:testSelector) perform:aSymbol
- self perform:aSymbol
+ "/ used to be:
+ "/ (self class selector:testSelector) perform:aSymbol
+ "/ which is bad for subclasses which need more arguments.
+ "/ why not use:
+ "/ self copy perform:aSymbol
+ "/ or even
+ "/ self perform:aSymbol
+ "/ (self class selector:testSelector) perform:aSymbol
+ self perform:aSymbol
] ensure:[
- self resources do:[:each |
- each reset
- ]
+ self resources do:[:each |
+ each reset
+ ]
]
@@ -678,32 +678,32 @@
!
failureLog
- ^SUnitNameResolver class >> #defaultLogDevice
+ ^SUnitNameResolver class >> #defaultLogDevice
!
isLogging
- "By default, we're not logging failures. If you override this in
- a subclass, make sure that you override #failureLog"
- ^false
+ "By default, we're not logging failures. If you override this in
+ a subclass, make sure that you override #failureLog"
+ ^false
!
logFailure: aString
- self isLogging ifTrue: [
- self failureLog
- cr;
- nextPutAll: aString;
- flush]
+ self isLogging ifTrue: [
+ self failureLog
+ cr;
+ nextPutAll: aString;
+ flush]
!
openDebuggerOnFailingTestMethod
- "SUnit has halted one step in front of the failing test method. Step over the 'self halt' and
- send into 'self perform: testSelector' to see the failure from the beginning"
+ "SUnit has halted one step in front of the failing test method. Step over the 'self halt' and
+ send into 'self perform: testSelector' to see the failure from the beginning"
- self
- "/halt;
- performTest
+ self
+ "/halt;
+ performTest
"Modified: / 05-12-2009 / 18:40:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -815,18 +815,18 @@
!
runCaseAsFailure
- self setUp.
- [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
+ self setUp.
+ [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
"Modified: / 21.6.2000 / 10:04:33 / Sames"
!
runCaseAsFailure: aSemaphore
- [self resources do: [:each | each availableFor: self].
- [self setUp.
- self openDebuggerOnFailingTestMethod]
- sunitEnsure: [self tearDown]]
- sunitEnsure: [aSemaphore signal].
+ [self resources do: [:each | each availableFor: self].
+ [self setUp.
+ self openDebuggerOnFailingTestMethod]
+ sunitEnsure: [self tearDown]]
+ sunitEnsure: [aSemaphore signal].
!
setUp
@@ -859,11 +859,11 @@
!TestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.73 2011-08-09 21:56:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.74 2011-08-09 22:09:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.73 2011-08-09 21:56:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.74 2011-08-09 22:09:25 cg Exp $'
!
version_SVN