--- a/Tools__TestRunner2.st	Mon Jul 04 22:47:37 2011 +0200
+++ b/Tools__TestRunner2.st	Mon Jul 04 23:36:38 2011 +0200
@@ -202,17 +202,25 @@
                     model: runSelectedAction
                     enableChannel: hasTestCasesAspect
                     disabledLogo: 'Run Selected'
-                    extent: (Point 123 44)
+                    extent: (Point 98 44)
                   )
                  (ActionButtonSpec
-                    label: 'Run Profiled'
+                    label: 'Profiled'
                     name: 'RunProfiled'
                     translateLabel: true
                     tabable: true
                     model: runProfiledAction
                     initiallyDisabled: true
-                    disabledLogo: 'Run Profiled'
-                    extent: (Point 123 44)
+                    extent: (Point 98 44)
+                  )
+                 (ActionButtonSpec
+                    label: 'Coverage'
+                    name: 'RunCoverage'
+                    translateLabel: true
+                    tabable: true
+                    model: runCoverageAction
+                    initiallyDisabled: true
+                    extent: (Point 99 44)
                   )
                  (ActionButtonSpec
                     label: 'Run Failures'
@@ -223,7 +231,7 @@
                     initiallyDisabled: true
                     enableChannel: hasFailuresAspect
                     disabledLogo: 'Run Failures'
-                    extent: (Point 123 44)
+                    extent: (Point 98 44)
                   )
                  (ActionButtonSpec
                     label: 'Run Errors'
@@ -234,7 +242,7 @@
                     initiallyDisabled: true
                     enableChannel: hasErrorsAspect
                     disabledLogo: 'Run Errors'
-                    extent: (Point 123 44)
+                    extent: (Point 99 44)
                   )
                  )
                
@@ -245,7 +253,7 @@
         )
       )
 
-    "Modified: / 06-06-2008 / 09:55:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 04-07-2011 / 22:39:20 / cg"
 !
 
 classCategoryListSpec
@@ -971,10 +979,12 @@
     testCases := self classList selectionHolder value.
     testCases isNilOrEmptyCollection ifTrue:
         [testCases := self classList listOfClasses].
-    ^testCases reject:[:cls|cls isAbstract]
+    testCases := testCases collect:[:cls|cls theNonMetaclass].
+    ^testCases reject:[:cls | cls isAbstract]
 
     "Created: / 05-06-2008 / 22:02:24 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 27-11-2008 / 17:16:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 04-07-2011 / 21:56:15 / cg"
 !
 
 selectedTestSuite
@@ -1064,13 +1074,14 @@
         classList inGeneratorHolder:self classListInGeneratorHolder.
         classList doubleClickChannel:[:testCase | self runSelectedAction].
         classList menuHolder:[ self class classListMenu ].
+        classList selectionHolder onChangeSend:#classSelectionChanged to:self.
     ].
     ^ classList
 
     "Created: / 05-06-2008 / 19:28:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 27-11-2008 / 17:22:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 09-01-2010 / 20:30:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 30-06-2011 / 22:00:11 / cg"
+    "Modified: / 04-07-2011 / 22:58:46 / cg"
 !
 
 packageList
@@ -1144,6 +1155,31 @@
     "Created: / 06-06-2008 / 09:20:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
 !
 
+runCoverageAction
+    | allCoveredClasses browser result |
+
+    allCoveredClasses := OrderedCollection new.
+    self selectedTestCases do:[:eachClass | 
+        allCoveredClasses addAll:(eachClass coveredClasses).
+    ].
+
+    browser := NewSystemBrowser browseClasses:allCoveredClasses.
+    browser selectClasses:allCoveredClasses.
+    allCoveredClasses do:[:eachClass |
+        browser recompileClassWithInstrumentation:eachClass
+    ].
+
+    self withWaitCursorDo:[
+        result := self runSuite: self selectedTestSuite.
+        History add: result.
+    ].
+
+    "Modified: / 18-01-2008 / 18:38:08 / janfrog"
+    "Modified: / 06-06-2008 / 08:51:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 19-03-2010 / 08:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 04-07-2011 / 23:04:22 / cg"
+!
+
 runErrorsAction
     "akce na tlacitku Run Errors"
     
