| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294 |
- Smalltalk current createPackage: 'SUnit' properties: #{}!
- Object subclass: #ResultAnnouncement
- instanceVariableNames: 'result'
- package: 'SUnit'!
- !ResultAnnouncement methodsFor: 'accessing'!
- result
- ^result
- !
- result: aTestResult
- result := aTestResult
- ! !
- Object subclass: #RunningTestContext
- instanceVariableNames: 'finished testCase result'
- package: 'SUnit'!
- !RunningTestContext methodsFor: 'accessing'!
- finished: aBlock
- finished := aBlock
- !
- result: aTestResult
- result := aTestResult
- !
- testCase: aTestCase
- testCase := aTestCase
- ! !
- !RunningTestContext methodsFor: 'running'!
- execute: aBlock
- [[[ aBlock
- ensure: [ result increaseRuns. testCase tearDown ]]
- on: TestFailure do: [:ex | result addFailure: testCase]]
- on: Error do: [:ex | result addError: testCase]]
- ensure: finished
- !
- start
- self execute: [ testCase setUp. testCase performTest ]
- ! !
- !RunningTestContext class methodsFor: 'instance creation'!
- testCase: aTestCase result: aTestResult finished: aBlock
- ^self new
- testCase: aTestCase;
- result: aTestResult;
- finished: aBlock;
- yourself
- ! !
- Object subclass: #TestCase
- instanceVariableNames: 'testSelector'
- package: 'SUnit'!
- !TestCase methodsFor: 'accessing'!
- selector
- ^testSelector
- !
- setTestSelector: aSelector
- testSelector := aSelector
- ! !
- !TestCase methodsFor: 'private'!
- signalFailure: aString
- TestFailure new
- messageText: aString;
- signal
- ! !
- !TestCase methodsFor: 'running'!
- performTest
- self perform: self selector
- !
- runCase
- [ self setUp.
- self performTest ] ensure: [
- self tearDown ]
- !
- setUp
- !
- tearDown
- ! !
- !TestCase methodsFor: 'testing'!
- assert: aBoolean
- self assert: aBoolean description: 'Assertion failed'
- !
- assert: aBoolean description: aString
- aBoolean ifFalse: [self signalFailure: aString]
- !
- assert: expected equals: actual
- ^ self assert: (expected = actual) description: 'Expected: ', expected asString, ' but was: ', actual asString
- !
- deny: aBoolean
- self assert: aBoolean not
- !
- 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
- ! !
- Error subclass: #TestFailure
- instanceVariableNames: ''
- package: 'SUnit'!
- Object subclass: #TestResult
- instanceVariableNames: 'timestamp runs errors failures total'
- package: 'SUnit'!
- !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 ]
- ! !
- 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 := [ result nextRunDo: [ :index |
- (RunningTestContext testCase: (suite at: index) result: result finished: [ self resume ]) start ]].
- ! !
- !TestSuiteRunner class methodsFor: 'instance creation'!
- new
- self shouldNotImplement
- !
- on: aCollection
- ^super new suite: aCollection
- ! !
|
