"{ Package: '__NoProject__' }"
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:'documentation'!
documentation
"
the concept of a prep, is to provide an opportunity to set up some UnitTestCase parameters
before the fixture is setUp, there is a #defaultPrep, or a #prepFor_<eachTest>
[author:]
Keith Hodges (kh@cuthbert)
[see also:]
[instance variables:]
[class variables:]
"
!
examples
"
examples to be added.
[exBegin]
... add code fragment for
... executable example here ...
[exEnd]
"
!
history
"Created: / 9.7.1999 / 17:28:21 / kh"
! !
!TestCase class methodsFor:'instance creation'!
selector: aSymbol
^self new setTestSelector: aSymbol
! !
!TestCase class methodsFor:'running'!
allSelectorsPrefixed: string
| selectors |
selectors := OrderedCollection new.
"/self superclasses do: [ :class | selectors addAll: (class selectors select: [ :selector | selector startsWith: string ]) ].
selectors addAll: (self selectors select: [ :selector | selector startsWith: string ]).
^selectors
!
allTestCases
^(self allSelectorsPrefixed: 'test') collect: [ :selector | self selector: selector ].
!
runAllUnitTests
| test |
test := TestSuite named: (self name).
test addTestCases: self allTestCases.
^test run
"
self run.
Transcript showCR: self runAll.
"
! !
!TestCase methodsFor:'assertions'!
assert: aBoolean
"fail, if the argument is not true"
"/ aBoolean ifFalse: [self signalFailure: 'Assertion failed']
self assert: aBoolean message:'Assertion failed'
!
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)
!
shouldnt:aBlock
"fail, if the block does evaluate to true"
self deny:aBlock value
! !
!TestCase methodsFor:'printing'!
printOn: aStream
"/ aStream
"/ nextPutAll: self class printString;
"/ nextPutAll: '>>#';
"/ nextPutAll: testSelector
aStream nextPutAll: self name.
aStream nextPutAll: '>>'.
testSelector printOn: aStream
! !
!TestCase methodsFor:'private'!
errorException
^self class errorSignal
!
performTest
self perform: testSelector asSymbol
!
setSelector: aSymbol
selector := aSymbol
! !
!TestCase methodsFor:'running'!
defaultPrep
"prep methods are called before UnitTestCase-#setUp
this is the default prep method if there
is none defined for a unit test"
!
prepTest
| prepSelector |
prepSelector := ('prepFor_', selector) asSymbol.
(self respondsTo: prepSelector) ifTrue: [ self perform: prepSelector ]
ifFalse: [ self defaultPrep ].
!
run
| result |
result := TestResult new.
self run: result.
^result
!
run: aResult
aResult runCase: self
!
setUp
!
tearDown
! !
!TestCase methodsFor:'set up'!
onSetUpFailed
"Run whatever code you need to tidy up if the Setup procedure fails"
! !
!TestCase class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.43 2006-08-31 09:23:04 boris Exp $'
! !
TestCase initialize!