fixes and enhancements:
added stop button to allow runaway test to be stopped;
added run failed;
do NOT catch terminate signal.
run tests at background prio
--- a/Tools__TestRunnerEmbedded.st Mon Jun 04 18:17:33 2012 +0200
+++ b/Tools__TestRunnerEmbedded.st Mon Jun 04 19:13:51 2012 +0200
@@ -28,11 +28,10 @@
"{ NameSpace: Tools }"
AbstractTestRunner subclass:#TestRunnerEmbedded
- instanceVariableNames:'runnerPanel selectedTestCases selectedClassesHolder
- selectedProtocolsHolder selectedMethodsHolder
- methodGeneratorHolder resultHolder resultInfoHolder
- resultBackgroundColorHolder runningHolder progressHolder
- infoHolder'
+ instanceVariableNames:'runnerPanel selectedClassesHolder selectedProtocolsHolder
+ selectedMethodsHolder methodGeneratorHolder resultHolder
+ resultInfoHolder resultBackgroundColorHolder runningHolder
+ progressHolder infoHolder testProcess allTestCases'
classVariableNames:''
poolDictionaries:''
category:'SUnit-UI'
@@ -106,7 +105,7 @@
label: 'Test Runner Embedded'
name: 'Test Runner Embedded'
min: (Point 10 10)
- bounds: (Rectangle 0 0 350 50)
+ bounds: (Rectangle 0 0 595 50)
)
component:
(SpecCollection
@@ -157,7 +156,7 @@
(LabelSpec
name: 'ResultInfo'
layout: (LayoutFrame 0 0 -10 1 0 1 0 1)
- style: (FontDescription helvetica medium roman 8)
+ style: (FontDescription helvetica medium roman 8 #'iso10646-1')
backgroundChannel: resultBackgroundColorAspect
foregroundColor: (Color 100.0 100.0 100.0)
translateLabel: true
@@ -184,26 +183,42 @@
)
)
- extent: (Point 151 30)
+ extent: (Point 336 30)
)
(ActionButtonSpec
label: 'Debug'
name: 'DebugButton'
initiallyInvisible: true
- visibilityChannel: debugVisibleAspect
translateLabel: true
model: debug
extent: (Point 60 25)
)
(ActionButtonSpec
+ label: 'Stop'
+ name: 'Button2'
+ visibilityChannel: runningHolder
+ translateLabel: true
+ model: stop
+ extent: (Point 60 25)
+ )
+ (ActionButtonSpec
label: 'Run'
name: 'Run'
+ visibilityChannel: notRunningHolder
translateLabel: true
model: run
enableChannel: runEnabledHolder
extent: (Point 60 25)
)
(ActionButtonSpec
+ label: 'Run Failed'
+ name: 'Button1'
+ translateLabel: true
+ model: runFailed
+ enableChannel: runFailedEnabledHolder
+ extent: (Point 60 25)
+ )
+ (ActionButtonSpec
label: 'Run all'
name: 'RunAll'
translateLabel: true
@@ -219,7 +234,7 @@
)
)
- extent: (Point 340 40)
+ extent: (Point 585 40)
)
)
@@ -288,31 +303,36 @@
generator := self methodGeneratorHolder value.
selectedClass := self theSingleTestCase.
- generator ifNotNil:
- [ generator do:
- [:cls :cat :sel :mthd |
- (mthd notNil
- and:[ (self isTestCaseLike:(selectedClass ? cls)) and:[ (selectedClass ? cls) isTestSelector:sel ] ])
- ifTrue:[ methods add:mthd ] ] ]
- ifNil:
- [ selectedTestCases do:
- [:cls |
- cls methodsDo:
- [:mthd |
- ((protocols includes:mthd category)
- and:[ cls isTestSelector:mthd selector ]) ifTrue:[ methods add:mthd ] ] ] ].
+ generator notNil ifTrue:[
+ generator do: [:cls :cat :sel :mthd |
+ (mthd notNil
+ and:[ (self isTestCaseLike:(selectedClass ? cls))
+ and:[ (selectedClass ? cls) isTestSelector:sel ] ])
+ ifTrue:[ methods add:mthd ]
+ ]
+ ] ifFalse:[
+ allTestCases do: [:cls |
+ cls methodsDo: [:mthd |
+ ((protocols includes:mthd category) and:[ cls isTestSelector:mthd selector ])
+ ifTrue:[
+ methods add:mthd
+ ]
+ ]
+ ]
+ ].
^ methods
"Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 04-06-2012 / 19:05:32 / cg"
!
theSingleTestCase
- selectedTestCases isEmptyOrNil ifTrue:[^nil].
- selectedTestCases size > 1 ifTrue:[^nil].
+ allTestCases isEmptyOrNil ifTrue:[^nil].
+ allTestCases size > 1 ifTrue:[^nil].
- ^selectedTestCases anyOne.
+ ^allTestCases anyOne.
"Created: / 22-07-2011 / 15:44:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -359,19 +379,21 @@
!
run:suite
- |process suiteAndResult numTests|
+ |suiteAndResult numTests|
numTests := suite tests size.
numTests == 0 ifTrue:[
^ self
].
- process := [
+ self stop.
+
+ testProcess := [
|result incr run|
[
+ self runningHolder value:true.
self progressHolder value:0.
- self runningHolder value:true.
incr := 100 / numTests.
run := 0.
result := suite
@@ -395,19 +417,28 @@
self runningHolder value:false.
]
] newProcess.
- process resume.
+
+ testProcess priority:(Processor userBackgroundPriority).
+ testProcess resume.
"Created: / 11-03-2010 / 10:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-09-2010 / 21:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 06-07-2011 / 14:28:02 / cg"
+ "Modified: / 04-06-2012 / 19:08:40 / cg"
!
runAll
- self run: self suiteForRunAll.
+ self run: (self suiteForRunAll).
"Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-03-2010 / 13:12:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:00:14 / cg"
+!
+
+runFailed
+ self run: self suiteForRunFailed.
+
+ "Created: / 04-06-2012 / 18:32:19 / cg"
!
runWithDebug
@@ -433,6 +464,17 @@
"Created: / 05-07-2011 / 18:45:43 / cg"
"Modified: / 22-08-2011 / 09:59:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-10-2011 / 10:55:46 / cg"
+!
+
+stop
+ |p|
+
+ (p := testProcess) notNil ifTrue:[
+ testProcess := nil.
+ p terminate
+ ].
+
+ "Created: / 04-06-2012 / 18:34:07 / cg"
! !
!TestRunnerEmbedded methodsFor:'aspects'!
@@ -479,6 +521,12 @@
].
!
+notRunningHolder
+ ^ BlockValue forLogicalNot:(self runningHolder)
+
+ "Created: / 04-06-2012 / 18:38:48 / cg"
+!
+
progressHolder
"return/create the 'progressHolder' value holder (automatically generated)"
@@ -544,31 +592,55 @@
runAllEnabledHolder
- ^true
+ ^ self notRunningHolder
"Created: / 07-09-2010 / 09:15:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 18:40:46 / cg"
!
runEnabledHolder
-
^BlockValue
with:
- [:resultHolder | | result |
- (result := resultHolder value) notNil and:[result testCount > 0 ]]
+ [:result :running |
+
+ running not
+ and:[ result notNil
+ and:[ result testCount > 0 ]]
+ ]
argument: self resultHolder
+ argument: self runningHolder
"Created: / 07-09-2010 / 09:15:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 18:52:41 / cg"
+!
+
+runFailedEnabledHolder
+ ^BlockValue
+ with:
+ [:running |
+
+ |result|
+
+ result := (self resultForSuite:self suiteForRunAll).
+ running not
+ and:[ result notNil
+ and:[ result hasFailuresOrErrors ]]
+ ]
+ "/ argument: self resultHolder
+ argument: self runningHolder
+
+ "Created: / 07-09-2010 / 09:15:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 04-06-2012 / 18:28:12 / cg"
!
runningHolder
- "return/create the 'runningHolder' value holder (automatically generated)"
-
runningHolder isNil ifTrue:[
runningHolder := ValueHolder with: false.
].
^ runningHolder
"Modified: / 15-03-2010 / 20:29:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 04-06-2012 / 18:38:52 / cg"
!
selectedClassesHolder
@@ -656,6 +728,12 @@
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:selectedProtocolsHolder.
].
+!
+
+stopEnabledHolder
+ ^ self runningHolder
+
+ "Created: / 04-06-2012 / 18:29:01 / cg"
! !
!TestRunnerEmbedded methodsFor:'change & update'!
@@ -686,7 +764,7 @@
sender == Smalltalk ifTrue:[
aspect == #lastTestRunResult ifTrue:[
- (selectedTestCases notNil and:[selectedTestCases includesIdentical: param first]) ifTrue:[
+ (allTestCases includesIdentical: param first) ifTrue:[
self updateTestSuiteAndResult.
^self
]
@@ -698,24 +776,24 @@
super update:aspect with:param from: sender
"Modified: / 20-11-2011 / 12:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:03:34 / cg"
!
updateTestCases
- selectedTestCases := ((self selectedClassesHolder value ? #())
+ allTestCases := ((self selectedClassesHolder value ? #())
select:[:cls | self isTestCaseLike:cls ]).
- selectedTestCases := selectedTestCases isEmpty
- ifTrue:[ nil ]
- ifFalse:[ selectedTestCases asArray ]
+ allTestCases := allTestCases asArray
"Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:02:52 / cg"
!
updateTestSuiteAndResult
| suite suiteAndResult |
self runningHolder value ifTrue:[^self].
- selectedTestCases ifNil:[^self].
+ allTestCases isEmptyOrNil ifTrue:[^self].
suiteAndResult := SuiteAndResult
suite: (suite := self suiteForRun)
result: (self resultForSuite: suite).
@@ -723,6 +801,7 @@
"Created: / 15-03-2010 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:03:15 / cg"
!
updateVisibility
@@ -804,7 +883,7 @@
hasTestCaseSelected
- ^selectedTestCases notEmptyOrNil
+ ^allTestCases notEmptyOrNil
"Created: / 11-03-2010 / 09:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-03-2010 / 20:54:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -874,13 +953,39 @@
suiteForRunAll
|suite|
- suite := TestSuite named:(self suiteNameFromClasses: selectedTestCases).
- selectedTestCases do:[:testCase |
+ suite := TestSuite named:(self suiteNameFromClasses: allTestCases).
+ allTestCases isNil ifTrue:[
+ self updateTestCases.
+ ].
+
+ allTestCases do:[:testCase |
suite addTests:(self buildSuiteFromClass:testCase) tests
].
^suite
"Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:01:48 / cg"
+!
+
+suiteForRunFailed
+ |suite|
+
+ suite := TestSuite named:(self suiteNameFromClasses: allTestCases).
+ allTestCases do:[:testCase |
+ (self buildSuiteFromClass:testCase) tests do:[:eachTest |
+ | sel cls |
+
+ sel := eachTest selector.
+ cls := eachTest class.
+ (cls testSelectorPassed:sel) ifFalse:[
+ suite addTest:eachTest
+ ]
+ ]
+ ].
+ ^suite
+
+ "Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 04-06-2012 / 18:32:40 / cg"
! !
!TestRunnerEmbedded::SuiteAndResult class methodsFor:'instance creation'!
@@ -998,11 +1103,11 @@
!TestRunnerEmbedded class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012-01-24 22:20:06 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.23 2012-06-04 17:13:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012-01-24 22:20:06 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.23 2012-06-04 17:13:51 cg Exp $'
!
version_SVN