--- a/Tools__NewSystemBrowser.st Thu Nov 08 00:04:35 2012 +0100
+++ b/Tools__NewSystemBrowser.st Thu Nov 08 00:15:47 2012 +0100
@@ -463,6 +463,30 @@
^ spec.
"Modified: / 09-08-2012 / 09:37:10 / cg"
+!
+
+helpSpec
+ "This resource specification was automatically generated
+ by the UIHelpTool of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIHelpTool may not be able to read the specification."
+
+ "
+ UIHelpTool openOnClass:Tools::NewSystemBrowser
+ "
+
+ <resource: #help>
+
+ ^ super helpSpec addPairsFrom:#(
+
+#runTestCases
+''
+
+#runTestCasesWithDebug
+''
+
+)
! !
!NewSystemBrowser class methodsFor:'image specs'!
@@ -17228,13 +17252,12 @@
(MenuItem
label: '-'
)
- (MenuItem
- enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
- label: 'Recompile all Methods with Instrumentation'
- itemValue: classMenuRecompileInstrumented
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
+ (MenuItem
+ enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
+ label: 'Recompile all Methods with Instrumentation'
+ itemValue: classMenuRecompileInstrumented
+ showBusyCursorWhilePerforming: true
+ )
)
nil
nil
@@ -17289,7 +17312,7 @@
label: 'Run Tests'
itemValue: runTestCases
isButton: true
- isVisible: hasAnyTestCaseSelectedHolder
+ isVisible: hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24Icon)
showBusyCursorWhilePerforming: true
)
@@ -17298,7 +17321,7 @@
label: 'Debug Tests'
itemValue: runTestCasesWithDebug
isButton: true
- isVisible: hasAnyTestCaseSelectedHolder
+ isVisible: hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24DebugIcon)
showBusyCursorWhilePerforming: true
)
@@ -17342,11 +17365,11 @@
(MenuItem
activeHelpKey: showCodeCoverage
enabled: hasInstrumentedMethodSelectedHolder
- isVisible: false
label: 'ShowCoverage'
itemValue: codeMenuShowCoverage
isButton: true
startGroup: right
+ isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary showCodeCoverage16x16Icon)
)
(MenuItem
@@ -19770,6 +19793,12 @@
"Modified: / 28-02-2012 / 16:49:32 / cg"
!
+hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
+ ^ BlockValue
+ with:[:b | b and:[UserPreferences current showEmbeddedTestRunnerInBrowser not]]
+ argument:(self hasAnyTestCaseSelectedHolder)
+!
+
hasAnyTestCaseSelectedHolder
|holder|
@@ -36779,70 +36808,68 @@
embeddedTestRunner notNil ifTrue:[
withDebug ifTrue:[
embeddedTestRunner runWithDebug
- "/ embeddedTestRunner debug
] ifFalse:[
embeddedTestRunner run
].
^ self
].
- "/ original code
[
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 isTestCaseLike and:[ cls isAbstract not ]) ifTrue:[
- (cls isTestSelector:sel) ifTrue:[
- selectors add:sel
- ].
- ].
- ].
+ [
+ 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 isTestCaseLike 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.
- withDebug ifTrue:[
- result := TestResultForRunWithDebug new.
- ] ifFalse:[
- result := TestResult defaultResultClass new.
].
- suite
- run:result
- beforeEachDo:[:case :result |
- self showInfo:('To Run: %1 ; executing %2...' bindWith:toRun
- with:case printString).
- ]
- afterEachDo:[:case :result | toRun := toRun - 1. ].
-
- result hasPassed ifTrue:[
- result passedCount > 0 ifTrue:[
- self showInfo:(result printString asText colorizeAllWith:Color black
- on:Color green).
- ].
- ] ifFalse:[
- 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.
+ withDebug ifTrue:[
+ result := TestResultForRunWithDebug new.
+ ] ifFalse:[
+ result := TestResult defaultResultClass new.
+ ].
+ suite
+ run:result
+ beforeEachDo:[:case :result |
+ self showInfo:('To Run: %1 ; executing %2...'
+ bindWith:toRun
+ with:case printString).
+ ]
+ afterEachDo:[:case :result | toRun := toRun - 1. ].
+
+ Transcript showCR:(result printString).
+ result hasPassed ifTrue:[
+ result passedCount > 0 ifTrue:[
+ self showInfo:(result printString asText colorizeAllWith:Color black on:Color green).
].
- ].
- ].
- ] ensure:[ self normalLabel. ].
- Transcript showCR:(TimeDuration new setMilliseconds:t).
+ ] ifFalse:[
+ self showInfo:(result printString asText colorizeAllWith:Color black on:Color red).
+ ].
+ ].
+ ].
+ ] ensure:[
+ self normalLabel.
+ ].
+ Transcript show:'test execution time: '; showCR:(TimeDuration new setMilliseconds:t).
"Created: / 05-08-2006 / 17:32:06 / cg"
"Modified: / 06-07-2011 / 14:07:52 / cg"
@@ -58002,11 +58029,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1819 2012-11-07 19:33:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1820 2012-11-07 23:15:47 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1819 2012-11-07 19:33:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1820 2012-11-07 23:15:47 cg Exp $'
!
version_SVN