--- a/Tools__TestRunnerEmbedded.st Sun Jan 29 12:56:58 2012 +0000
+++ b/Tools__TestRunnerEmbedded.st Sun Jan 29 15:33:37 2012 +0000
@@ -323,7 +323,7 @@
| suiteAndResult suite test result |
suiteAndResult := self resultHolder value.
- suite := suiteAndResult suite.
+ suite := suiteAndResult suiteForRun.
suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
test := suiteAndResult suite tests anyOne.
[
@@ -337,18 +337,25 @@
] fork
"Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-07-2011 / 19:05:31 / cg"
"Modified: / 07-07-2011 / 11:33:48 / Jan Vrany <jan.vrant@fit.cvut,cz>"
"Modified (format): / 02-08-2011 / 18:18:38 / cg"
+ "Modified: / 22-08-2011 / 09:59:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
run
+ |suite|
- self run: resultHolder value suite
+ resultHolder value isNil ifTrue:[
+ suite := self suiteForRun
+ ] ifFalse:[
+ suite := resultHolder value suiteForRun
+ ].
+ self run:suite
"Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-08-2011 / 09:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 09-10-2011 / 10:56:39 / cg"
!
run:suite
@@ -407,64 +414,25 @@
"/ cg: I really do not want to run them twice to get a debugger
"/ - I want to run them either with a debugger coming right away, or not.
- | suiteAndResult suite result|
+ | suiteAndResult suite|
suiteAndResult := self resultHolder value.
- suite := suiteAndResult suite.
- result := suiteAndResult result.
-
- suite tests do:[:each |
- |errorHappened failureHappened cls|
+ suiteAndResult isNil ifTrue:[
+ suite := self suiteForRun.
+ ] ifFalse:[
+ suite := suiteAndResult suiteForRun.
+ ].
- errorHappened := failureHappened := false.
- GenericException
- handle:[:ex |
- (HaltInterrupt accepts:ex signal) ifFalse:[
- ex signal == NoHandlerError ifFalse:[
- (TestFailure accepts:ex signal) ifTrue:[
- failureHappened := true
- ] ifFalse:[
- errorHappened := true.
- ].
- ]
- ].
- ex reject.
- ]
- do:[
- infoHolder notNil ifTrue:[
- infoHolder value:('Running "%1-%2"...'
- bindWith:each name
- with:each getTestName allBold)
- ].
- each debug.
- infoHolder notNil ifTrue:[
- infoHolder value:('Done.')
- ]
- ].
+ suite run: TestResultForRunWithDebug new
- result failures remove:each ifAbsent:[].
- result passed remove:each ifAbsent:[].
- result errors remove:each ifAbsent:[].
- failureHappened ifTrue:[
- each class rememberErrorTest:each selector.
- result errors add:each.
- ] ifFalse:[
- errorHappened ifTrue:[
- each class rememberFailedTest:each selector.
- result failures add:each.
- ] ifFalse:[
- each class rememberPassedTest:each selector.
- result passed add:each.
- ]
- ]
- ]
"/ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
"/ [suiteAndResult suite tests anyOne debug] fork
- "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"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"
! !
!TestRunnerEmbedded methodsFor:'aspects'!
@@ -716,22 +684,31 @@
^self
].
+ sender == Smalltalk ifTrue:[
+ aspect == #lastTestRunResult ifTrue:[
+ (selectedTestCases notNil and:[selectedTestCases includesIdentical: param first]) ifTrue:[
+ self updateTestSuiteAndResult.
+ ^self
+ ]
+ ]
+ ].
+
super update:aspect with:param from: sender
- "Modified: / 07-09-2010 / 08:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-11-2011 / 12:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateTestCases
- selectedTestCases := (self selectedClassesHolder value
+ selectedTestCases := ((self selectedClassesHolder value ? #())
select:[:cls | self isTestCaseLike:cls ]).
selectedTestCases := selectedTestCases isEmpty
ifTrue:[ nil ]
ifFalse:[ selectedTestCases asArray ]
"Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateTestSuiteAndResult
@@ -759,12 +736,26 @@
!TestRunnerEmbedded methodsFor:'hooks'!
+commonPostOpen
+
+ Smalltalk addDependent: self.
+
+ "Created: / 17-11-2011 / 20:59:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
postBuildRunnerPanel: aView
runnerPanel := aView.
runnerPanel backgroundColor: self resultBackgroundColorAspect value
"Created: / 15-03-2010 / 14:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+releaseAsSubCanvas
+
+ Smalltalk removeDependent: self.
+
+ "Created: / 17-11-2011 / 21:03:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestRunnerEmbedded methodsFor:'private'!
@@ -827,17 +818,18 @@
result := TestResult new.
suite tests do:[:test |
- |sel|
+ | sel cls |
sel := test selector.
- (test class testSelectorPassed:sel) ifTrue:[
- result passed add:test
+ cls := test class.
+ (cls testSelectorPassed:sel) ifTrue:[
+ result passedOutcomes add: (cls rememberedOutcomeFor: sel)
] ifFalse:[
- (test class testSelectorError:sel) ifTrue:[
- result errors add:test
+ (cls testSelectorError:sel) ifTrue:[
+ result errorOutcomes add:(cls rememberedOutcomeFor: sel)
] ifFalse:[
- (test class testSelectorFailed:sel) ifTrue:[
- result failures add:test
+ (cls testSelectorFailed:sel) ifTrue:[
+ result failureOutcomes add:(cls rememberedOutcomeFor: sel)
]
]
]
@@ -846,6 +838,7 @@
"Created: / 15-03-2010 / 19:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-08-2011 / 18:20:00 / cg"
+ "Modified: / 20-08-2011 / 14:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
suiteForRun
@@ -954,6 +947,17 @@
suite := aTestSuite.
!
+suiteForRun
+
+ | suiteForRun |
+ suiteForRun := suite class named: suite name.
+ suiteForRun addTests:
+ (suite tests collect:[:testCase|testCase class selector: testCase selector]).
+ ^suiteForRun
+
+ "Created: / 22-08-2011 / 09:56:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testCount
^suite tests size
@@ -994,13 +998,13 @@
!TestRunnerEmbedded class methodsFor:'documentation'!
version
- ^ '$Id: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.15 2011/08/09 21:57:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012/01/24 22:20:06 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.15 2011/08/09 21:57:18 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012/01/24 22:20:06 vrany Exp §'
!
version_SVN
^ '$Id$'
-! !
\ No newline at end of file
+! !