--- a/Tools__TestRunner2.st Sun Jan 12 23:30:25 2014 +0000
+++ b/Tools__TestRunner2.st Wed Apr 01 10:38:01 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
@@ -96,7 +98,12 @@
initialize
self initializeHistory.
- Smalltalk addStartBlock: [self installInLauncher]
+ "/ mhmh - somehow, this does not work if done immediately
+ "/ (probably Launcher is not yet initialized in some situations).
+ "/ therefore, do it delayed.
+ Smalltalk addStartBlock: [
+ self installInLauncher
+ ]
"Created: / 09-06-2008 / 11:11:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 26-11-2008 / 09:38:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
@@ -119,17 +126,18 @@
"/ NewLauncher removeUserTool:#TestRunner2.
- "Class may be changed, and we want to start the changed class"
+ "test runner class may be changed, and we want to start the changed class,
+ not the one which installed the menu item"
"/ action := (MessageSend receiver:(Smalltalk at:self name) selector:#open).
action := [ UserPreferences current testRunnerClass "(Smalltalk at:self name)" open ].
"Install in Tools menu"
- menuItem := (MenuItem label:'SUnit Test Runner (enhanced)')
- nameKey:#TestRunner2;
- labelImage:self startSUnitIcon;
- value:action;
- isButton:false.
+ menuItem := MenuItem label:'SUnit Test Runner (enhanced)' itemValue:action.
+ menuItem
+ nameKey:#TestRunner2;
+ labelImage:self startSUnitIcon;
+ isButton:false.
NewLauncher
addMenuItem:menuItem
from:self
@@ -138,13 +146,12 @@
space:false.
"Install in Toolbar"
- menuItem := (MenuItem new)
- nameKey:#TestRunner2;
- label: 'SUnit Test Runner (enhanced)';
- activeHelpKey: #openTestRunner;
- icon:self startSUnitIcon;
- value:action;
- isButton:true.
+ menuItem := MenuItem label: 'SUnit Test Runner (enhanced)' itemValue:action.
+ menuItem
+ nameKey:#TestRunner2;
+ activeHelpKey: #openTestRunner;
+ icon:self startSUnitIcon;
+ isButton:true.
NewLauncher
addMenuItem:menuItem
from:self
@@ -189,6 +196,7 @@
!TestRunner2 class methodsFor:'image specs'!
defaultIcon
+ <resource: #programImage>
^ToolbarIconLibrary sUnit24x24Icon
@@ -462,7 +470,7 @@
label: 'N/A'
name: 'Mode'
layout: (LayoutFrame 0 0 0 0 0 1 0 0.6)
- style: (FontDescription Arial bold roman 14)
+ style: (FontDescription arial bold roman 14)
labelChannel: modeHolder
)
(LabelSpec
@@ -599,76 +607,79 @@
<resource: #canvas>
^
- #(FullSpec
- name: windowSpec
- window:
- (WindowSpec
- label: 'Test Runner Tool'
- name: 'Test Runner Tool'
- min: (Point 0 0)
- bounds: (Rectangle 0 0 717 412)
- menu: mainMenu
- icon: defaultIcon
- )
- component:
- (SpecCollection
- collection: (
- (UISubSpecification
- name: 'ResultPane'
- layout: (LayoutFrame 0 0 0 0 0 1 100 0)
- minorKey: resultPaneSpec
- )
- (VariableHorizontalPanelSpec
- name: 'ListPane'
- layout: (LayoutFrame 0 0 100 0 0 1 -30 1)
- showHandle: true
- snapMode: both
- handlePosition: right
- component:
- (SpecCollection
- collection: (
- (NoteBookViewSpec
- name: 'ClassOrPackageTab'
- model: classCategoryOrPackageTabIndexHolder
- menu: classCategoryOrPackageTabList
- useIndex: true
- fitLastRow: false
- )
- (TransparentBoxSpec
- name: 'ClassListBox'
- component:
- (SpecCollection
- collection: (
- (SubCanvasSpec
- name: 'ClassList'
- layout: (LayoutFrame 0 0 25 0 0 1 0 1)
- hasHorizontalScrollBar: false
- hasVerticalScrollBar: false
- clientKey: classList
- createNewBuilder: false
- )
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'Test Runner Tool'
+ name: 'Test Runner Tool'
+ min: (Point 0 0)
+ bounds: (Rectangle 0 0 717 412)
+ menu: mainMenu
+ icon: defaultIcon
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (UISubSpecification
+ name: 'ResultPane'
+ layout: (LayoutFrame 0 0 0 0 0 1 100 0)
+ minorKey: resultPaneSpec
+ )
+ (VariableHorizontalPanelSpec
+ name: 'ListPane'
+ layout: (LayoutFrame 0 0 100 0 0 1 -30 1)
+ showHandle: true
+ snapMode: both
+ handlePosition: right
+ component:
+ (SpecCollection
+ collection: (
+ (NoteBookViewSpec
+ name: 'ClassOrPackageTab'
+ model: classCategoryOrPackageTabIndexHolder
+ menu: classCategoryOrPackageTabList
+ useIndex: true
+ fitLastRow: false
+ translateLabel: true
+ )
+ (TransparentBoxSpec
+ name: 'ClassListBox'
+ component:
+ (SpecCollection
+ collection: (
+ (SubCanvasSpec
+ name: 'ClassList'
+ layout: (LayoutFrame 0 0 25 0 0 1 0 1)
+ hasHorizontalScrollBar: false
+ hasVerticalScrollBar: false
+ clientKey: classList
+ createNewBuilder: false
)
-
- )
- )
- (NoteBookViewSpec
- name: 'NoteBook2'
- menu: resultAndHistoryTabList
- )
+ )
+
+ )
+ )
+ (NoteBookViewSpec
+ name: 'NoteBook2'
+ menu: resultAndHistoryTabList
+ translateLabel: true
)
-
- )
- handles: (Any 0.33333333333333 0.66666666666667 1.0)
- )
- (UISubSpecification
- name: 'ButtonPane'
- layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
- minorKey: buttonPaneSpec
- )
+ )
+
+ )
+ handles: (Any 0.33333333333332998 0.66666666666666996 1.0)
)
-
- )
- )
+ (UISubSpecification
+ name: 'ButtonPane'
+ layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
+ minorKey: buttonPaneSpec
+ keepSpaceForOSXResizeHandleH: true
+ )
+ )
+
+ )
+ )
!
windowSpec_old
@@ -905,9 +916,9 @@
)
)
(MenuItem
- label: 'Help'
+ label: 'MENU_Help'
+ startGroup: conditionalRight
translateLabel: true
- startGroup: conditionalRight
submenu:
(Menu
(
@@ -1004,6 +1015,14 @@
itemValue: resultListMenuBrowse
translateLabel: true
)
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Copy List'
+ itemValue: resultListMenuCopyList
+ translateLabel: true
+ )
)
nil
nil
@@ -1128,12 +1147,28 @@
package := self theSingleSelectedProject.
package ifNil:[^nil].
- ^Smalltalk at:(ProjectDefinition initialClassNameForDefinitionOf:package) asSymbol
+ ^Smalltalk at:(ProjectDefinition projectDefinitionClassNameForDefinitionOf:package) asSymbol
"Created: / 06-06-2008 / 20:08:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
-!TestRunner2 methodsFor:'accessing - lists'!
+!TestRunner2 methodsFor:'accessing - menus'!
+
+packageListMenu
+ ^ self class packageListMenu
+
+ "Created: / 06-06-2008 / 19:16:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 23-09-2011 / 18:55:05 / cg"
+!
+
+resultListMenu
+ ^ self class resultListMenu
+
+ "Created: / 06-06-2008 / 19:16:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 23-09-2011 / 18:53:46 / cg"
+! !
+
+!TestRunner2 methodsFor:'accessing-lists'!
allTestCategories
@@ -1215,22 +1250,6 @@
"Modified: / 28-02-2011 / 21:13:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!TestRunner2 methodsFor:'accessing - menus'!
-
-packageListMenu
- ^ self class packageListMenu
-
- "Created: / 06-06-2008 / 19:16:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 23-09-2011 / 18:55:05 / cg"
-!
-
-resultListMenu
- ^ self class resultListMenu
-
- "Created: / 06-06-2008 / 19:16:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Created: / 23-09-2011 / 18:53:46 / cg"
-! !
-
!TestRunner2 methodsFor:'actions'!
classSelectionChanged
@@ -1238,7 +1257,7 @@
selectedTestCaseHasCoveredClasses :=
self selectedTestCases
- conform:[:eachClass | eachClass asTestCase coveredClasses notEmpty].
+ contains:[:eachClass | eachClass asTestCase coveredClasses notEmpty].
(builder componentAt:#RunCoverage) enabled:selectedTestCaseHasCoveredClasses.
self selectedTestCaseHasCoveredClassesHolder value:selectedTestCaseHasCoveredClasses.
@@ -1288,14 +1307,17 @@
!
runCoverageAction
- | allCoveredClasses browser result|
+ | coveredClasses allCoveredClasses browser result|
+
+ coveredClasses := Set new.
+ self selectedTestCases do:[:eachClass |
+ eachClass coveredClasses do:[:cls | cls autoload].
+ coveredClasses addAll:eachClass coveredClasses.
+ ].
allCoveredClasses := Set new.
- self selectedTestCases do:[:eachClass |
- eachClass coveredClasses do:[:cls | cls autoload].
- eachClass coveredClasses do:[:eachCoveredClass |
- allCoveredClasses addAll:(eachCoveredClass withAllPrivateClasses).
- ].
+ coveredClasses do:[:eachCoveredClass |
+ allCoveredClasses addAll:(eachCoveredClass withAllPrivateClasses).
].
(lastBrowser notNil
@@ -1311,8 +1333,10 @@
browser selectClasses:allCoveredClasses.
browser window topView raise.
- allCoveredClasses do:[:eachClass |
- browser recompileClassWithInstrumentation:eachClass
+ self withWaitCursorDo:[
+ allCoveredClasses do:[:eachClass |
+ browser recompileClassWithInstrumentation:eachClass
+ ].
].
browser infoLabelHolder value:nil.
@@ -1441,16 +1465,16 @@
!
classListMenuBrowseCoveredClasses
- |setOfCoveredClasses|
+ |setOfCoveredClasses setOfAllCoveredClasses|
setOfCoveredClasses := Set new.
(self selectedTestSuite tests collect:[:each | each class]) do:[:eachTestClass |
- eachTestClass coveredClasses do:[:eachCoveredClass |
- setOfCoveredClasses addAll:(eachCoveredClass withAllPrivateClasses)
- ].
+ setOfCoveredClasses addAll:eachTestClass coveredClasses.
].
-
- UserPreferences systemBrowserClass browseClasses:setOfCoveredClasses
+ setOfAllCoveredClasses := Set new.
+ setOfCoveredClasses do:[:eachCoveredClass | setOfAllCoveredClasses addAll:(eachCoveredClass withAllPrivateClasses)].
+
+ UserPreferences systemBrowserClass browseClasses:setOfAllCoveredClasses
"Created: / 30-06-2011 / 22:02:26 / cg"
!
@@ -1512,10 +1536,56 @@
!
resultListMenuBrowse
- UserPreferences systemBrowserClass
- openInClass: (self selectedResultHolder value test class) selector:(self selectedResultHolder value test selector).
+ |rslt test cls selector|
+
+ rslt := self selectedResultHolder value.
+ test := rslt test.
+ test notNil ifTrue:[
+ cls := test class.
+ selector := test selector.
+ ] ifFalse:[
+ cls := Smalltalk classNamed:rslt rawLabel
+ ].
+
+ cls notNil ifTrue:[
+ UserPreferences systemBrowserClass
+ openInClass: cls
+ selector:selector.
+ ].
"Created: / 23-09-2011 / 18:55:50 / cg"
+!
+
+resultListMenuCopyList
+ |rslt passed failures errors text|
+
+ rslt := resultHolder value.
+ rslt isNil ifTrue:[^ self].
+
+ passed := OrderedCollection new.
+ failures := OrderedCollection new.
+ errors := OrderedCollection new.
+
+ rslt collectAll:[:each |
+ passed addAll:each passed.
+ failures addAll:each failures.
+ errors addAll:each errors.
+ ].
+ text := String streamContents:[:s |
+ s nextPutLine:('errors: %1' bindWith:errors size).
+ errors do:[:each |
+ s spaces:4; nextPutLine:each printString
+ ].
+ s nextPutLine:('failures: %1' bindWith:failures size).
+ failures do:[:each |
+ s spaces:4; nextPutLine:each printString
+ ].
+ s nextPutLine:('passed: %1' bindWith:passed size).
+ passed do:[:each |
+ s spaces:4; nextPutLine:each printString
+ ].
+ ].
+ self window setClipboardText:text
! !
!TestRunner2 methodsFor:'aspects'!
@@ -1764,19 +1834,23 @@
!
displayResult: aTestResult keepFailures: keepFailures keepErrors: keepErrors
-
-
- self resultHolder value: (Array with: aTestResult).
-
- aTestResult hasPassed
- ifTrue:[self displayPass: aTestResult]
- ifFalse:[self displayFail: aTestResult].
- keepFailures ifFalse:
- [failureListHolder value: (aTestResult failures
- asSortedCollection:[:a :b|a printString < b printString])].
- keepErrors ifFalse:
- [errorListHolder value: (aTestResult errors
- asSortedCollection:[:a :b|a printString < b printString])].
+ |sortByPrintString|
+
+ resultHolder value: (Array with: aTestResult).
+
+ aTestResult hasPassed ifTrue:[
+ self displayPass: aTestResult
+ ] ifFalse:[
+ self displayFail: aTestResult
+ ].
+ sortByPrintString := [:a :b|a printString < b printString].
+
+ keepFailures ifFalse:[
+ failureListHolder value: (aTestResult failures asSortedCollection:sortByPrintString)
+ ].
+ keepErrors ifFalse:[
+ errorListHolder value: (aTestResult errors asSortedCollection:sortByPrintString)
+ ].
self repairDamage
"Modified: / 21-06-2000 / 12:14:52 / Sames"
@@ -1856,7 +1930,7 @@
!TestRunner2::ClassList class methodsFor:'documentation'!
version
- ^'$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.43 2013-07-30 17:34:24 cg Exp $'
+ ^'$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.64 2015-02-28 20:35:02 cg Exp $'
! !
!TestRunner2::ClassList methodsFor:'private'!
@@ -2176,8 +2250,8 @@
"/ please change as required (and remove this comment)
PassedText := ' [passed]' asText colorizeAllWith: Tools::TestRunner2 passedColor darker.
- FailedText := ' [failed]' asText colorizeAllWith: Tools::TestRunner2 failedColor darker.
- ErrorText := ' [error]' asText colorizeAllWith: Tools::TestRunner2 errorColor darker.
+ FailedText := ' [','failed' allBold,']' asText colorizeAllWith: Tools::TestRunner2 failedColor "darker".
+ ErrorText := ' [','error' allBold,']' asText colorizeAllWith: Tools::TestRunner2 errorColor "darker".
"Modified: / 07-02-2010 / 15:06:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -2230,6 +2304,10 @@
"Modified: / 07-02-2010 / 14:36:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+rawLabel
+ ^ label.
+!
+
result
result ifNil:
@@ -2357,20 +2435,15 @@
!TestRunner2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.43 2013-07-30 17:34:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.64 2015-02-28 20:35:02 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.43 2013-07-30 17:34:24 cg Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.64 2015-02-28 20:35:02 cg Exp $'
!
version_SVN
- ^ '$Id: Tools__TestRunner2.st,v 1.43 2013-07-30 17:34:24 cg Exp $'
+ ^ '$Id: Tools__TestRunner2.st,v 1.64 2015-02-28 20:35:02 cg Exp $'
! !