Smalltalk current createPackage: 'SUnit' properties: #{}!
Object subclass: #ResultAnnouncement
instanceVariableNames: 'result'
package: 'SUnit'!
!ResultAnnouncement methodsFor: 'accessing'!
result
^result
!
result: aTestResult
result := aTestResult
! !
Object subclass: #TestCase
instanceVariableNames: 'testSelector asyncTimeout context'
package: 'SUnit'!
!TestCase commentStamp!
A TestCase is an implementation of the command pattern to run a test.
`TestCase` instances are created with the class method `#selector:`,
passing the symbol that names the method to be executed when the test case runs.
When you discover a new fixture, subclass `TestCase` and create a `#test...` method for the first test.
As that method develops and more `#test...` methods are added, you will find yourself refactoring temps
into instance variables for the objects in the fixture and overriding `#setUp` to initialize these variables.
As required, override `#tearDown` to nil references, release objects and deallocate.!
!TestCase methodsFor: 'accessing'!
context: aRunningTestContext
context := aRunningTestContext
!
selector
^testSelector
!
setTestSelector: aSelector
testSelector := aSelector
! !
!TestCase methodsFor: 'async'!
async: aBlock
| c |
self errorIfNotAsync: '#async'.
c := context.
^ [ self isAsync ifTrue: [ c execute: aBlock ] ]
!
finished
self errorIfNotAsync: '#finished'.
asyncTimeout := nil
!
timeout: aNumber
"Set a grace time timeout in milliseconds to run the test asynchronously"
asyncTimeout ifNotNil: [ asyncTimeout clearTimeout ].
"to allow #async: message send without throwing an error"
asyncTimeout := 0.
asyncTimeout := (self async: [
self assert: false description: 'SUnit grace time exhausted' ])
valueWithTimeout: aNumber
! !
!TestCase methodsFor: 'error handling'!
errorIfNotAsync: aString
self isAsync ifFalse: [
self error: aString, ' used without prior #timeout:' ]
! !
!TestCase methodsFor: 'private'!
signalFailure: aString
TestFailure new
messageText: aString;
signal
! !
!TestCase methodsFor: 'running'!
performTest
asyncTimeout := nil.
self perform: self selector
!
runCase
"Runs a test case in isolated context, leaking all errors."
(TestContext testCase: self) start
!
setUp
!
tearDown
! !
!TestCase methodsFor: 'testing'!
assert: aBoolean
self assert: aBoolean description: 'Assertion failed'
!
assert: aBoolean description: aString
aBoolean ifFalse: [self signalFailure: aString]
!
assert: actual equals: expected
^ self assert: (actual = expected) description: 'Expected: ', expected asString, ' but was: ', actual asString
!
deny: aBoolean
self assert: aBoolean not
!
isAsync
^asyncTimeout notNil
!
should: aBlock
self assert: aBlock value
!
should: aBlock raise: anExceptionClass
self assert: ([aBlock value. false]
on: anExceptionClass
do: [:ex | true])
!
shouldnt: aBlock raise: anExceptionClass
self assert: ([aBlock value. true]
on: anExceptionClass
do: [:ex | false])
! !
!TestCase class methodsFor: 'accessing'!
allTestSelectors
| selectors |
selectors := self testSelectors.
self shouldInheritSelectors ifTrue: [
selectors addAll: self superclass allTestSelectors].
^selectors
!
buildSuite
^self allTestSelectors collect: [:each | self selector: each]
!
lookupHierarchyRoot
^TestCase
!
selector: aSelector
^self new
setTestSelector: aSelector;
yourself
!
testSelectors
^self methodDictionary keys select: [:each | each match: '^test']
! !
!TestCase class methodsFor: 'testing'!
isAbstract
^ self name = 'TestCase'
!
shouldInheritSelectors
^self ~= self lookupHierarchyRoot
! !
Object subclass: #TestContext
instanceVariableNames: 'testCase'
package: 'SUnit'!
!TestContext commentStamp!
TestContext governs running a particular test case.
It's main added value is `#execute:` method which runs a block
as a part of test case (restores context, nilling it afterwards,
cleaning/calling tearDown as appropriate for sync/async scenario).!
!TestContext methodsFor: 'accessing'!
testCase: aTestCase
testCase := aTestCase
! !
!TestContext methodsFor: 'running'!
execute: aBlock
| failed |
testCase context: self.
[
failed := true.
aBlock value.
failed := false
]
ensure: [
testCase context: nil.
(failed and: [ testCase isAsync ]) ifTrue: [
testCase finished ].
testCase isAsync ifFalse: [
testCase tearDown ] ]
!
start
self execute: [
testCase setUp.
testCase performTest ]
! !
!TestContext class methodsFor: 'instance creation'!
testCase: aTestCase
^self new
testCase: aTestCase;
yourself
! !
TestContext subclass: #ReportingTestContext
instanceVariableNames: 'finished result'
package: 'SUnit'!
!ReportingTestContext commentStamp!
ReportingTestContext adds `TestResult` reporting
to `TestContext`.
Errors are caught and save into a `TestResult`,
When test case is finished (which can be later for async tests),
a callback block is executed; this is used by a `TestSuiteRunner`.!
!ReportingTestContext methodsFor: 'accessing'!
finished: aBlock
finished := aBlock
!
result: aTestResult
result := aTestResult
! !
!ReportingTestContext methodsFor: 'private'!
withErrorReporting: aBlock
[ aBlock
on: TestFailure
do: [ :ex | result addFailure: testCase ]
]
on: Error
do: [ :ex | result addError: testCase ]
! !
!ReportingTestContext methodsFor: 'running'!
execute: aBlock
[
self withErrorReporting: [ super execute: aBlock ]
]
ensure: [
testCase isAsync ifFalse: [
result increaseRuns. finished value ] ]
! !
!ReportingTestContext class methodsFor: 'instance creation'!
testCase: aTestCase result: aTestResult finished: aBlock
^(super testCase: aTestCase)
result: aTestResult;
finished: aBlock;
yourself
! !
Error subclass: #TestFailure
instanceVariableNames: ''
package: 'SUnit'!
!TestFailure commentStamp!
The test framework distinguishes between failures and errors.
A failure is an event whose possibiity is explicitly anticipated and checked for in an assertion,
whereas an error is an unanticipated problem like a division by 0 or an index out of bounds.
TestFailure is raised when the boolean parameter of an #`assert:` or `#deny:` call is the opposite of what the assertion claims.!
Object subclass: #TestResult
instanceVariableNames: 'timestamp runs errors failures total'
package: 'SUnit'!
!TestResult commentStamp!
A TestResult implements the collecting parameter pattern for running a bunch of tests.
A TestResult holds tests that have run, sorted into the result categories of passed, failures and errors.
TestResult is an interesting object to subclass or substitute. `#runCase:` is the external protocol you need to reproduce!
!TestResult methodsFor: 'accessing'!
addError: anError
self errors add: anError
!
addFailure: aFailure
self failures add: aFailure
!
errors
^errors
!
failures
^failures
!
increaseRuns
runs := runs + 1
!
runs
^runs
!
status
^self errors isEmpty
ifTrue: [
self failures isEmpty
ifTrue: ['success']
ifFalse: ['failure']]
ifFalse: ['error']
!
timestamp
^timestamp
!
total
^total
!
total: aNumber
total := aNumber
! !
!TestResult methodsFor: 'initialization'!
initialize
super initialize.
timestamp := Date now.
runs := 0.
errors := Array new.
failures := Array new.
total := 0
! !
!TestResult methodsFor: 'running'!
nextRunDo: aBlock
"Runs aBlock with index of next run
or does nothing if no more runs"
^self runs == self total
ifFalse: [ aBlock value: self runs + 1 ]
!
runCase: aTestCase
[[ self increaseRuns.
aTestCase runCase]
on: TestFailure do: [:ex | self addFailure: aTestCase]]
on: Error do: [:ex | self addError: aTestCase]
! !
Object subclass: #TestSuiteRunner
instanceVariableNames: 'suite result announcer runNextTest'
package: 'SUnit'!
!TestSuiteRunner methodsFor: 'accessing'!
announcer
^announcer
!
result
^result
!
suite: aCollection
suite := aCollection
! !
!TestSuiteRunner methodsFor: 'actions'!
resume
runNextTest fork.
announcer announce: (ResultAnnouncement new result: result)
!
run
result total: suite size.
self resume
! !
!TestSuiteRunner methodsFor: 'initialization'!
initialize
super initialize.
announcer := Announcer new.
result := TestResult new.
runNextTest := [ | runs | runs := result runs. runs < result total ifTrue: [ (self contextOf: runs + 1) start ]].
! !
!TestSuiteRunner methodsFor: 'private'!
contextOf: anInteger
^ReportingTestContext testCase: (suite at: anInteger) result: result finished: [ self resume ]
! !
!TestSuiteRunner class methodsFor: 'instance creation'!
new
self shouldNotImplement
!
on: aCollection
^super new suite: aCollection
! !