"{ Package: 'stx:goodies/sunit' }"
ApplicationModel subclass:#TestRunner
instanceVariableNames:'result lastTestCase lastPass defect allDefects defectMenu details
mode scriptModel script numberOfTestsToRun testsWhichFailed
testsWhichPassed categoryModel category'
classVariableNames:''
poolDictionaries:''
category:'SUnit-UI'
!
!TestRunner class methodsFor:'documentation'!
documentation
"
This GUI is based on SUnit2.7 and
was ported to ST/X by Samuel S. Schuster (as 2.7) (thanks, indeed)
It was slightly enhanced by adding a rerun-defects, browse and
a category selector (to minor revision 2.7d, in the meantime)
"
! !
!TestRunner class methodsFor:'defaults'!
colorForFailedTests
^ Color red
!
colorForPassedTests
^ Color green darkened
!
defaultIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self defaultIcon inspect
ImageEditor openOnClass:self andSelector:#defaultIcon
"
<resource: #image>
^Icon
constantNamed:#'TestRunner class defaultIcon'
ifAbsentPut:[(Depth4Image new) width: 28; height: 28; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@O??C???????C?<O?0@@??<O??????<O?0??@@@@@@@@@@@@@@@@@@@@@BH"H"H"
H"H"H#L3L0@@H"H"H"H"H"H#L3L3@@@"H"H"H"H"H#L3L3L@@BH"H"H"H"H#L3L3L0@@H"H"H"H@@@L1L3L3@@@"H"H"HO??<A@3L3L@@BH"H"HO???1@3L3
L0@@H"H"HO???1@@L3L3@@@"H"H <_?1@O@3L3L@@BH"H"C0G1@O<CL3L0@@H"H"HO@A@O?0L3L3@@@"H"H ?0@O??@3L3L@@BH"H#LO<O??@3L3L0@@H"H#
L3C???@3L3L3@@@"H#L3L0@@@3L3L3L@@BH#L3L3L3L3L3L3L0@@H#L3L3L3L3L3L3L3@@@#L3L3L3L3L3L3L3L@@CL3L3L3L3L3L3L3L0@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 127 127 127 170 170 170]; mask:((Depth1Image new) width: 28; height: 28; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G??
?>A???? _???8G???>@@@@@@@@@@@@@a') ; yourself); yourself]
! !
!TestRunner class methodsFor:'interface specs'!
flyByHelpSpec
<resource: #help>
^super flyByHelpSpec addPairsFrom:#(
#refreshSuitesButton
'Refresh List of Tests'
#suitesCategoryList
'Test Categories'
#suiteSelection
'Selected Test'
#runButton
'Run selected Test'
#rerunDefectsButton
'ReRun Defects Only'
#runAllButton
'Run all Tests from Category'
#defectsList
'Failures'
#browseButton
'Browse Test'
#debugButton
'Debug Failed Test'
)
!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:TestRunner andSelector:#windowSpec
TestRunner new openInterface:#windowSpec
TestRunner open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'SUnit Camp Smalltalk 2.7d TestRunner'
#name: 'SUnit Camp Smalltalk 2.7d TestRunner'
#min: #(#Point 362 122)
#bounds: #(#Rectangle 13 23 506 198)
#icon: #defaultIcon
)
#component:
#(#SpecCollection
#collection: #(
#(#ActionButtonSpec
#label: 'Refresh'
#name: 'Button3'
#layout: #(#LayoutFrame 0 0 0 0 75 0 48 0)
#activeHelpKey: #refreshSuitesButton
#model: #refreshSuites
)
#(#MenuButtonSpec
#name: 'category'
#layout: #(#LayoutFrame 76 0 0 0 -216 1 24 0)
#activeHelpKey: #suitesCategoryList
#model: #category
#menu: #categoryList
)
#(#MenuButtonSpec
#name: #tests
#layout: #(#LayoutFrame 76 0 24 0 -216 1 48 0)
#activeHelpKey: #suiteSelection
#model: #script
#menu: #scriptModel
#useIndex: true
)
#(#ActionButtonSpec
#label: 'Run'
#name: 'Button1'
#layout: #(#LayoutFrame -215 1 0 0 -160 1 48 0)
#activeHelpKey: #runButton
#model: #runTests
#enableChannel: #enableRunButton
)
#(#ActionButtonSpec
#label: 'ReRun Defects'
#name: 'Button5'
#layout: #(#LayoutFrame -159 1 0 0 -57 1 48 0)
#activeHelpKey: #rerunDefectsButton
#model: #runDefects
#enableChannel: #enableRunDefectsButton
)
#(#ActionButtonSpec
#label: 'Run All'
#name: 'Button2'
#layout: #(#LayoutFrame -56 1 0 0 0 1 48 0)
#activeHelpKey: #runAllButton
#model: #runAllTests
)
#(#ProgressIndicatorSpec
#name: 'ProgressIndicator1'
#layout: #(#LayoutFrame 0 0.0 49 0 0 1.0 60 0)
#visibilityChannel: #percentageIndicatorVisible
#model: #percentageDone
#foregroundColor: #(#Color 32.9992 32.9992 0.0)
#backgroundColor: #(#Color 66.9993 66.9993 0.0)
#showPercentage: false
)
#(#LabelSpec
#label: '...'
#name: 'details'
#layout: #(#LayoutFrame 0 0 21 0.5 0 1 -25 1)
#labelChannel: #details
)
#(#LabelSpec
#label: 'N/A'
#name: 'mode'
#layout: #(#LayoutFrame 0 0 49 0 0 1 35 0.5)
#style: #(#FontDescription #Arial #bold #roman 14)
#labelChannel: #mode
)
#(#MenuButtonSpec
#name: #defects
#layout: #(#LayoutFrame 0 0 -24 1 -152 1 0 1)
#isOpaque: true
#flags: 40
#activeHelpKey: #defectsList
#model: #selectionHolder
#initiallyDisabled: true
#enableChannel: #enableDefectsList
#menu: #defectMenu
)
#(#ActionButtonSpec
#label: 'Browse'
#name: 'Button4'
#layout: #(#LayoutFrame -151 1 -24 1 -76 1 0 1)
#activeHelpKey: #browseButton
#model: #browseSelectedTestCase
#initiallyDisabled: true
#enableChannel: #enableRunButton
)
#(#ActionButtonSpec
#label: 'Debug'
#name: 'Button6'
#layout: #(#LayoutFrame -75 1 -24 1 0 1 0 1)
#activeHelpKey: #debugButton
#model: #debugSelectedFailure
#initiallyDisabled: true
#enableChannel: #enableDebugButton
)
)
)
)
! !
!TestRunner class methodsFor:'opening'!
open
^super open
!
openOnTestCase:aTestCaseSubclass
|runner idx|
runner := self new.
runner open.
runner window waitUntilVisible.
idx := runner scriptModel value indexOf:aTestCaseSubclass name.
runner selectScriptNamed:aTestCaseSubclass name.
"
self openOnTestCase:CompilerTest
"
! !
!TestRunner class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#script
).
! !
!TestRunner methodsFor:'accessing'!
category
|holder|
(holder := builder bindingAt:#category) isNil ifTrue:[
holder := '* all *' asValue.
builder aspectAt:#category put:holder.
holder onChangeSend:#categorySelectionChanged to:self.
].
^ holder.
!
categoryList
^categoryModel isNil
ifTrue: [categoryModel := ValueHolder new. self updateCategoryList. categoryModel]
ifFalse: [categoryModel]
!
defectMenu
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
^defectMenu isNil
ifTrue: [defectMenu := OrderedCollection new asValue]
ifFalse: [defectMenu]
"Modified: / 4.4.2000 / 20:00:31 / Sames"
!
defects
^self builder componentAt: #defects
"Created: / 21.6.2000 / 12:19:29 / Sames"
!
details
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^details isNil
ifTrue:
[details := '...' asValue]
ifFalse:
[details]
!
mode
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^mode isNil
ifTrue:
[mode := 'N/A' asValue]
ifFalse:
[mode]
!
percentageDone
|holder|
(holder := builder bindingAt:#percentageDone) isNil ifTrue:[
holder := 0 asValue.
builder aspectAt:#percentageDone put:holder.
].
^ holder.
!
percentageIndicatorVisible
|holder|
(holder := builder bindingAt:#percentageIndicatorVisible) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#percentageIndicatorVisible put:holder.
].
^ holder.
!
script
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
script isNil ifTrue:[
script := ValueHolder new.
script onChangeSend:#suiteSelectionChanged to:self.
].
^ script.
"Created: / 21.6.2000 / 12:04:36 / Sames"
!
script:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#script) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#script put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 21.6.2000 / 12:04:36 / Sames"
!
scriptModel
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^scriptModel isNil
ifTrue: [scriptModel := ValueHolder new. self updateSuitesList. scriptModel]
ifFalse: [scriptModel]
"Modified: / 2.4.2000 / 14:37:51 / Sames"
!
selection
^defect
"Created: / 4.4.2000 / 18:50:55 / Sames"
!
selectionHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#selectionHolder) isNil ifTrue:[
holder := AspectAdaptor new subject:self; forAspect:#selection.
builder aspectAt:#selectionHolder put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 4.4.2000 / 18:46:08 / Sames"
"Modified: / 4.4.2000 / 18:47:31 / Sames"
!
tests
^self builder componentAt: #tests
"Created: / 4.4.2000 / 19:57:37 / Sames"
! !
!TestRunner methodsFor:'actions'!
browseSelectedTestCase
|testCaseName testCase browser|
testCaseName := self selectedScript.
testCaseName notNil ifTrue:[
testCase := Smalltalk at:testCaseName asSymbol.
testCase notNil ifTrue:[
browser := UserPreferences current systemBrowserClass openInClass:testCase.
MessageNotUnderstood
handle:[:ex | ]
do:[ browser selectProtocolsMatching:'*']
]
]
!
categorySelectionChanged
|selectedScriptIndex selectedScript oldSuitesList newSuitesList
newScriptSelectionIndex|
selectedScriptIndex := self script value.
oldSuitesList := self scriptModel value.
selectedScriptIndex notNil ifTrue:[
selectedScript := (oldSuitesList at:selectedScriptIndex) string
].
self updateSuitesList.
newSuitesList := self scriptModel value.
newScriptSelectionIndex := newSuitesList indexOf:selectedScript.
self script value:(newScriptSelectionIndex == 0
ifTrue:[nil]
ifFalse:[newScriptSelectionIndex]).
!
debugSelectedFailure
self debugTest: self selection
"Created: / 21.6.2000 / 10:58:58 / Sames"
"Modified: / 21.6.2000 / 12:21:05 / Sames"
!
debugTest: aTestCaseName
| testCase |
defect := aTestCaseName.
testCase := allDefects at: aTestCaseName ifAbsent: [nil].
testCase isNil ifTrue: [^self enableDebugButton value: false].
self enableDebugButton value: true.
self displayMode: 'Debugging'.
defect := nil.
self withWaitCursorDo:[
(result isFailure: testCase)
ifTrue: [testCase debugAsFailure]
ifFalse: [testCase debug].
].
"Modified: / 21.6.2000 / 12:12:09 / Sames"
!
enableDebugButton
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
| holder |
(holder := builder bindingAt: #enableDebugButton) isNil
ifTrue:
[holder := true asValue.
builder aspectAt: #enableDebugButton put: holder
" holder addDependent:self."].
^holder
"Created: / 21.6.2000 / 10:47:34 / Sames"
"Modified: / 21.6.2000 / 10:51:07 / Sames"
!
enableDefectsList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#enableDefectsList) isNil ifTrue:[
holder := true asValue.
builder aspectAt:#enableDefectsList put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 21.6.2000 / 10:47:34 / Sames"
!
enableRunButton
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#enableRunButton) isNil ifTrue:[
holder := true asValue.
builder aspectAt:#enableRunButton put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 21.6.2000 / 10:47:34 / Sames"
!
enableRunDefectsButton
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#enableRunDefectsButton) isNil ifTrue:[
holder := true asValue.
builder aspectAt:#enableRunDefectsButton put:holder.
"/ holder addDependent:self.
].
^ holder.
!
refreshSuites
self updateCategoryList.
self updateSuitesList.
self script value:nil.
self tests selection: 0.
self defects selection: 0.
result := TestResult new.
lastTestCase := nil.
self displayRefresh
"Created: / 21.6.2000 / 10:58:34 / Sames"
"Modified: / 21.6.2000 / 12:19:54 / Sames"
!
runAllTests
self runSuite: self allTestSuite
!
runDefectTests
| testSuite |
(testSuite := self defectTestSuite) notNil ifTrue:
[self runSuite: testSuite]
!
runDefects
allDefects size > 0 ifTrue:[
^ self runDefectTests
].
self runTests
!
runSuite: aTestSuite
|numTests|
"/ count the number of individual tests
numTests := 0.
aTestSuite tests do:[:eachTestOrSubSuite |
(eachTestOrSubSuite isKindOf:TestSuite) ifTrue:[
numTests := numTests + eachTestOrSubSuite tests size.
] ifFalse:[
numTests := numTests + 1.
]
].
numberOfTestsToRun := numTests.
self percentageDone value:0.
Cursor
wait
showWhile:[
|errorCountBefore failureCountBefore|
self displayRunning.
self displayDetails: '...'.
aTestSuite addDependentToHierachy: self.
result := TestResult new.
lastTestCase := aTestSuite.
self showPercentageIndicator.
errorCountBefore := result errorCount.
failureCountBefore := result failureCount.
[
aTestSuite
run:result
beforeEachDo:[:eachCaseOrSuite :eachResult |
|caseName passed errorCountAfter failureCountAfter|
(eachCaseOrSuite isKindOf:TestCase) ifTrue:[
caseName := eachCaseOrSuite selector.
] ifFalse:[
caseName := eachCaseOrSuite name.
].
caseName size == 0 ifTrue:[self halt].
self displayDetails:(caseName , '...').
testsWhichFailed remove:caseName ifAbsent:nil.
testsWhichPassed add:caseName.
]
afterEachDo:[:eachCaseOrSuite :eachResult |
|caseName passed errorCountAfter failureCountAfter|
caseName := eachCaseOrSuite name.
caseName size == 0 ifTrue:[self halt].
self displayDetails:('...').
errorCountAfter := result errorCount.
failureCountAfter := result failureCount.
passed := (errorCountAfter == errorCountBefore)
& (failureCountAfter == failureCountBefore).
passed == true ifTrue:[
"/ testsWhichPassed add:caseName.
"/ testsWhichFailed remove:caseName ifAbsent:nil.
] ifFalse:[
testsWhichFailed add:caseName.
testsWhichPassed remove:caseName ifAbsent:nil.
].
errorCountBefore := errorCountAfter.
failureCountBefore := failureCountAfter
]
] ensure: [
aTestSuite removeDependentFromHierachy: self.
self hidePercentageIndicator.
self displayNormalColorInProgress.
].
self updateWindow
]
!
runTests
| testSuite |
(testSuite := self freshTestSuite) notNil ifTrue:
[self runSuite: testSuite]
"Modified: / 2.4.2000 / 14:16:10 / Sames"
!
scriptSelectionChanged
self enableRunButton value:(self script value notNil).
!
selection: aValue
self debugTest: aValue
"Created: / 4.4.2000 / 18:54:09 / Sames"
"Modified: / 4.4.2000 / 19:01:33 / Sames"
!
setSelection: aValue
defect := aValue
!
suiteSelectionChanged
|ok className description cls|
self enableRunButton value:(ok := self freshTestSuite notNil and:[self script value notNil]).
self enableRunDefectsButton value:(ok and:[allDefects size > 0]).
self script value notNil ifTrue:[
className := self selectedScript string.
(ok and:[className notNil]) ifTrue:[
cls := Smalltalk at:className.
(cls class includesSelector:#description) ifTrue:[
description := cls description.
]
].
].
self displayDetails:nil.
self displayMode: (description ? '').
self displayGray.
"Created: / 21.6.2000 / 11:31:25 / Sames"
"Modified: / 21.6.2000 / 11:32:54 / Sames"
!
suitesInCategory
|suites cat allCategories|
cat := self category value.
allCategories := (cat = '* all *').
suites := TestCase allSubclasses
select:[:each | allCategories or:[cat = each category]]
thenCollect: [:each | each name].
suites sort.
^ suites
!
updateCategoryList
|categories|
categories := (TestCase allSubclasses collect: [:each | each category]) asSet asOrderedCollection.
categories sort.
categories addFirst:'* all *'.
self categoryList value:categories.
!
updateSuitesList
|suites|
suites := self suitesInCategory.
suites := suites
collect:[:eachSuiteName |
(testsWhichFailed includes:eachSuiteName) ifTrue:[
eachSuiteName colorizeAllWith:(self class colorForFailedTests).
] ifFalse:[
(testsWhichPassed includes:eachSuiteName) ifTrue:[
eachSuiteName colorizeAllWith:(self class colorForPassedTests).
] ifFalse:[
eachSuiteName
]
].
].
self scriptModel value: suites.
! !
!TestRunner methodsFor:'private'!
allTestSuite
"generate and return a suite for all tests, except SUnitTests"
| tokens stream suite|
tokens := (self suitesInCategory
collect: [:eachName | eachName ", '*' " ])
copyWithout: 'SUnitTest* '.
stream := WriteStream on: String new.
tokens do: [:each | stream nextPutAll:each; space].
suite := TestSuitesScripter run: stream contents.
suite name:'all'.
^ suite
!
defectTestSuite
|suite|
suite := TestSuite new.
suite name:'defects'.
allDefects keysAndValuesDo:[:nm :test |
suite addTest:test.
].
^suite
!
formatTime: aTime
aTime hours > 0 ifTrue: [^aTime hours printString , 'h'].
aTime minutes > 0 ifTrue: [^aTime minutes printString , 'min'].
^aTime seconds printString , ' sec'
!
freshTestSuite
|tests|
tests := self tests contents.
tests isNil ifTrue:[ ^ nil].
^TestSuitesScripter run: tests
"Modified: / 4.4.2000 / 20:13:41 / Sames"
!
initialize
super initialize.
testsWhichPassed := Set new.
testsWhichFailed := Set new.
!
postOpenWith: aBuilder
"automatically generated by UIPainter ..."
super postOpenWith: aBuilder.
self tests defaultLabel: ''.
"/ self tests selection: 'ExampleSetTest'. self script value:1.
self enableRunButton value: (self script value notNil).
self enableRunDefectsButton value: false.
self enableDebugButton value: false.
self enableDefectsList value: false.
self script onChangeSend: #suiteSelectionChanged to:self.
Smalltalk addDependent:self.
"Created: / 2.4.2000 / 14:44:32 / Sames"
"Modified: / 21.6.2000 / 12:06:30 / Sames"
!
release
Smalltalk removeDependent:self.
super release.
!
selectScriptNamed:aScriptName
|idx scriptClass|
idx := self scriptModel value indexOf:aScriptName.
self script value:idx.
self updateCategoryList.
scriptClass := Smalltalk at:aScriptName asSymbol.
scriptClass notNil ifTrue:[
self category value:scriptClass category.
]
!
selectedScript
|scriptIndex|
scriptIndex := self script value.
scriptIndex isNil ifTrue:[
^ ''
].
^ self scriptModel value at:scriptIndex ifAbsent:nil.
!
timeSinceLastPassAsString
lastPass isNil ifTrue: [^''].
^', ' , (self formatTime: (Time now subtractTime: lastPass getSeconds)) , ' since last Pass'
"Modified: / 3.4.2000 / 19:17:11 / Sames"
! !
!TestRunner methodsFor:'updating'!
displayColor: aColorValue
(builder componentAt: #mode) widget insideColor: aColorValue.
(builder componentAt: #details) widget insideColor: aColorValue.
"Modified: / 2.4.2000 / 14:21:42 / Sames"
!
displayDefault
self displayColor: self tests backgroundColor
"Created: / 21.6.2000 / 12:28:06 / Sames"
"Modified: / 21.6.2000 / 12:35:09 / Sames"
!
displayDefects: aCollection
| menuButton |
menuButton := self builder componentAt: #defects.
aCollection isEmpty ifTrue: [
menuButton disable.
self enableRunDefectsButton value:false.
^ self
].
allDefects := Dictionary new.
aCollection do: [:each | allDefects at: each printString put: each].
self defectMenu value: allDefects keys asOrderedCollection sort.
menuButton enable.
self enableRunDefectsButton value:(allDefects size > 0).
"Modified: / 4.4.2000 / 20:11:06 / Sames"
!
displayDetails: aString
self details value: aString.
self repairDamage.
"Modified: / 21.6.2000 / 11:10:14 / Sames"
!
displayErrorColorInProgress
(self builder componentAt:#ProgressIndicator1)
foregroundColor: (self class colorForFailedTests).
"/ (self builder componentAt:#ProgressIndicator1)
"/ backgroundColor: (Color red:67 green:0 blue:0)
!
displayFail
self displayRed.
self displayMode: 'Fail'.
self displayDetails: result printString.
!
displayGray
self displayColor: (View defaultViewBackgroundColor)
!
displayGreen
self displayColor: ColorValue green
!
displayMode: aString
self mode value: aString.
self repairDamage.
"Modified: / 21.6.2000 / 11:14:19 / Sames"
!
displayNormalColorInProgress
(self builder componentAt:#ProgressIndicator1)
foregroundColor: (Color red:33 green:33 blue:0);
backgroundColor: (Color red:67 green:67 blue:0)
!
displayPass
self displayGreen.
(lastTestCase notNil
and:[lastTestCase name notNil]) ifTrue:[
self displayMode: 'Pass ' , lastTestCase name.
] ifFalse:[
self displayMode: 'Pass'.
].
self displayDetails: result runCount printString , ' run' , self timeSinceLastPassAsString.
lastPass := Time now
"Modified: / 21.6.2000 / 12:14:52 / Sames"
!
displayRed
self displayColor: ColorValue red.
!
displayRefresh
self displayMode: 'N/A'.
self displayDetails:'...'.
self updateDefects.
self enableRunButton value: false.
self enableRunDefectsButton value: false.
self enableDebugButton value: false.
self displayDefault
"Created: / 21.6.2000 / 12:14:11 / Sames"
"Modified: / 21.6.2000 / 12:28:24 / Sames"
!
displayRunning
self displayRunning:(self selectedScript ? 'all') string.
!
displayRunning:scriptName
self displayYellow.
self displayMode:('running ' , scriptName allBold).
"/ self displayDetails: '...'.
self repairDamage.
!
displayYellow
self displayColor: ColorValue yellow
!
hidePercentageIndicator
self percentageIndicatorVisible value:false.
!
repairDamage
self windowGroup repairDamage.
!
showPercentageIndicator
self percentageIndicatorVisible value:true.
!
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
(changedObject isBehavior and:[changedObject isSubclassOf:TestCase]) ifTrue:[
self updateSuitesList
].
^ self
].
(changedObject isKindOf: TestSuite) ifTrue: [
self displayRunning:changedObject name.
^ self
].
(changedObject isKindOf: TestCase) ifTrue: [
(result errorCount + result failureCount) > 0 ifTrue:[
self displayErrorColorInProgress.
].
self percentageDone value:(result runCount / numberOfTestsToRun * 100) rounded.
self displayDetails: changedObject printString.
^ self
].
super update:something with:aParameter from:changedObject
!
updateDefects
|script|
script := self selectedScript.
script notNil ifTrue:[script := script string].
self displayDefects: result defects.
script notNil ifTrue:[
result hasPassed ifTrue:[
testsWhichPassed add:script.
testsWhichFailed remove:script ifAbsent:nil.
] ifFalse:[
testsWhichFailed add:script.
testsWhichPassed remove:script ifAbsent:nil.
].
].
!
updateWindow
result hasPassed
ifTrue: [self displayPass]
ifFalse: [self displayFail].
self updateDefects.
self updateSuitesList. "/ for colors
! !
!TestRunner class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.33 2002-06-19 12:20:41 cg Exp $'
! !