'From Squeak3.1alpha of 7 March 2001 [latest update: #4282] on 29 August 2001 at 1:49:03 am'! Object subclass: #TestCase instanceVariableNames: 'testMessage testSelector ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! !TestCase commentStamp: '' prior: 0! Defines the fixture to run multiple tests plus the tests using this fixture. To define a test case * implement a subclass of TestCase, * define instance variables that store the state of the fixture, * initialize the fixture state by overriding TestCase setUp, * clean-up after a test by overriding TestCase tearDown, and Each test runs in its own fixture so there can be no side effects among test runs. For each test in the context of this fixture set-up, * implement a method(s) which interacts with the fixture. In the test method(s) verify the expected results with assertions specified by calling * TestCase assert: * TestCase deny: * TestCase should: * TestCase shouldnt: * TestCase value:shouldRaise: or * TestCase value:shouldntRaise: with arguments of the expected type. Instance Variables: testMessage ! ]style[(252 14 42 17 298 16 5 14 5 16 5 18 5 27 8 29 75 6 1)f1,f1LTestCase setUp;,f1,f1LTestCase tearDown;,f1,f1LTestCase assert:;,f1,f1LTestCase deny:;,f1,f1LTestCase should:;,f1,f1LTestCase shouldnt:;,f1,f1LTestCase value:shouldRaise:;,f1,f1LTestCase value:shouldntRaise:;,f1,f1LSymbol Hierarchy;,f1! TestCase class instanceVariableNames: ''! Object subclass: #TestResource instanceVariableNames: 'name description ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! TestResource class instanceVariableNames: 'current '! Object subclass: #TestResult instanceVariableNames: 'runCount failures errors passed ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! !TestResult commentStamp: '' prior: 0! Collects the results of executing a test case. The test framework distinguishes between failures and errors. A failure is anticipated and checked for with assertions. Errors are unanticipated problems like a division by 0 or an index out of bound ... Instance Variables: runCount failures errors ! ]style[(283 12 14 17 5 8 12 17 5 8 1)f1,f1LSmallInteger Hierarchy;,f1,f1LOrderedCollection Hierarchy;,f1,f1LTestCase Hierarchy;,f1,f1LOrderedCollection Hierarchy;,f1,f1LTestCase Hierarchy;,f1! TestResult class instanceVariableNames: ''! Object subclass: #TestSuite instanceVariableNames: 'tests resources name ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! !TestSuite commentStamp: '' prior: 0! A Composite of test cases. It runs a collection of test cases. Instance Variables: tests ! ]style[(92 17 5 8 1)f1,f1LOrderedCollection Hierarchy;,f1,f1LTestCase Hierarchy;,f1! TestSuite class instanceVariableNames: ''! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:50'! assert: aBoolean aBoolean ifFalse: [self signalFailure: 'Assertion failed']! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:50'! deny: aBoolean self assert: aBoolean not! ! !TestCase methodsFor: 'Accessing' stamp: 'JP 9/9/2000 18:03'! resources ^self class resources! ! !TestCase methodsFor: 'Accessing' stamp: 'Sames 2/19/2001 13:29'! selector ^testSelector! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:50'! should: aBlock self assert: aBlock value! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:51'! should: aBlock raise: anExceptionalEvent ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:51'! shouldnt: aBlock self deny: aBlock value! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:51'! shouldnt: aBlock raise: anExceptionalEvent ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not! ! !TestCase methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 12:52'! signalFailure: aString TestResult failure sunitSignalWith: aString ! ! !TestCase methodsFor: 'Dependencies' stamp: 'SSS 7/3/2000 12:52'! addDependentToHierachy: anObject "an empty method. for Composite compability with TestSuite" ! ! !TestCase methodsFor: 'Dependencies' stamp: 'SSS 7/3/2000 12:53'! removeDependentFromHierachy: anObject "an empty method. for Composite compability with TestSuite" ! ! !TestCase methodsFor: 'Printing' stamp: 'Sames 2/19/2001 13:30'! printOn: aStream aStream nextPutAll: self class printString; nextPutAll: '>>'; nextPutAll: testSelector! ! !TestCase methodsFor: 'Testing' stamp: 'JP 9/9/2000 18:01'! areAllResourcesAvailable ^self resources inject: true into: [:total :each | each isAvailable & total]! ! !TestCase methodsFor: 'Private' stamp: 'SSS 7/3/2000 12:55'! executeShould: aBlock inScopeOf: anExceptionalEvent [[aBlock value] sunitOn: anExceptionalEvent do: [:ex | ^true]] sunitOn: TestResult error do: [:ex | ^false]. ^false.! ! !TestCase methodsFor: 'Private' stamp: 'Sames 2/19/2001 13:31'! performTest self perform: testSelector sunitAsSymbol! ! !TestCase methodsFor: 'Private' stamp: 'SSS 7/3/2000 12:55'! setTestSelector: aSymbol testSelector := aSymbol! ! !TestCase methodsFor: 'Running' stamp: 'JP 9/9/2000 18:02'! debug self debugUsing: #runCase! ! !TestCase methodsFor: 'Running' stamp: 'JP 9/9/2000 18:03'! debugAsFailure self debugUsing: #runCaseAsFailure ! ! !TestCase methodsFor: 'Running' stamp: 'Sames 2/19/2001 13:32'! debugUsing: aSymbol self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized']. [(self class selector: testSelector) perform: aSymbol] sunitEnsure: [self resources do: [:each | each reset]]! ! !TestCase methodsFor: 'Running' stamp: 'Sames 2/19/2001 13:33'! 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; performTest! ! !TestCase methodsFor: 'Running' stamp: 'SSS 7/3/2000 12:56'! run | result | result := TestResult new. self run: result. ^result! ! !TestCase methodsFor: 'Running' stamp: 'SSS 7/3/2000 12:57'! run: aResult aResult runCase: self! ! !TestCase methodsFor: 'Running' stamp: 'Sames 2/19/2001 13:33'! runCase self setUp. [self performTest] sunitEnsure: [self tearDown]! ! !TestCase methodsFor: 'Running' stamp: 'SSS 7/3/2000 12:57'! runCaseAsFailure self setUp. [[self openDebuggerOnFailingTestMethod] sunitEnsure: [self tearDown]] fork! ! !TestCase methodsFor: 'Running' stamp: 'SSS 7/3/2000 12:57'! setUp! ! !TestCase methodsFor: 'Running' stamp: 'SSS 7/3/2000 12:57'! tearDown! ! !TestCase class methodsFor: 'Building Suites' stamp: 'Sames 2/19/2001 13:25'! 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]! ! !TestCase class methodsFor: 'Building Suites' stamp: 'Sames 2/19/2001 13:25'! buildSuiteFromAllSelectors ^self buildSuiteFromMethods: self allTestSelectors! ! !TestCase class methodsFor: 'Building Suites' stamp: 'Sames 2/19/2001 13:26'! buildSuiteFromLocalSelectors ^self buildSuiteFromMethods: self testSelectors! ! !TestCase class methodsFor: 'Building Suites' stamp: 'Sames 2/19/2001 13:26'! buildSuiteFromMethods: testMethods ^testMethods inject: ((TestSuite new) name: self name asString; yourself) into: [:suite :selector | suite addTest: (self selector: selector); yourself]! ! !TestCase class methodsFor: 'Building Suites' stamp: 'Sames 2/19/2001 13:26'! buildSuiteFromSelectors ^self shouldInheritSelectors ifTrue: [self buildSuiteFromAllSelectors] ifFalse: [self buildSuiteFromLocalSelectors]! ! !TestCase class methodsFor: 'Accessing' stamp: 'Sames 2/22/2001 10:08'! allTestSelectors ^self sunitAllSelectors select: [:each | 'test*' sunitMatch: each]! ! !TestCase class methodsFor: 'Accessing' stamp: 'Sames 2/19/2001 13:24'! resources ^#()! ! !TestCase class methodsFor: 'Accessing' stamp: 'Sames 2/19/2001 13:25'! testSelectors ^self sunitSelectors select: [:each | 'test*' sunitMatch: each]! ! !TestCase class methodsFor: 'Testing' stamp: 'Sames 2/19/2001 13:27'! isAbstract "Override to true if a TestCase subclass is Abstract and should not have TestCase instances built from it" ^self name = #TestCase.! ! !TestCase class methodsFor: 'Testing' stamp: 'Sames 2/19/2001 13:28'! shouldInheritSelectors "answer true to inherit selectors from superclasses" ^true! ! !TestCase class methodsFor: 'Instance Creation' stamp: 'SSS 7/3/2000 12:58'! debug: aSymbol ^(self selector: aSymbol) debug! ! !TestCase class methodsFor: 'Instance Creation' stamp: 'SSS 7/3/2000 12:58'! run: aSymbol ^(self selector: aSymbol) run! ! !TestCase class methodsFor: 'Instance Creation' stamp: 'SSS 7/3/2000 12:59'! selector: aSymbol ^self new setTestSelector: aSymbol! ! !TestCase class methodsFor: 'Instance Creation' stamp: 'Sames 2/19/2001 13:27'! suite ^self buildSuite! ! !TestResource methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:08'! description description isNil ifTrue: [^'']. ^description! ! !TestResource methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:08'! description: aString description := aString! ! !TestResource methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:09'! name name isNil ifTrue: [^self printString]. ^name! ! !TestResource methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:09'! name: aString name := aString! ! !TestResource methodsFor: 'Printing' stamp: 'Sames 2/21/2001 12:09'! printOn: aStream aStream nextPutAll: self class printString! ! !TestResource methodsFor: 'Init / Release' stamp: 'Sames 2/21/2001 12:09'! initialize ! ! !TestResource methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:10'! isAvailable "override to provide information on the readiness of the resource" ^true! ! !TestResource methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:10'! isUnavailable "override to provide information on the readiness of the resource" ^self isAvailable not! ! !TestResource methodsFor: 'Running'! setUp "Does nothing. Subclasses should override this to initialize their resource"! ! !TestResource methodsFor: 'Running'! tearDown "Does nothing. Subclasses should override this to tear down their resource"! ! !TestResource class methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:13'! isAbstract "Override to true if a TestCase subclass is Abstract and should not have TestCase instances built from it" ^self name = #TestResource! ! !TestResource class methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:12'! isAvailable ^self current notNil! ! !TestResource class methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:12'! isUnavailable ^self isAvailable not! ! !TestResource class methodsFor: 'Creation' stamp: 'Sames 2/21/2001 12:11'! new ^super new initialize! ! !TestResource class methodsFor: 'Creation' stamp: 'Sames 2/21/2001 12:11'! reset current notNil ifTrue: [current tearDown. current := nil]! ! !TestResource class methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:11'! current current isNil ifTrue: [current := self new]. ^current! ! !TestResource class methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:11'! current: aTestResource current := aTestResource! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:14'! correctCount "depreciated - use #passedCount" ^self passedCount! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:14'! defects ^self errors, self failures! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:14'! errorCount ^self errors size! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:14'! errors errors isNil ifTrue: [errors := OrderedCollection new]. ^errors! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:15'! failureCount ^self failures size! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:15'! failures failures isNil ifTrue: [failures := OrderedCollection new]. ^failures! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:15'! passed passed isNil ifTrue: [passed := OrderedCollection new]. ^passed! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:15'! passedCount ^self passed size! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:14'! runCount ^self passedCount + self failureCount + self errorCount! ! !TestResult methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:15'! tests ^(OrderedCollection new: self runCount) addAll: self passed; addAll: self errors; addAll: self defects; yourself! ! !TestResult methodsFor: 'Init / Release' stamp: 'Sames 2/21/2001 12:15'! initialize ! ! !TestResult methodsFor: 'Printing' stamp: 'Sames 2/21/2001 12:16'! printOn: aStream aStream nextPutAll: self runCount printString; nextPutAll: ' run, '; nextPutAll: self passedCount printString; nextPutAll: ' passed, '; nextPutAll: self failureCount printString; nextPutAll: ' failed, '; nextPutAll: self errorCount printString; nextPutAll:' error'. self errorCount ~= 1 ifTrue: [aStream nextPut: $s].! ! !TestResult methodsFor: 'Running' stamp: 'Sames 2/21/2001 12:16'! runCase: aTestCase | testCasePassed | testCasePassed := true. [[aTestCase runCase] sunitOn: self class failure do: [:signal | self failures add: aTestCase. testCasePassed := false. signal sunitExitWith: false]] sunitOn: self class error do: [:signal | self errors add: aTestCase. testCasePassed := false. signal sunitExitWith: false]. testCasePassed ifTrue: [self passed add: aTestCase]! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:16'! hasErrors ^self errors size > 0! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:16'! hasFailures ^self failures size > 0! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:16'! hasPassed ^self runCount = self correctCount! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:16'! isError: aTestCase ^self errors includes: aTestCase! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:16'! isFailure: aTestCase ^self failures includes: aTestCase! ! !TestResult methodsFor: 'Testing' stamp: 'Sames 2/21/2001 12:17'! isPassed: aTestCase ^self passed includes: aTestCase! ! !TestResult class methodsFor: 'Exceptions' stamp: 'SSS 7/3/2000 13:05'! error ^self exError! ! !TestResult class methodsFor: 'Exceptions' stamp: 'SSS 7/3/2000 13:06'! exError "Change for Dialect" ^ Error! ! !TestResult class methodsFor: 'Exceptions' stamp: 'SSS 7/3/2000 13:06'! failure ^TestFailure! ! !TestResult class methodsFor: 'Exceptions' stamp: 'SSS 7/3/2000 13:06'! signalErrorWith: aString self error sunitSignalWith: aString! ! !TestResult class methodsFor: 'Exceptions' stamp: 'SSS 7/3/2000 13:07'! signalFailureWith: aString self failure sunitSignalWith: aString! ! !TestResult class methodsFor: 'Init / Release' stamp: 'SSS 7/3/2000 13:07'! new ^super new initialize! ! !TestSuite methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 13:09'! addTest: aTest self tests add: aTest! ! !TestSuite methodsFor: 'Accessing' stamp: 'SSS 7/3/2000 13:10'! addTests: aCollection aCollection do: [:eachTest | self addTest: eachTest]! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! defaultResources ^self tests inject: Set new into: [:coll :testCase | coll addAll: testCase resources; yourself]! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! name ^name! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! name: aString name := aString! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! resources resources isNil ifTrue: [resources := self defaultResources]. ^resources! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! resources: anObject resources := anObject! ! !TestSuite methodsFor: 'Accessing' stamp: 'Sames 2/21/2001 12:20'! tests tests isNil ifTrue: [tests := OrderedCollection new]. ^tests! ! !TestSuite methodsFor: 'Dependencies' stamp: 'SSS 7/3/2000 13:11'! addDependentToHierachy: anObject self sunitAddDependent: anObject. self tests do: [ :each | each addDependentToHierachy: anObject]! ! !TestSuite methodsFor: 'Dependencies' stamp: 'SSS 7/3/2000 13:11'! removeDependentFromHierachy: anObject self sunitRemoveDependent: anObject. self tests do: [ :each | each removeDependentFromHierachy: anObject]! ! !TestSuite methodsFor: 'Testing' stamp: 'JP 9/9/2000 18:11'! areAllResourcesAvailable ^self resources inject: true into: [:total :each | each isAvailable & total]! ! !TestSuite methodsFor: 'Running' stamp: 'Sames 2/21/2001 12:21'! run | result | result := TestResult new. self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized']. [self run: result] sunitEnsure: [self resources do: [:each | each reset]]. ^result! ! !TestSuite methodsFor: 'Running' stamp: 'Sames 2/21/2001 12:21'! run: aResult self tests do: [:each | self sunitChanged: each. each run: aResult]! ! !TestSuite class methodsFor: 'Creation' stamp: 'Sames 2/21/2001 12:22'! named: aString ^self new name: aString; yourself! ! TestSuite class removeSelector: #new! TestSuite removeSelector: #initialize! TestSuite removeSelector: #tests:! TestResult class removeSelector: #testFailureException! TestResult removeSelector: #errors:! TestResult removeSelector: #failures:! TestResult removeSelector: #runCount:! TestResult removeSelector: #testFailureException! Object subclass: #TestResult instanceVariableNames: 'failures errors passed ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! TestCase removeSelector: #testMessage! TestCase removeSelector: #testMessage:! TestCase removeSelector: #value:shouldRaise:! TestCase removeSelector: #value:shouldntRaise:! Object subclass: #TestCase instanceVariableNames: 'testSelector ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-Core'! SystemOrganization removeSystemCategory: 'SUnit-Framework'!