Smalltalk current createPackage: 'SUnit' properties: #{}! Object subclass: #BareTestContext instanceVariableNames: 'testCase' package: 'SUnit'! !BareTestContext commentStamp! BareTestContext 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).! !BareTestContext methodsFor: 'accessing'! testCase: aTestCase testCase := aTestCase ! ! !BareTestContext 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 ] ! ! !BareTestContext class methodsFor: 'instance creation'! testCase: aTestCase ^self new testCase: aTestCase; yourself ! ! BareTestContext subclass: #ReportingTestContext instanceVariableNames: 'finished result' package: 'SUnit'! !ReportingTestContext commentStamp! ReportingTestContext adds TestResult reporting to BareTestContext. Errors are caught and save into TestResult, When test case is finished (which can be later for async tests), a callback block is executed; this is used by TestSuiteRunner.! !ReportingTestContext methodsFor: 'accessing'! finished: aBlock finished := aBlock ! result: aTestResult result := aTestResult ! ! !ReportingTestContext methodsFor: 'running'! execute: aBlock [[[ super execute: aBlock ] on: TestFailure do: [:ex | result addFailure: testCase]] on: Error do: [:ex | result addError: testCase]] 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 ! ! 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 methodsFor: 'accessing'! context: aRunningTestContext context := aRunningTestContext ! selector ^testSelector ! setTestSelector: aSelector testSelector := aSelector ! ! !TestCase methodsFor: 'async'! async: aBlock | c | self mustBeAsync: '#async'. c := context. ^[ self isAsync ifTrue: [ c execute: aBlock ]] ! finished self mustBeAsync: '#finished'. asyncTimeout := nil ! graceTime: millis asyncTimeout ifNotNil: [ asyncTimeout clearTimeout ]. asyncTimeout := true. "to allow async:" asyncTimeout := (self async: [ self assert: false description: 'SUnit grace time exhausted' ]) valueWithTimeout: millis ! isAsync ^asyncTimeout notNil ! mustBeAsync: aString self isAsync ifFalse: [ self error: aString, ' used without prior #graceTime:' ] ! ! !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." (BareTestContext 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: 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 ! ! 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 ! !