"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestCase
instanceVariableNames:'testSelector'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
"
No other class instance variables are inherited by this class.
"
!
TestCase comment:'A TestCase is a Command representing the future running of a test case. Create one with the class method #selector: aSymbol, passing the name of the method to be run when the test case runs.
When you discover a new fixture, subclass TestCase, declare instance variables for the objects in the fixture, override #setUp to initialize the variables, and possibly override# tearDown to deallocate any external resources allocated in #setUp.
When you are writing a test case method, send #assert: aBoolean when you want to check for an expected value. For example, you might say "self assert: socket isOpen" to test whether or not a socket is open at a point in a test.'
!
!TestCase class methodsFor:'initialization'!
initialize
ResumableTestFailure autoload
"
self initialize
"
! !
!TestCase class methodsFor:'instance creation'!
debug: aSymbol
^(self selector: aSymbol) debug
!
run: aSymbol
^(self selector: aSymbol) run
!
selector: aSymbol
^self new setTestSelector: aSymbol
!
suite
^self buildSuite
! !
!TestCase class methodsFor:'accessing'!
allTestSelectors
^ (self allSelectors select: [:each | self isTestSelector:each]) asOrderedCollection sort
"Modified: / 06-08-2006 / 11:46:32 / cg"
!
forgetLastTestRunResult
lastTestRunResultOrNil ~~ nil ifTrue:[
lastTestRunResultOrNil := nil.
Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:40:07 / cg"
!
isTestSelector:aSelector
^aSelector ~= #testName
and:[aSelector startsWith: 'test']
"Created: / 06-08-2006 / 11:46:17 / cg"
"Modified: / 19-08-2009 / 14:42:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
lastTestRunResultOrNil
^ lastTestRunResultOrNil
!
rememberFailedTest:selector
lastTestRunsFailedTests isNil ifTrue:[
lastTestRunsFailedTests := Set new.
].
(lastTestRunsFailedTests includes:selector) ifFalse:[
lastTestRunsFailedTests add:selector.
Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
self changed:#lastTestRunResult with:selector.
].
self rememberFailedTestRun
"Modified: / 06-08-2006 / 11:01:08 / cg"
!
rememberFailedTestRun
lastTestRunResultOrNil ~~ false ifTrue:[
lastTestRunResultOrNil := false.
Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:00:42 / cg"
!
rememberFailedTestRunWithResult:result
self rememberFailedTestRun.
self rememberFailedTestsFromResult:result.
"Modified: / 05-08-2006 / 12:45:19 / cg"
!
rememberFailedTestsFromResult:result
(result failures union:result errors) do:[:eachFailedTest |
self rememberFailedTest:(eachFailedTest selector).
].
"Created: / 05-08-2006 / 12:45:01 / cg"
"Modified: / 06-08-2006 / 10:54:31 / cg"
!
rememberPassedTest:selector
lastTestRunsFailedTests notNil ifTrue:[
(lastTestRunsFailedTests includes:selector) ifTrue:[
lastTestRunsFailedTests remove:selector ifAbsent:nil.
Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
self changed:#lastTestRunResult with:selector.
lastTestRunsFailedTests isEmpty ifTrue:[
lastTestRunsFailedTests := nil.
self forgetLastTestRunResult.
].
].
].
"Modified: / 06-08-2006 / 11:40:16 / cg"
!
rememberPassedTestRun
lastTestRunResultOrNil ~~ true ifTrue:[
lastTestRunResultOrNil := true.
lastTestRunsFailedTests := nil.
Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:01:22 / cg"
!
rememberPassedTestsFromResult:result
(result passed) do:[:eachPassedTest |
self rememberPassedTest:(eachPassedTest selector).
].
"Created: / 06-08-2006 / 10:29:47 / cg"
"Modified: / 06-08-2006 / 11:42:01 / cg"
!
resources
^#()
!
sunitVersion
^'3.1'
!
testSelectorFailed:selector
^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
!
testSelectors
"the default here is all methods in a test*-category;
this can, of course, be redefined in a testCase-class, which knows better"
^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort
"Modified: / 24-04-2010 / 14:04:51 / cg"
!
testedClasses
"for the browser and for coverage analysis:
return a collection of classNames, which are tested by this testCase"
^ #()
! !
!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]
!
buildSuiteFromAllSelectors
^self buildSuiteFromMethods: self allTestSelectors
!
buildSuiteFromLocalSelectors
^self buildSuiteFromMethods: self testSelectors
!
buildSuiteFromMethods: testMethods
^testMethods
inject: (self suiteClass named: self name asString)
into: [:suite :selector |
suite
addTest: (self selector: selector);
yourself]
!
buildSuiteFromSelectors
^self shouldInheritSelectors
ifTrue: [self buildSuiteFromAllSelectors]
ifFalse: [self buildSuiteFromLocalSelectors]
!
suiteClass
^TestSuite
! !
!TestCase class methodsFor:'misc ui support'!
iconInBrowserSymbol
<resource: #programImage>
|lastResult|
self theNonMetaclass isAbstract ifTrue:[^ super iconInBrowserSymbol].
lastResult := self lastTestRunResultOrNil.
lastResult == true ifTrue:[
^ #testCasePassedIcon
].
lastResult == false ifTrue:[
^ #testCaseFailedIcon
].
^ #testCaseClassIcon
! !
!TestCase class methodsFor:'quick testing'!
assert: aBoolean
^ self new assert: aBoolean
"
TestCase assert: true
"
!
should: aBlock raise: anError
^ self new should: aBlock raise: anError
"
TestCase should:[ self error ] raise: Error
"
! !
!TestCase class methodsFor:'testing'!
isAbstract
"Override to true if a TestCase subclass is Abstract and should not have
TestCase instances built from it"
^ self == TestCase
!
rememberResult:result
result hasPassed ifTrue:[
self rememberPassedTestRun
] ifFalse:[
self rememberFailedTestRunWithResult:result
].
"Created: / 05-08-2006 / 12:33:08 / cg"
!
runTests
|result|
result := self suite run.
self rememberResult:result.
"Modified: / 05-08-2006 / 12:33:20 / cg"
!
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."
^self superclass isAbstract
or: [self testSelectors isEmpty]
"$QA Ignore:Sends system method(superclass)$"
! !
!TestCase methodsFor:'accessing'!
resources
| allResources resourceQueue |
allResources := Set new.
resourceQueue := OrderedCollection new.
resourceQueue addAll: self class resources.
[resourceQueue isEmpty] whileFalse: [
| next |
next := resourceQueue removeFirst.
allResources add: next.
resourceQueue addAll: next resources].
^allResources
!
selector
^testSelector
! !
!TestCase methodsFor:'accessing & queries'!
unfinished
"indicates an unfinished test"
! !
!TestCase methodsFor:'assertions'!
assert: aBoolean
"fail, if the argument is not true"
<resource: #skipInDebuggersWalkBack>
"/ aBoolean ifFalse: [self signalFailure: 'Assertion failed']
self assert: aBoolean message:'Assertion failed'
!
assert:aBlock completesInSeconds:aNumber
"fail, if aBlock does not finish its work in aNumber seconds"
<resource: #skipInDebuggersWalkBack>
|done process semaphore|
done := false.
semaphore := Semaphore new.
process := [
aBlock value.
done := true.
semaphore signal
] fork.
semaphore waitWithTimeout: aNumber.
process terminate.
self assert: done
"
self new assert:[Delay waitForSeconds:2] completesInSeconds:1
"
"
self new assert:[Delay waitForSeconds:1] completesInSeconds:2
"
!
assert:aBoolean description:aString
<resource: #skipInDebuggersWalkBack>
aBoolean ifFalse:[
self logFailure:aString.
self signalFailure:aString resumable:true
]
"Modified: / 06-08-2006 / 22:56:27 / cg"
!
assert:aBoolean description:aString resumable:resumableBoolean
<resource: #skipInDebuggersWalkBack>
aBoolean ifFalse:[
self logFailure:aString.
self signalFailure:aString resumable:resumableBoolean
]
!
assert: aBoolean message:messageIfFailing
"fail, if the argument is not true"
<resource: #skipInDebuggersWalkBack>
"check the testCase itself"
(aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
aBoolean ifFalse: [self signalFailure: messageIfFailing resumable:true]
"Modified: / 21-06-2000 / 10:00:05 / Sames"
"Modified: / 06-08-2006 / 22:56:21 / cg"
!
assertFalse:aBoolean
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean not
!
assertFalse:aBoolean named:testName
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean not
!
assertTrue:aBoolean
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean
!
assertTrue:aBoolean named:testName
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean
!
deny:aBoolean
"fail, if the argument is not false"
<resource: #skipInDebuggersWalkBack>
self assert:aBoolean not
!
deny: aBoolean description: aString
<resource: #skipInDebuggersWalkBack>
self assert: aBoolean not description: aString
!
deny: aBoolean description: aString resumable: resumableBoolean
<resource: #skipInDebuggersWalkBack>
self
assert: aBoolean not
description: aString
resumable: resumableBoolean
!
should:aBlock
"fail, if the block does not evaluate to true"
<resource: #skipInDebuggersWalkBack>
self assert:aBlock value
!
should: aBlock description: aString
<resource: #skipInDebuggersWalkBack>
self assert: aBlock value description: aString
!
should:aBlock raise:anExceptionalEvent
"fail, if the block does not raise the given event"
<resource: #skipInDebuggersWalkBack>
^ self assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent)
!
should: aBlock raise: anExceptionalEvent description: aString
<resource: #skipInDebuggersWalkBack>
^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
description: aString
!
shouldnt:aBlock
"fail, if the block does evaluate to true"
<resource: #skipInDebuggersWalkBack>
self deny:aBlock value
!
shouldnt: aBlock description: aString
<resource: #skipInDebuggersWalkBack>
self deny: aBlock value description: aString
!
shouldnt:aBlock raise:anExceptionalEvent
"fail, if the block does raise the given event"
<resource: #skipInDebuggersWalkBack>
^ self
assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent) not
!
shouldnt: aBlock raise: anExceptionalEvent description: aString
<resource: #skipInDebuggersWalkBack>
^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not description: aString
! !
!TestCase methodsFor:'dependencies'!
addDependentToHierachy: anObject
"an empty method. for Composite compability with TestSuite"
!
removeDependentFromHierachy: anObject
"an empty method. for Composite compability with TestSuite"
! !
!TestCase methodsFor:'printing'!
name
^ self class name.
!
printOn: aStream
"/ aStream
"/ nextPutAll: self class printString;
"/ nextPutAll: '>>#';
"/ nextPutAll: testSelector
aStream nextPutAll: self name.
aStream nextPutAll: '>>'.
testSelector printOn: aStream
!
testName
^ testSelector.
! !
!TestCase methodsFor:'private'!
executeShould: aBlock inScopeOf: anExceptionalEvent
"/ ^[aBlock value.
"/ false] sunitOn: anExceptionalEvent
"/ do: [:ex | ex sunitExitWith: true]
"/ [[aBlock value]
"/ on: anExceptionalEvent
"/ do: [:ex | ^true]]
"/ on: TestResult exError
"/ do: [:ex | ^false].
aBlock
on: anExceptionalEvent
do: [:ex | ^true].
^false.
!
performTest
self perform: testSelector asSymbol
!
setTestSelector: aSymbol
testSelector := aSymbol
!
signalFailure: aString
"/ TestResult failure sunitSignalWith: aString
TestResult failure raiseErrorString:aString in:thisContext sender sender .
!
signalFailure:aString resumable:isResumable
"/ TestResult failure sunitSignalWith: aString
<resource: #skipInDebuggersWalkBack>
isResumable ifTrue:[
TestResult resumableFailure
raiseRequestWith:nil
errorString:aString
in:thisContext sender sender
] ifFalse:[
TestResult failure
raiseErrorString:aString
in:thisContext sender sender
].
"Modified: / 06-08-2006 / 22:55:55 / cg"
!
signalUnavailableResources
self resources do:[:res |
res isAvailable ifFalse:[
^ res signalInitializationError
]
].
! !
!TestCase methodsFor:'queries'!
isTestCase
^ true
!
isTestSuite
^ false
! !
!TestCase methodsFor:'running'!
debug
"/ self signalUnavailableResources.
"/ [(self class selector: testSelector) runCase]
"/ sunitEnsure: [self resources do: [:each | each reset]]
self debugUsing:#runCase.
!
debugAsFailure
|semaphore|
self signalUnavailableResources.
semaphore := Semaphore new.
[
semaphore wait.
self resources do:[:each |
each reset
]
] fork.
"/ used to be:
"/ (self class selector:testSelector) runCaseAsFailure:semaphore
"/ 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) runCaseAsFailure:semaphore.
self 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
] ensure:[
self resources do:[:each |
each reset
]
]
!
failureLog
^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
!
logFailure: aString
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"
self
"halt;"
performTest
!
run
| result |
result := TestResult new.
self run: result.
^result
!
run: aResult
aResult runCase: self
!
run: aResult afterEachDo:block2
aResult runCase: self.
block2 value:self value:aResult.
!
run: aResult beforeEachDo:block1 afterEachDo:block2
block1 value:self value:aResult.
aResult runCase: self.
block2 value:self value:aResult.
!
run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
block1 value:self value:aResult.
aResult runCase: self.
block2 value:self value:aResult.
!
runCase
[
self setUp.
self performTest
] ensure:[
Error , AbortOperationRequest
handle:[:ex |
ex signal ~~ AbortOperationRequest ifTrue:[
Transcript showCR:'Error during tearDown: "', ex description, '" - ignored'.
]
]
do:[ self tearDown ]
]
!
runCaseAsFailure
self setUp.
[[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
"Modified: / 21.6.2000 / 10:04:33 / Sames"
!
runCaseAsFailure: aSemaphore
[self setUp.
self openDebuggerOnFailingTestMethod] ensure: [
self tearDown.
aSemaphore signal]
!
setUp
!
tearDown
! !
!TestCase class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.56 2010-05-03 15:48:52 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.56 2010-05-03 15:48:52 cg Exp $'
! !
TestCase initialize!