--- a/TestCase.st Fri Jul 11 02:23:44 2014 +0200
+++ b/TestCase.st Tue Nov 18 19:22:22 2014 +0100
@@ -22,7 +22,7 @@
"Flush all remembered outcomes in all testcases"
self withAllSubclassesDo:[:cls|
- cls flushRememberedOutcomes
+ cls flushRememberedOutcomes
]
"Created: / 17-11-2011 / 19:18:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -35,10 +35,10 @@
| outcomes |
lastOutcomes isNil ifTrue:[^self].
- outcomes := lastOutcomes.
+ outcomes := lastOutcomes.
lastOutcomes := nil.
outcomes do:[:outcome|
- self lastTestRunResultChanged: outcome selector.
+ self lastTestRunResultChanged: outcome selector.
]
"Created: / 17-11-2011 / 19:17:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -56,7 +56,7 @@
|pd|
(pd := self projectDefinitionClass) notNil ifTrue:[
- pd loadExtensions
+ pd loadExtensions
]
"Modified: / 02-11-2011 / 15:44:58 / sr"
@@ -72,22 +72,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'!
@@ -97,12 +97,12 @@
answer := Set withAll: self testSelectors.
self shouldInheritSelectors ifTrue:[
- pivotClass := self superclass.
- lookupRoot := self lookupHierarchyRoot.
- [pivotClass == lookupRoot] whileFalse:[
- answer addAll: pivotClass testSelectors.
- pivotClass := pivotClass superclass.
- ]
+ pivotClass := self superclass.
+ lookupRoot := self lookupHierarchyRoot.
+ [pivotClass == lookupRoot] whileFalse:[
+ answer addAll: pivotClass testSelectors.
+ pivotClass := pivotClass superclass.
+ ]
].
^answer asSortedCollection asOrderedCollection
@@ -130,10 +130,10 @@
lastTestRunResultOrNil
"Returns a state (TestResult stateXXX), depending
on the state of the tests:
- statePass if all tests passed,
- stateError if any error,
- stateFail if any fail,
- or nil if never run
+ statePass if all tests passed,
+ stateError if any error,
+ stateFail if any fail,
+ or nil if never run
"
|anyFail|
@@ -143,12 +143,12 @@
anyFail := false.
lastOutcomes do:[:outcome|
- outcome result == (TestResult stateError) ifTrue:[
- ^ TestResult stateError
- ].
- outcome result == (TestResult stateFail) ifTrue:[
- anyFail := true
- ].
+ outcome result == (TestResult stateError) ifTrue:[
+ ^ TestResult stateError
+ ].
+ outcome result == (TestResult stateFail) ifTrue:[
+ anyFail := true
+ ].
].
anyFail ifTrue:[ ^ TestResult stateFail ].
^ TestResult statePass
@@ -157,7 +157,7 @@
!
lookupHierarchyRoot
- ^TestCase
+ ^TestCase
!
rememberOutcome: thisOutcome
@@ -166,24 +166,24 @@
thisTestCase := thisOutcome testCase.
lastOutcomes isNil ifTrue:[
- lastOutcomes := OrderedCollection new.
+ lastOutcomes := OrderedCollection new.
].
"Not a nice code, but portable (what: doWithIndex: is not portable?)"
1 to: lastOutcomes size do:[:i|
- someOtherOutcome := lastOutcomes at: i.
- someOtherTestCase := someOtherOutcome testCase.
- "/ compare by classes name - in case it got redefined
- (someOtherTestCase selector == thisTestCase selector
- and: [someOtherTestCase class name = thisTestCase class name]) ifTrue:[
- "remember; for the timestamp and other info"
- lastOutcomes at: i put: thisOutcome.
- someOtherOutcome result ~= thisOutcome result ifTrue:[
- "but only send out change notification to browser if state has changed"
- self lastTestRunResultChanged: thisOutcome selector.
- ].
- ^self.
- ].
+ someOtherOutcome := lastOutcomes at: i.
+ someOtherTestCase := someOtherOutcome testCase.
+ "/ compare by classes name - in case it got redefined
+ (someOtherTestCase selector == thisTestCase selector
+ and: [someOtherTestCase class name = thisTestCase class name]) ifTrue:[
+ "remember; for the timestamp and other info"
+ lastOutcomes at: i put: thisOutcome.
+ someOtherOutcome result ~= thisOutcome result ifTrue:[
+ "but only send out change notification to browser if state has changed"
+ self lastTestRunResultChanged: thisOutcome selector.
+ ].
+ ^self.
+ ].
].
lastOutcomes add: thisOutcome.
self lastTestRunResultChanged: thisOutcome selector.
@@ -196,16 +196,16 @@
rememberedOutcomeFor: selector
lastOutcomes isNil ifTrue:[^nil].
- ^lastOutcomes
- detect: [:outcome| outcome testCase selector == selector]
- ifNone:[nil].
+ ^lastOutcomes
+ detect: [:outcome| outcome testCase selector == selector]
+ ifNone:[nil].
"Created: / 20-08-2011 / 14:27:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
resources
- ^#()
+ ^#()
!
shouldFork
@@ -216,19 +216,19 @@
!
sunitVersion
- ^'4.0'
+ ^'4.0'
!
testSelector:selector result: result
"return true, if the last run of this test had the outcome result"
lastOutcomes isNil ifTrue:[^false].
- ^ lastOutcomes
- contains:[:any|
- any testCase class name = self name
- and:[any testCase selector == selector
- and:[any result == result]]
- ]
+ ^ lastOutcomes
+ contains:[:any|
+ any testCase class name = self name
+ and:[any testCase selector == selector
+ and:[any result == result]]
+ ]
"Created: / 20-08-2011 / 16:15:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2012 / 16:12:17 / cg"
@@ -269,32 +269,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'!
@@ -308,15 +308,15 @@
lastResult := self lastTestRunResultOrNil.
lastResult notNil ifTrue:[
- lastResult == TestResult statePass ifTrue:[
- ^ #testCasePassedIcon
- ].
- lastResult == TestResult stateFail ifTrue:[
- ^ #testCaseFailedIcon
- ].
- lastResult == TestResult stateError ifTrue:[
- ^ #testCaseErrorIcon
- ].
+ lastResult == TestResult statePass ifTrue:[
+ ^ #testCasePassedIcon
+ ].
+ lastResult == TestResult stateFail ifTrue:[
+ ^ #testCaseFailedIcon
+ ].
+ lastResult == TestResult stateError ifTrue:[
+ ^ #testCaseErrorIcon
+ ].
].
^ #testCaseClassIcon
! !
@@ -328,9 +328,9 @@
"Adds given selector from collection. Answers
true iff selector was really added"
- ^(collection includes: selector)
- ifTrue:[false]
- ifFalse:[collection add: selector. true]
+ (collection includes: selector)
+ 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>"
@@ -345,9 +345,9 @@
!
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:'queries'!
@@ -363,7 +363,7 @@
!
coveredClasses
- "return a collection of classes which are tested by this suite/case.
+ "return a collection of classes which are tested by this suite/case.
These classes can be instrumented for coverage analysis,
before running the suite"
@@ -394,10 +394,10 @@
!TestCase class methodsFor:'testing'!
isAbstract
- "Override to true if a TestCase subclass is Abstract and should not have
- TestCase instances built from it"
+ "Override to true if a TestCase subclass is Abstract and should not have
+ TestCase instances built from it"
- ^self sunitName = #TestCase
+ ^self sunitName = #TestCase
!
isTestCaseLike
@@ -424,23 +424,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
@@ -459,7 +459,7 @@
| method |
method := self class lookupMethodFor: testSelector.
method annotationsAt:#ignore orAt: #skip do:[:annotation|
- ^true
+ ^true
].
^false
@@ -477,7 +477,7 @@
unfinished
- "indicates an unfinished test"
+ "indicates an unfinished test"
! !
!TestCase methodsFor:'assertions'!
@@ -492,9 +492,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.
@@ -543,33 +543,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'!
@@ -582,13 +582,13 @@
!
name
- ^ self class name.
+ ^ self class name.
!
printOn: aStream
- self class printOn:aStream.
- aStream nextPutAll: '>>#'.
- testSelector printOn:aStream.
+ self class printOn:aStream.
+ aStream nextPutAll: '>>#'.
+ testSelector printOn:aStream.
! !
!TestCase methodsFor:'private'!
@@ -603,11 +603,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
@@ -623,7 +623,7 @@
!
setTestSelector: aSymbol
- testSelector := aSymbol
+ testSelector := aSymbol
!
signalFailure:aString resumable:isResumable
@@ -632,14 +632,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"
@@ -648,9 +648,9 @@
signalUnavailableResources
self resources do:[:res |
- res isAvailable ifFalse:[
- ^ res signalInitializationError
- ]
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
].
! !
@@ -677,45 +677,45 @@
| testCase outcome result wasProceeded|
[
- result := TestResult stateError.
- wasProceeded := false.
+ result := TestResult stateError.
+ wasProceeded := false.
- [
- (testCase := self class selector: testSelector) runCase.
- wasProceeded ifFalse:[
- result := TestResult statePass.
- ]
- ] sunitOn:(TestResult failure) do: [:ex |
- ex creator == TestSkipped ifTrue:[
- result := TestResult stateSkip.
- ] ifFalse:[
- result := TestResult stateFail.
- ].
- "I want a debugger to open here..."
- "the only really portable dialect query..."
- ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
- "/ debug
- Debugger
- enter:ex raiseContext
- withMessage:(ex description)
- mayProceed:true.
- wasProceeded := true.
- ex proceed.
- ] ifFalse:[
- "is there a portable way to open a debugger?"
- self halt:(ex description).
- wasProceeded := true.
- ].
- ].
+ [
+ (testCase := self class selector: testSelector) runCase.
+ wasProceeded ifFalse:[
+ result := TestResult statePass.
+ ]
+ ] sunitOn:(TestResult failure) do: [:ex |
+ ex creator == TestSkipped ifTrue:[
+ result := TestResult stateSkip.
+ ] ifFalse:[
+ result := TestResult stateFail.
+ ].
+ "I want a debugger to open here..."
+ "the only really portable dialect query..."
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
+ "/ debug
+ Debugger
+ enter:ex raiseContext
+ withMessage:(ex description)
+ mayProceed:true.
+ wasProceeded := true.
+ ex proceed.
+ ] ifFalse:[
+ "is there a portable way to open a debugger?"
+ self halt:(ex description).
+ wasProceeded := true.
+ ].
+ ].
] sunitEnsure: [
- " if proceeded in the debugger, we arrive here; "
- " but still, this is not always a pass !! "
- outcome := TestCaseOutcome new.
- outcome testCase: testCase.
- outcome result: result.
- outcome remember.
- TestResource resetResources: self resources
+ " if proceeded in the debugger, we arrive here; "
+ " but still, this is not always a pass !! "
+ outcome := TestCaseOutcome new.
+ outcome testCase: testCase.
+ outcome result: result.
+ outcome remember.
+ TestResource resetResources: self resources
].
"Modified: / 07-07-2011 / 11:10:50 / jv"
@@ -724,65 +724,65 @@
!
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 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 perform:aSymbol
] ensure:[
- self resources do:[:each |
- each reset
- ]
+ self resources do:[:each |
+ each reset
+ ]
]
!
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]
!
logSkipped: 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>"
!
@@ -817,11 +817,11 @@
run: result beforeEachDo: before afterEachDo: after resetResources: reset
^ self
- run: result
- beforeEachDo: before
- afterEachDo: after
- resetResources: reset
- debug: false
+ run: result
+ beforeEachDo: before
+ afterEachDo: after
+ resetResources: reset
+ debug: false
"Created: / 29-07-2011 / 12:04:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-08-2011 / 17:45:17 / cg"
@@ -836,37 +836,37 @@
"This code is ugly in Smalltalk/X but it is so because
it is more portable - numArgs in ANSI (?)"
before numArgs == 2 ifTrue:[
- before value: self value: result
+ before value: self value: result
] ifFalse:[
- before numArgs == 1 ifTrue:[
- before value: self
- ] ifFalse:[
- before value.
- ]
+ before numArgs == 1 ifTrue:[
+ before value: self
+ ] ifFalse:[
+ before value.
+ ]
].
"2. Run the testcase"
reset ifTrue:[
- [
- result runCase: self debugged:doDebug
- ] sunitEnsure: [
- TestResource resetResources: self resources
- ].
+ [
+ result runCase: self debugged:doDebug
+ ] sunitEnsure: [
+ TestResource resetResources: self resources
+ ].
] ifFalse:[
- result runCase: self debugged:doDebug
+ result runCase: self debugged:doDebug
].
"3. Execute after block"
"This code is ugly in Smalltalk/X but it is so because
it is more portable - numArgs in ANSI (?)"
after numArgs == 2 ifTrue:[
- after value: self value: result
+ after value: self value: result
] ifFalse:[
- after numArgs == 1 ifTrue:[
- after value: self
- ] ifFalse:[
- after value.
- ]
+ after numArgs == 1 ifTrue:[
+ after value: self
+ ] ifFalse:[
+ after value.
+ ]
].
^result
@@ -890,12 +890,12 @@
self resources do: [:each | each availableFor: self].
[
- didSetup := false.
- self setUp.
- didSetup := true.
- self performTest.
+ didSetup := false.
+ self setUp.
+ didSetup := true.
+ self performTest.
] sunitEnsure: [
- didSetup ifTrue:[ self safeTearDown ]
+ didSetup ifTrue:[ self safeTearDown ]
]
"Modified (comment): / 18-08-2011 / 20:35:20 / cg"
@@ -904,7 +904,7 @@
runCaseAsFailure
self setUp.
[
- [self openDebuggerOnFailingTestMethod] ensure: [self safeTearDown]
+ [self openDebuggerOnFailingTestMethod] ensure: [self safeTearDown]
] fork
"Modified: / 21.6.2000 / 10:04:33 / Sames"
@@ -912,17 +912,17 @@
runCaseAsFailure: aSemaphore
[
- |didSetup|
+ |didSetup|
- didSetup := false.
- self resources do: [:each | each availableFor: self].
- [
- self setUp.
- didSetup := true.
- self openDebuggerOnFailingTestMethod
- ] sunitEnsure: [
- didSetup ifTrue:[ self tearDown ]
- ]
+ didSetup := false.
+ self resources do: [:each | each availableFor: self].
+ [
+ self setUp.
+ didSetup := true.
+ self openDebuggerOnFailingTestMethod
+ ] sunitEnsure: [
+ didSetup ifTrue:[ self tearDown ]
+ ]
] sunitEnsure: [aSemaphore signal].
!
@@ -937,15 +937,15 @@
!TestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.104 2014-03-21 17:23:32 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.105 2014-11-18 18:22:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.104 2014-03-21 17:23:32 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.105 2014-11-18 18:22:22 cg Exp $'
!
version_SVN
- ^ '$Id: TestCase.st,v 1.104 2014-03-21 17:23:32 stefan Exp $'
+ ^ '$Id: TestCase.st,v 1.105 2014-11-18 18:22:22 cg Exp $'
! !