@@ -1170,12 +1206,14 @@
 runSelectedAction
 
     | result |
+
     result := self runSuite: self selectedTestSuite.
     History add: result.
 
     "Modified: / 18-01-2008 / 18:38:08 / janfrog"
     "Modified: / 06-06-2008 / 08:51:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 19-03-2010 / 08:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 04-07-2011 / 23:04:46 / cg"
 !
 
 runSuite: aTestSuite
@@ -1188,30 +1226,36 @@
 !
 
 runSuite: aTestSuite keepFailures: keepFailures keepErrors: keepErrors
+    | testResult testCases |
 
-    | testResult testCases |
-    testResult := TestResult new.
-    testCases := Set new.
-    aTestSuite
-        run: testResult
-        beforeEachDo: 
-            [:test :result|
-            self displayRunning: result test: test total: aTestSuite tests size]
-        afterEachDo:
-            [:test :result|
-            testCases add: test class name].                            
-    testCases do:
-        [:clsName| | cls |
-        (cls := Smalltalk classNamed:clsName) notNil ifTrue:
-            [cls rememberFailedTestRunWithResult:testResult]].
+    self withWaitCursorDo:[
+        testResult := TestResult new.
+        testCases := Set new.
+        aTestSuite
+            run: testResult
+            beforeEachDo:[:test :result |
+                self displayRunning: result test: test total: aTestSuite tests size
+            ]
+            afterEachDo:[:test :result|
+                testCases add: test class name
+            ].
 
-    self displayResult: testResult keepFailures: keepFailures keepErrors: keepErrors.
+        testCases do: [:clsName| 
+            | cls |
+
+            (cls := Smalltalk classNamed:clsName) notNil ifTrue:[
+                cls rememberFailedTestRunWithResult:testResult
+            ]
+        ].
+        self displayResult: testResult keepFailures: keepFailures keepErrors: keepErrors.
+    ].
     ^testResult
 
     "Modified: / 18-01-2008 / 18:38:08 / janfrog"
     "Created: / 06-06-2008 / 09:11:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 06-06-2008 / 19:40:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 19-03-2010 / 08:44:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 04-07-2011 / 23:06:23 / cg"
 ! !
 
 !TestRunner2 methodsFor:'actions - menu'!
@@ -1223,6 +1267,14 @@
     "Created: / 30-06-2011 / 22:02:26 / cg"
 !
 
+openDocumentation
+    "opens the documentation file"
+
+    HTMLDocumentView openFullOnDocumentationFile: 'tools/misc/TOP.html#SUNIT'
+
+    "Created: / 04-07-2011 / 22:02:09 / cg"
+!
+
 packageListMenuSelectDependents
 
     |prjDef|
@@ -1528,6 +1580,19 @@
     "Created: / 06-06-2008 / 19:38:48 / Jan Vrany <vranyj1@fel.cvut.cz>"
 ! !
 
+!TestRunner2 methodsFor:'events'!
+
+classSelectionChanged
+    (self selectedTestCases 
+            conform:[:eachClass | eachClass coveredClasses notEmpty]) ifTrue:[
+        (builder componentAt:#RunCoverage) enable
+    ] ifFalse:[
+        (builder componentAt:#RunCoverage) disable
+    ].
+
+    "Created: / 04-07-2011 / 22:59:42 / cg"
+! !
+
 !TestRunner2 methodsFor:'hooks'!
 
 commonPostOpen
@@ -1589,7 +1654,7 @@
 !TestRunner2::ClassList class methodsFor:'documentation'!
 
 version
-    ^'$Id: Tools__TestRunner2.st,v 1.4 2011-07-03 18:02:48 cg Exp $'
+    ^'$Id: Tools__TestRunner2.st,v 1.5 2011-07-04 21:36:38 cg Exp $'
 ! !
 
 !TestRunner2::ClassList methodsFor:'private'!
@@ -2084,7 +2149,7 @@
 !TestRunner2 class methodsFor:'documentation'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.4 2011-07-03 18:02:48 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.5 2011-07-04 21:36:38 cg Exp $'
 !
 
 version_SVN