diff -r 25c2a13f00c5 -r 184cea584be5 Tools__TestRunner2.st --- 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 " "Modified: / 26-11-2008 / 09:38:20 / Jan Vrany " @@ -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 + ^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 @@ ^ - #(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 " ! ! -!TestRunner2 methodsFor:'accessing - lists'! +!TestRunner2 methodsFor:'accessing - menus'! + +packageListMenu + ^ self class packageListMenu + + "Created: / 06-06-2008 / 19:16:28 / Jan Vrany " + "Modified: / 23-09-2011 / 18:55:05 / cg" +! + +resultListMenu + ^ self class resultListMenu + + "Created: / 06-06-2008 / 19:16:28 / Jan Vrany " + "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 " ! ! -!TestRunner2 methodsFor:'accessing - menus'! - -packageListMenu - ^ self class packageListMenu - - "Created: / 06-06-2008 / 19:16:28 / Jan Vrany " - "Modified: / 23-09-2011 / 18:55:05 / cg" -! - -resultListMenu - ^ self class resultListMenu - - "Created: / 06-06-2008 / 19:16:28 / Jan Vrany " - "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 " ! ! @@ -2230,6 +2304,10 @@ "Modified: / 07-02-2010 / 14:36:00 / Jan Vrany " ! +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: $' + ^ '$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 $' ! !