" Name: TestCase HideSource: false Parcel: TestCase SaveSource: true Date: 10:16:59 am September 21, 1998 " 'From VisualWorks®, Release 3.0 of February 5, 1998 on September 21, 1998 at 10:16:59 am'! (Dialog confirm: 'You are filing-in a Parcel source file!!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.']! Object subclass: #TestFailure instanceVariableNames: 'testCase exception ' classVariableNames: '' poolDictionaries: '' category: 'Testing Framework'! TestFailure class instanceVariableNames: ''! Object subclass: #TestCase instanceVariableNames: 'selector ' classVariableNames: 'FailedCheckSignal ' poolDictionaries: '' category: 'Testing Framework'! TestCase class instanceVariableNames: ''! Object subclass: #TestSuite instanceVariableNames: 'name testCases ' classVariableNames: '' poolDictionaries: '' category: 'Testing Framework'! TestSuite class instanceVariableNames: ''! TestCase subclass: #SetTestCase instanceVariableNames: 'full empty ' classVariableNames: '' poolDictionaries: '' category: 'Testing Framework'! SetTestCase class instanceVariableNames: ''! Object subclass: #TestResult instanceVariableNames: 'startTime stopTime testName failures errors ' classVariableNames: '' poolDictionaries: '' category: 'Testing Framework'! TestResult class instanceVariableNames: ''! !TestFailure methodsFor: 'printing'! printOn: aStream testCase printOn: aStream. aStream nextPutAll: ' failed because of '. exception printOn: aStream! ! !TestFailure methodsFor: 'private'! setTestCase: aTestCase exception: anException testCase := aTestCase. exception := anException! ! !TestFailure class methodsFor: 'instance creation'! testCase: aTestCase exception: anException ^self new setTestCase: aTestCase exception: anException! ! !TestCase methodsFor: 'set up'! setUp "Run whatever code you need to get ready for the test to run."! tearDown "Release whatever resources you used for the test."! ! !TestCase methodsFor: 'running'! performTest self perform: selector! run self setUp. [self performTest] valueNowOrOnUnwindDo: [self tearDown]! run: aTestResult self setUp. [self errorException handle: [:exception | aTestResult error: exception in: self] do: [self testFailedException handle: [:exception | aTestResult failure: exception in: self] do: [self performTest]]] valueNowOrOnUnwindDo: [self tearDown]! ! !TestCase methodsFor: 'checking'! should: aBlock aBlock value ifFalse: [self testFailedException raise]! should: aBlock raise: anException anException handle: [:ex | ^self] do: aBlock. self testFailedException raiseWith: 'Should have raised ' , anException printString! shouldnt: aBlock aBlock value ifTrue: [self testFailedException raise]! ! !TestCase methodsFor: 'printing'! printOn: aStream aStream nextPutAll: 'Test case '. self class printOn: aStream. aStream nextPutAll: '>>'; nextPutAll: selector! ! !TestCase methodsFor: 'private'! errorException ^self errorSignal! setSelector: aSymbol selector := aSymbol! testFailedException FailedCheckSignal isNil ifTrue: [FailedCheckSignal := (self errorSignal newSignal) notifierString: 'Check failed - '; nameClass: self message: #checkSignal]. ^FailedCheckSignal! ! !TestCase class methodsFor: 'instance creation'! selector: aSymbol ^self new setSelector: aSymbol! ! !TestSuite methodsFor: 'accessing'! addTestCase: aTestCase testCases add: aTestCase! addTestCases: aCollection aCollection do: [:each | self addTestCase: each]! name ^name! ! !TestSuite methodsFor: 'running'! run | result | result := self defaultTestResult. result start. self run: result. result stop. ^result! run: aTestResult testCases do: [:each | each run: aTestResult]! ! !TestSuite methodsFor: 'private'! defaultTestResult ^self defaultTestResultClass test: self! defaultTestResultClass ^TestResult! setName: aString name := aString. testCases := OrderedCollection new! ! !TestSuite class methodsFor: 'instance creation'! named: aString ^self new setName: aString! ! !SetTestCase methodsFor: 'set up'! setUp empty := Set new. full := Set with: 5 with: #abc! ! !SetTestCase methodsFor: 'running'! testAdd empty add: 5. self should: [empty includes: 5]! testError 2 + 'abc'! testFailure "This case is here to test the testing machinery only." self should: [false]! testGrow empty addAll: (1 to: 100). self should: [empty size = 100]! testIllegal self should: [empty at: 5] raise: self errorException. self should: [empty at: 5 put: #abc] raise: self errorException! testIncludes self should: [full includes: 5]. self should: [full includes: #abc]! testMinus self should: [(full - full copy) isEmpty]! testOccurrences self should: [(empty occurrencesOf: 0) = 0]. self should: [(full occurrencesOf: 5) = 1]. full add: 5. self should: [(full occurrencesOf: 5) = 1]! testRemove full remove: 5. self should: [full includes: #abc]. self shouldnt: [full includes: 5]! testTrim empty addAll: (1 to: 100). empty removeAll: (1 to: 99). empty trim. self should: [empty basicSize < 5]! ! !SetTestCase class methodsFor: 'running'! run | test | test := TestSuite named: 'Set Example'. test addTestCases: self testCases. ^test run! runAll | test | test := TestSuite named: 'Set Example'. test addTestCases: self allTestCases. ^test run! ! !SetTestCase class methodsFor: 'examples'! allTestCases | result | result := self testCases. result add: (self selector: #testIllegal). result add: (self selector: #testFailure). result add: (self selector: #testError). ^result! testCases | result | result := OrderedCollection new. result add: (self selector: #testAdd). result add: (self selector: #testRemove). result add: (self selector: #testIncludes). result add: (self selector: #testGrow). result add: (self selector: #testOccurrences). ^result! ! !TestResult methodsFor: 'running'! start startTime := Date dateAndTimeNow! stop stopTime := Date dateAndTimeNow! ! !TestResult methodsFor: 'testing'! hasNoErrors ^errors isEmpty! hasNoFailures ^failures isEmpty! wasSuccessful ^self hasNoFailures & self hasNoErrors! ! !TestResult methodsFor: 'logging'! error: anException in: aTestCase errors add: (TestFailure testCase: aTestCase exception: anException)! failure: anException in: aTestCase failures add: (TestFailure testCase: aTestCase exception: anException)! ! !TestResult methodsFor: 'printing'! printError: error on: aStream aStream nextPutAll: 'Error- '. error printOn: aStream! printErrorsOn: aStream errors do: [:each | aStream cr; tab. self printError: each on: aStream]! printFailure: failure on: aStream aStream nextPutAll: 'Failure- '. failure printOn: aStream! printFailuresOn: aStream failures do: [:each | aStream cr; tab. self printFailure: each on: aStream]! printHeaderOn: aStream aStream nextPutAll: 'Test results for '; nextPutAll: testName; cr; tab; nextPutAll: 'Start time: '. startTime printOn: aStream. aStream cr; tab; nextPutAll: 'Stop time: '. stopTime printOn: aStream! printOn: aStream self printHeaderOn: aStream. self printErrorsOn: aStream. self printFailuresOn: aStream! ! !TestResult methodsFor: 'private'! setTest: aTest testName := aTest name. failures := OrderedCollection new. errors := OrderedCollection new! ! !TestResult class methodsFor: 'instance creation'! test: aTest ^self new setTest: aTest! "Imported Classes:"! self error: 'Attempting to file-in parcel imports. Choose terminate or close'! ! nil subclass: #Object instanceVariableNames: '' classVariableNames: 'DependentsFields ' poolDictionaries: '' category: 'Kernel-Objects'!