--- a/Tools__TestRunnerEmbedded.st Fri Jan 27 22:18:53 2012 +0100
+++ b/Tools__TestRunnerEmbedded.st Sun Jan 29 12:53:39 2012 +0000
@@ -323,7 +323,7 @@
| suiteAndResult suite test result |
suiteAndResult := self resultHolder value.
- suite := suiteAndResult suiteForRun.
+ suite := suiteAndResult suite.
suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
test := suiteAndResult suite tests anyOne.
[
@@ -337,25 +337,18 @@
] 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|
- resultHolder value isNil ifTrue:[
- suite := self suiteForRun
- ] ifFalse:[
- suite := resultHolder value suiteForRun
- ].
- self run:suite
+ self run: resultHolder value suite
"Created: / 10-03-2010 / 19:42:08 / 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"
+ "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
run:suite
@@ -414,25 +407,64 @@
"/ 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|
+ | suiteAndResult suite result|
suiteAndResult := self resultHolder value.
- suiteAndResult isNil ifTrue:[
- suite := self suiteForRun.
- ] ifFalse:[
- suite := suiteAndResult suiteForRun.
- ].
+ suite := suiteAndResult suite.
+ result := suiteAndResult result.
+
+ suite tests do:[:each |
+ |errorHappened failureHappened cls|
- suite run: TestResultForRunWithDebug new
+ 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.')
+ ]
+ ].
+ 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'!
@@ -684,31 +716,22 @@
^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: / 20-11-2011 / 12:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-09-2010 / 08:18:11 / 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: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateTestSuiteAndResult
@@ -736,26 +759,12 @@
!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'!
@@ -818,18 +827,17 @@
result := TestResult new.
suite tests do:[:test |
- | sel cls |
+ |sel|
sel := test selector.
- cls := test class.
- (cls testSelectorPassed:sel) ifTrue:[
- result passedOutcomes add: (cls rememberedOutcomeFor: sel)
+ (test class testSelectorPassed:sel) ifTrue:[
+ result passed add:test
] ifFalse:[
- (cls testSelectorError:sel) ifTrue:[
- result errorOutcomes add:(cls rememberedOutcomeFor: sel)
+ (test class testSelectorError:sel) ifTrue:[
+ result errors add:test
] ifFalse:[
- (cls testSelectorFailed:sel) ifTrue:[
- result failureOutcomes add:(cls rememberedOutcomeFor: sel)
+ (test class testSelectorFailed:sel) ifTrue:[
+ result failures add:test
]
]
]
@@ -838,7 +846,6 @@
"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
@@ -947,17 +954,6 @@
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
@@ -998,13 +994,13 @@
!TestRunnerEmbedded class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012-01-24 22:20:06 vrany Exp $'
+ ^ '$Id: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.15 2011/08/09 21:57:18 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.15 2011/08/09 21:57:18 cg Exp §'
!
version_SVN
- ^ '§Id§'
-! !
+ ^ '$Id$'
+! !
\ No newline at end of file