diff -r 3d57003855a7 -r 4bde08cebd48 Tools__TestRunnerEmbedded.st --- 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 " + "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany " "Modified: / 05-07-2011 / 19:05:31 / cg" "Modified: / 07-07-2011 / 11:33:48 / Jan Vrany " "Modified (format): / 02-08-2011 / 18:18:38 / cg" - "Modified: / 22-08-2011 / 09:59:10 / Jan Vrany " ! 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 " - "Modified: / 22-08-2011 / 09:58:33 / Jan Vrany " - "Modified: / 09-10-2011 / 10:56:39 / cg" + "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany " ! 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 " "Created: / 05-07-2011 / 18:45:43 / cg" - "Modified: / 22-08-2011 / 09:59:46 / Jan Vrany " - "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 " + "Modified: / 07-09-2010 / 08:18:11 / Jan Vrany " ! 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 " - "Modified: / 24-01-2012 / 22:09:14 / Jan Vrany " + "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany " ! updateTestSuiteAndResult @@ -736,26 +759,12 @@ !TestRunnerEmbedded methodsFor:'hooks'! -commonPostOpen - - Smalltalk addDependent: self. - - "Created: / 17-11-2011 / 20:59:47 / Jan Vrany " -! - postBuildRunnerPanel: aView runnerPanel := aView. runnerPanel backgroundColor: self resultBackgroundColorAspect value "Created: / 15-03-2010 / 14:26:15 / Jan Vrany " -! - -releaseAsSubCanvas - - Smalltalk removeDependent: self. - - "Created: / 17-11-2011 / 21:03:18 / Jan Vrany " ! ! !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 " "Modified: / 02-08-2011 / 18:20:00 / cg" - "Modified: / 20-08-2011 / 14:30:36 / Jan Vrany " ! 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 " -! - 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