--- a/NewSystemBrowser.st Wed Aug 04 18:36:56 2010 +0200
+++ b/NewSystemBrowser.st Sun Aug 08 05:22:32 2010 +0200
@@ -26749,85 +26749,90 @@
runTestCasesWithDebug:withDebug protocols:protocolsOrNil
"run selected testcases"
+ |t|
+
[
- self selectedNonAbstractTestCaseClassesDo:[:cls |
- |isCompleteSuite suite selectors toRun result|
-
- (protocolsOrNil isEmptyOrNil
- or:[protocolsOrNil includes:BrowserList nameListEntryForALL]) ifTrue:[
- isCompleteSuite := true.
- suite := cls buildSuite.
- ] ifFalse:[
- isCompleteSuite := false.
- (selectors := self selectedSelectors) isEmptyOrNil ifTrue:[
- selectors := OrderedCollection new.
- self selectedProtocolMethodsDo:[:cls :category :sel :mthd |
- ((cls isSubclassOf:TestCase) and:[cls isAbstract not]) ifTrue:[
- (cls isTestSelector:sel) ifTrue:[
- selectors add:sel
+ t := Time millisecondsToRun:[
+ self selectedNonAbstractTestCaseClassesDo:[:cls |
+ |isCompleteSuite suite selectors toRun result|
+
+ (protocolsOrNil isEmptyOrNil
+ or:[protocolsOrNil includes:BrowserList nameListEntryForALL]) ifTrue:[
+ isCompleteSuite := true.
+ suite := cls buildSuite.
+ ] ifFalse:[
+ isCompleteSuite := false.
+ (selectors := self selectedSelectors) isEmptyOrNil ifTrue:[
+ selectors := OrderedCollection new.
+ self selectedProtocolMethodsDo:[:cls :category :sel :mthd |
+ ((cls isSubclassOf:TestCase) and:[cls isAbstract not]) ifTrue:[
+ (cls isTestSelector:sel) ifTrue:[
+ selectors add:sel
+ ].
].
].
].
- ].
- suite := cls buildSuiteFromMethods:selectors.
- ].
-
- self busyLabel:'running test %1 ...' with:cls name.
- toRun := suite tests size.
- result := TestResult new.
- withDebug ifTrue:[
- suite tests do:[:each |
- |errorHappened|
-
- errorHappened := false.
- GenericException handle:[:ex |
- (HaltInterrupt accepts:ex signal) ifFalse:[
- ex signal == NoHandlerError ifFalse:[
- errorHappened := true.
- ]
- ].
- ex reject.
- ] do:[
- each debug
- ].
- errorHappened ifTrue:[
- cls rememberFailedTest:each selector.
- result failures add:each.
- ] ifFalse:[
- cls rememberPassedTest:each selector.
- result passed add:each.
- ]
- ]
- ] ifFalse:[
- suite
- run: result
- beforeEachTestCaseDo:[:case :result |
- self showInfo:('To Run: %1 ; executing %2...' bindWith:toRun with:case printString).
- ]
- afterEachTestCaseDo:[:case :result |
- toRun := toRun - 1.
- ].
-
- cls rememberPassedTestsFromResult:result.
- cls rememberFailedTestsFromResult:result.
- ].
-
- result hasPassed ifTrue:[
- result passedCount > 0 ifTrue:[
- isCompleteSuite ifTrue:[ cls rememberPassedTestRun ].
- self showInfo:(result printString asText colorizeAllWith:Color black on:Color green).
- ].
- ] ifFalse:[
- isCompleteSuite ifTrue:[ cls rememberFailedTestRun ].
- self showInfo:(result printString asText colorizeAllWith:Color black on:Color red).
+ suite := cls buildSuiteFromMethods:selectors.
+ ].
+
+ self busyLabel:'running test %1 ...' with:cls name.
+ toRun := suite tests size.
+ result := TestResult new.
+ withDebug ifTrue:[
+ suite tests do:[:each |
+ |errorHappened|
+
+ errorHappened := false.
+ GenericException handle:[:ex |
+ (HaltInterrupt accepts:ex signal) ifFalse:[
+ ex signal == NoHandlerError ifFalse:[
+ errorHappened := true.
+ ]
+ ].
+ ex reject.
+ ] do:[
+ each debug
+ ].
+ errorHappened ifTrue:[
+ cls rememberFailedTest:each selector.
+ result failures add:each.
+ ] ifFalse:[
+ cls rememberPassedTest:each selector.
+ result passed add:each.
+ ]
+ ]
+ ] ifFalse:[
+ suite
+ run: result
+ beforeEachTestCaseDo:[:case :result |
+ self showInfo:('To Run: %1 ; executing %2...' bindWith:toRun with:case printString).
+ ]
+ afterEachTestCaseDo:[:case :result |
+ toRun := toRun - 1.
+ ].
+
+ cls rememberPassedTestsFromResult:result.
+ cls rememberFailedTestsFromResult:result.
+ ].
+
+ result hasPassed ifTrue:[
+ result passedCount > 0 ifTrue:[
+ isCompleteSuite ifTrue:[ cls rememberPassedTestRun ].
+ self showInfo:(result printString asText colorizeAllWith:Color black on:Color green).
+ ].
+ ] ifFalse:[
+ isCompleteSuite ifTrue:[ cls rememberFailedTestRun ].
+ self showInfo:(result printString asText colorizeAllWith:Color black on:Color red).
+ ].
].
].
] ensure:[
self normalLabel.
- ]
+ ].
+ Transcript showCR:(TimeDuration new setMilliseconds:t).
"Created: / 05-08-2006 / 17:32:06 / cg"
- "Modified: / 22-11-2006 / 18:13:42 / cg"
+ "Modified: / 08-08-2010 / 05:15:50 / cg"
!
selectedNonAbstractTestCaseClassesDo:aBlock
@@ -44520,11 +44525,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1469 2010-07-26 09:59:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1470 2010-08-08 03:22:32 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1469 2010-07-26 09:59:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1470 2010-08-08 03:22:32 cg Exp $'
! !
NewSystemBrowser initialize!