"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestCase
instanceVariableNames:'testSelector'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
!TestCase class methodsFor:'initialization'!
initialize
"ensure, that the sunit extensions are loaded"
(Class implements:#sunitName) ifFalse:[
Smalltalk fileIn:'extensions.st' inPackage:(self package)
].
TestFailure isLoaded ifFalse:[
TestFailure autoload
].
"
self initialize
"
! !
!TestCase class methodsFor:'Accessing'!
allTestSelectors
^self sunitAllSelectors select: [:each | 'test*' match: each]
!
resources
^#()
!
testSelectors
^self sunitSelectors select: [:each | 'test*' match: each]
! !
!TestCase class methodsFor:'Building Suites'!
buildSuite
| suite |
^self isAbstract
ifTrue:
[suite := TestSuite new.
suite name: 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: ((TestSuite new)
name: self name asString;
yourself)
into:
[:suite :selector |
suite
addTest: (self selector: selector);
yourself]
!
buildSuiteFromSelectors
^self shouldInheritSelectors
ifTrue: [self buildSuiteFromAllSelectors]
ifFalse: [self buildSuiteFromLocalSelectors]
! !
!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
| testSelectors result |
testSelectors := self sunitSelectors select: [:each | 'test*' match: each].
testSelectors sort.
result := TestSuite new.
result name:self name.
testSelectors do: [:each | result addTest: (self selector: each)].
^result
"Modified: / 21.6.2000 / 10:05:24 / Sames"
! !
!TestCase class methodsFor:'Testing'!
isAbstract
"Override to true if a TestCase subclass is Abstract and should not have
TestCase instances built from it"
^self name = #TestCase.
!
shouldInheritSelectors
"answer true to inherit selectors from superclasses"
^true
! !
!TestCase methodsFor:'Accessing'!
assert: aBoolean
"fail, if the argument is not true"
"check the testCase itself"
(aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
aBoolean ifFalse: [self signalFailure: 'Assertion failed']
"Modified: / 21.6.2000 / 10:00:05 / Sames"
!
assertFalse:aBoolean
^ self assert:aBoolean not
!
assertFalse:aBoolean named:testName
^ self assert:aBoolean not
!
assertTrue:aBoolean
^ self assert:aBoolean
!
assertTrue:aBoolean named:testName
^ self assert:aBoolean
!
deny: aBoolean
"fail, if the argument is not false"
self assert: aBoolean not
!
resources
^self class resources
!
selector
^testSelector
!
should: aBlock
"fail, if the block does not evaluate to true"
self assert: aBlock value
!
should: aBlock raise: anExceptionalEvent
"fail, if the block does not raise the given event"
^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
"Modified: / 21.6.2000 / 10:01:08 / Sames"
!
shouldnt: aBlock
"fail, if the block does evaluate to true"
self deny: aBlock value
!
shouldnt: aBlock raise: anExceptionalEvent
"fail, if the block does raise the given event"
^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
"Modified: / 21.6.2000 / 10:01:16 / Sames"
!
signalFailure: aString
"/ TestResult failure sunitSignalWith: aString
TestResult failure raiseErrorString:aString in:thisContext sender sender .
"Modified: / 21.6.2000 / 10:01:34 / Sames"
! !
!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 name.
aStream nextPutAll: '>>'.
aStream nextPutAll: testSelector
"Modified: / 4.4.2000 / 18:59:53 / Sames"
! !
!TestCase methodsFor:'Private'!
executeShould: aBlock inScopeOf: anExceptionalEvent
[[aBlock value]
on: anExceptionalEvent
do: [:ex | ^true]]
on: TestResult error
do: [:ex | ^false].
^false.
"Modified: / 21.6.2000 / 10:03:03 / Sames"
!
performTest
self perform: testSelector asSymbol
!
setTestSelector: aSymbol
testSelector := aSymbol
! !
!TestCase methodsFor:'Running'!
debug
self debugUsing:#runCase.
"/ (self class selector: testSelector) runCase
!
debugAsFailure
self debugUsing: #runCaseAsFailure
"/ (self class selector: testSelector) runCaseAsFailure
!
debugUsing: aSymbol
self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
[(self class selector: testSelector) perform: aSymbol] ensure: [self resources do: [:each | each reset]]
!
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.
self perform: testSelector asSymbol
"Modified: / 21.6.2000 / 10:03:37 / Sames"
!
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.
!
runCase
self setUp.
[self performTest "self perform: testSelector asSymbol"] ensure: [self tearDown]
"Modified: / 21.6.2000 / 10:04:18 / Sames"
!
runCaseAsFailure
self setUp.
[[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
"Modified: / 21.6.2000 / 10:04:33 / Sames"
!
setUp
!
tearDown
! !
!TestCase methodsFor:'Testing'!
areAllResourcesAvailable
^self resources
inject: true
into: [:total :each | each isAvailable & total]
! !
!TestCase class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.18 2001-12-21 15:46:31 cg Exp $'
! !
TestCase initialize!