'From Squeak3.1alpha of 7 March 2001 [latest update: #4347] on 30 September 2001 at 10:50:13 pm'! Model subclass: #TestRunner instanceVariableNames: 'result details passFail failures errors tests testSuite passFailText detailsText lastPass testsList selectedFailureTest selectedErrorTest selectedSuite ' classVariableNames: '' poolDictionaries: '' category: 'SUnit-UI'! !TestRunner commentStamp: '' prior: 0! A simple text-based user interface to run all the test cases that exist in this image within the SUnit framework by Kent Beck and Erich Gamma (SUnit release 2, November 1998). The tests can be executed via TestRunner runTests or TestRunner runTests: '* test*'. The test results appear in the Transcript window.! ]style[(97 1 1 3 13 33 58 19 4 30 51)f1,f1cgreen;b,f1cred;b,f1bcblack;,f1,f1cblack;,f1,f1dTestRunner runTests;;,f1,f1dTestRunner runTests: '* test*';;,f1! TestRunner class instanceVariableNames: ''! !TestRunner methodsFor: 'test processing' stamp: 'rhi 4/26/2000 07:51'! runTests: aString "doIt: [TestRunner new runTests: 'Test* test*']" self classPattern: (self classPatternFrom: aString); selectorPattern: (self selectorPatternFrom: aString). self runTests.! ! !TestRunner methodsFor: 'test processing' stamp: 'rhi 2/5/2000 12:45'! showResult Transcript cr;cr; show: '==== SUnit ======== Start ===='. self showResultSummary; showResultDefects. Transcript cr; show: '==== SUnit ========== End ===='; cr.! ! !TestRunner methodsFor: 'test processing' stamp: 'rhi 2/5/2000 12:45'! showResultDefects (self result failureCount > 0) ifTrue: [ Transcript cr; show: '---- SUnit ----- Failures ----'. self result failures do: [:failure | Transcript crtab; show: failure printString]]. (self result errorCount > 0) ifTrue: [ Transcript cr; show: '---- SUnit ------- Errors ----'. self result errors do: [:error | Transcript crtab; show: error printString]].! ! !TestRunner methodsFor: 'test processing' stamp: 'rhi 2/5/2000 12:45'! showResultSummary | message summary | message := (self result runCount = self result correctCount) ifTrue: [self successMessage] ifFalse: [self failureMessage]. Transcript crtab; show: message. summary := self result runCount printString, ' run, ', self result failureCount printString, ' failed, ', self result errorCount printString, ' errors (', self duration printString, ' ms)'. Transcript crtab; show: summary.! ! !TestRunner methodsFor: 'constants' stamp: 'SSS 7/5/2000 13:53'! debugButtonLabel ^ 'DEBUG'! ! !TestRunner methodsFor: 'constants' stamp: 'SSS 7/5/2000 14:08'! debugState ^true! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 19:13'! errorColor ^ Color red! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 19:13'! failColor ^ Color yellow! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 19:13'! passColor ^ Color green! ! !TestRunner methodsFor: 'constants' stamp: 'SSS 7/5/2000 13:53'! refreshButtonLabel ^ 'REFRESH'! ! !TestRunner methodsFor: 'constants' stamp: 'SSS 7/5/2000 13:59'! refreshButtonState ^true! ! !TestRunner methodsFor: 'constants' stamp: 'SSS 7/5/2000 14:30'! resetColor ^ Color white! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 19:32'! runButtonColor ^ Color yellow! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 18:14'! runButtonLabel ^ 'RUN ALL'! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 17:32'! runButtonState ^true! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 4/11/2000 18:17'! runOneButtonLabel ^ 'RUN'! ! !TestRunner methodsFor: 'constants' stamp: 'Sames 2/22/2001 10:22'! windowLabel ^'SUnit Camp Smalltalk 3.0 Test Runner'! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 20:44'! debugErrorTest: anInteger selectedErrorTest _ anInteger. "added rew" selectedFailureTest _ 0. "added rew" self changed: #selectedFailureTest. "added rew" self changed: #selectedErrorTest. "added rew" (anInteger ~= 0) ifTrue: [(result errors at: anInteger) debug]! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 21:49'! debugFailureTest: anInteger (anInteger ~= 0) ifTrue: [(result failures at: anInteger) debugAsFailure]. selectedFailureTest _ anInteger. selectedErrorTest _ 0. self changed: #selectedErrorTest. self changed: #selectedFailureTest. ! ! !TestRunner methodsFor: 'processing' stamp: 'SSS 7/5/2000 13:59'! debugTest! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 20:47'! refreshTests tests _ (TestCase allSubclasses collect: [:each | each name]) asOrderedCollection. self changed: #tests. testSuite := nil. selectedSuite _ 0. selectedFailureTest _ 0. selectedErrorTest _ 0. self changed: #selectedFailureTest. "added rew" self changed: #selectedErrorTest. "added rew" self changed: #selectedSuite. self refreshWindow! ! !TestRunner methodsFor: 'processing' stamp: 'Sames 2/22/2001 10:19'! runOneTest Cursor execute showWhile: [testSuite notNil ifTrue: [self runWindow. result _ testSuite asSymbol sunitAsClass suite run. self updateWindow: result] ifFalse: [self runWindow. self displayPassFail: 'No Test Suite Selected']]! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 21:05'! runTests Cursor execute showWhile: [self runWindow. result _ self suite run. self updateWindow: result]! ! !TestRunner methodsFor: 'processing' stamp: 'rew 5/15/2000 21:08'! selectedErrorTest ^selectedErrorTest! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 21:01'! selectedFailureTest ^selectedFailureTest! ! !TestRunner methodsFor: 'processing' stamp: 'rew 5/15/2000 21:08'! selectedSuite ^selectedSuite! ! !TestRunner methodsFor: 'processing' stamp: 'rew 8/23/2000 20:52'! selectedSuite: anInteger anInteger ~= 0 ifTrue: [testSuite _ tests at: anInteger]. selectedSuite _ selectedSuite = anInteger ifTrue:[0] ifFalse:[anInteger]. selectedFailureTest _ 0. selectedErrorTest _ 0. self changed: #selectedFailureTest. "added rew" self changed: #selectedErrorTest. "added rew" self changed: #selectedSuite.! ! !TestRunner methodsFor: 'interface opening' stamp: 'rww 8/29/2001 01:50'! openAsMorph "TestRunner new openAsMorph" "=== build the parts ... ===" | topWindow runButton errorsList failuresList runOneButton refreshButton | Smalltalk isMorphic ifFalse: [^ self open]. (topWindow _ SystemWindow labelled: self windowLabel) model: self. runButton _ PluggableButtonMorph on: self getState: #runButtonState action: #runTests label: #runButtonLabel. runButton color: self runButtonColor. runButton onColor: self runButtonColor offColor: self runButtonColor. runOneButton _ PluggableButtonMorph on: self getState: #runButtonState action: #runOneTest label: #runOneButtonLabel. runOneButton color: self runButtonColor. runOneButton onColor: self runButtonColor offColor: self runButtonColor. refreshButton _ PluggableButtonMorph on: self getState: #refreshButtonState action: #refreshTests label: #refreshButtonLabel. refreshButton color: self runButtonColor. refreshButton onColor: self runButtonColor offColor: self runButtonColor. passFailText _ PluggableTextMorph on: self text: #passFail accept: nil. passFailText hideScrollBarIndefinitely. detailsText _ PluggableTextMorph on: self text: #details accept: nil. detailsText hideScrollBarIndefinitely. testsList _ PluggableListMorph on: self list: #tests selected: #selectedSuite changeSelected: #selectedSuite:. testsList autoDeselect: false. failuresList _ PluggableListMorph on: self list: #failures selected: #selectedFailureTest changeSelected: #debugFailureTest:. errorsList _ PluggableListMorph on: self list: #errors selected: #selectedErrorTest changeSelected: #debugErrorTest:. "=== assemble the whole ... ===" topWindow addMorph: refreshButton frame: (0.0 @ 0.0 extent: 0.2 @ 0.2). topWindow addMorph: testsList frame: (0.2 @ 0.0 extent: 0.6 @ 0.2). topWindow addMorph: runOneButton frame: (0.8 @ 0.0 extent: 0.2 @ 0.1). topWindow addMorph: runButton frame: (0.8 @ 0.1 extent: 0.2 @ 0.1). topWindow addMorph: passFailText frame: (0.0 @ 0.2 extent: 1.0 @ 0.1). topWindow addMorph: detailsText frame: (0.0 @ 0.3 extent: 1.0 @ 0.1). topWindow addMorph: failuresList frame: (0.0 @ 0.4 extent: 1.0 @ 0.3). topWindow addMorph: errorsList frame: (0.0 @ 0.7 extent: 1.0 @ 0.3). "=== open it ... ===" topWindow openInWorldExtent: 400 @ 400. self refreshWindow. ^ topWindow! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/11/2000 17:25'! details ^details! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/11/2000 17:25'! errors ^errors! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/11/2000 17:26'! failures ^failures! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/12/2000 18:12'! formatTime: aTime aTime hours > 0 ifTrue: [^aTime hours printString , 'h']. aTime minutes > 0 ifTrue: [^aTime minutes printString , 'min']. ^aTime seconds printString , ' sec'! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/11/2000 17:26'! passFail ^passFail! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 2/22/2001 10:14'! suite ^TestCase buildSuite! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/11/2000 18:39'! tests ^ tests! ! !TestRunner methodsFor: 'accessing' stamp: 'Sames 4/12/2000 18:19'! timeSinceLastPassAsString: aResult (lastPass isNil or: [aResult hasPassed not]) ifTrue: [^ '']. ^ ', ' , (self formatTime: (Time now subtractTime: lastPass)) , ' since last Pass'! ! !TestRunner methodsFor: 'initialize' stamp: 'rew 8/23/2000 20:57'! initialize result _ TestResult new. passFail _ 'N/A'. details _ '...'. failures _ OrderedCollection new. errors _ OrderedCollection new. tests _ (TestCase allSubclasses collect: [:each | each name]) asOrderedCollection. selectedSuite _ 0. selectedFailureTest _ 0. selectedErrorTest _ 0. ! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:38'! displayDetails: aString details := aString. self changed: #details! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:37'! displayErrors: anOrderedCollection errors := anOrderedCollection. self changed: #errors! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:37'! displayFailures: anOrderedCollection failures := anOrderedCollection. self changed: #failures! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:36'! displayPassFail: aString passFail := aString. self changed: #passFail! ! !TestRunner methodsFor: 'updating' stamp: 'SSS 7/5/2000 14:31'! refreshWindow passFailText isMorph ifTrue: [passFailText color: Color white. detailsText color: Color white] ifFalse: [passFailText insideColor: Color white. detailsText insideColor: Color white]. self updateErrors: TestResult new. self updateFailures: TestResult new. self displayPassFail: 'N/A'. self displayDetails: '...'! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/12/2000 18:52'! runWindow passFailText isMorph ifTrue: [passFailText color: Color white. detailsText color: Color white] ifFalse: [passFailText insideColor: Color white. detailsText insideColor: Color white]. self updateErrors: TestResult new. self updateFailures: TestResult new. self displayPassFail: 'Running...'. self displayDetails: '...'! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/12/2000 18:20'! updateDetails: aTestResult self displayDetails: aTestResult printString , (self timeSinceLastPassAsString: aTestResult). aTestResult hasPassed ifTrue: [lastPass _ Time now]! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:35'! updateErrors: aTestResult self displayErrors: (aTestResult errors collect: [:error | error printString])! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 17:35'! updateFailures: aTestResult self displayFailures: (aTestResult failures collect: [:failure | failure printString])! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/12/2000 18:57'! updatePartColors: aColor passFailText isMorph ifTrue: [passFailText color: aColor. detailsText color: aColor] ifFalse: [passFailText insideColor: aColor. detailsText insideColor: aColor]! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/11/2000 18:27'! updatePassFail: aTestResult | message | message _ aTestResult hasPassed ifTrue: ['Pass'] ifFalse: ['Fail']. self displayPassFail: message! ! !TestRunner methodsFor: 'updating' stamp: 'Sames 4/12/2000 18:54'! updateWindow: aTestResult aTestResult errors size + aTestResult failures size = 0 ifTrue: [self updatePartColors: self passColor] ifFalse: [aTestResult errors size > 0 ifTrue: [self updatePartColors: self errorColor] ifFalse: [self updatePartColors: self failColor]]. self updatePassFail: aTestResult. self updateDetails: aTestResult. self updateFailures: aTestResult. self updateErrors: aTestResult! ! !TestRunner class methodsFor: 'documentation' stamp: 'rhi 2/5/2000 12:40'! testRunnerUsage "Please see the class comment for some documentation. Documentation links: * TestingFrameworkPaper * TestModel * TestRunner" self error: 'comment only'.! ]style[(15 83 21 5 9 5 10 31)f1b,f1,f1LTestingFrameworkPaper Comment;,f1,f1LTestModel Comment;,f1,f1LTestRunner Comment;,f1! ! !TestRunner class methodsFor: 'processing' stamp: 'rhi 2/5/2000 12:40'! runTests "doIt: [TestRunner runTests]" TestRunner new runTests.! ! !TestRunner class methodsFor: 'processing' stamp: 'rhi 2/5/2000 12:40'! runTests: aString "doIt: [TestRunner runTests: '* test*']" TestRunner new runTests: aString.! ! !TestRunner class methodsFor: 'instance creation' stamp: 'Sames 4/11/2000 17:33'! new ^super new initialize! ! !TestRunner class methodsFor: 'instance creation' stamp: 'rww 8/29/2001 01:34'! open ^TestRunner new openAsMorph ! ! Smalltalk removeClassNamed: #TestInterfaceBase! Smalltalk removeClassNamed: #TestModel! SystemOrganization removeSystemCategory: 'SUnit-Interface'!