class: Tools::TestRunnerEmbedded
authorClaus Gittinger <cg@exept.de>
Tue, 21 May 2013 22:21:03 +0200
changeset 12762 eeb5359c60d3
parent 12761 1280febd6212
child 12763 37d514cde1d5
class: Tools::TestRunnerEmbedded comment/format in: #resultInfoAspect changed:6 methods
Tools__TestRunnerEmbedded.st
--- a/Tools__TestRunnerEmbedded.st	Tue May 21 22:13:50 2013 +0200
+++ b/Tools__TestRunnerEmbedded.st	Tue May 21 22:21:03 2013 +0200
@@ -243,7 +243,7 @@
                           extent: (Point 60 25)
                         )
                        (ActionButtonSpec
-                          label: 'Run Failed'
+                          label: ' Failed'
                           name: 'Button1'
                           activeHelpKey: runFailed
                           translateLabel: true
@@ -381,6 +381,8 @@
     suite := suiteAndResult suiteForRun.
     "/ suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
     "/ test := suiteAndResult suite tests anyOne.
+    result := TestResult defaultResultClass new.
+    suiteAndResult := SuiteAndResult suite: suite result: result.
 
     self stop.
 
@@ -389,13 +391,28 @@
         self runningHolder value:true.
 
         suite tests do:[:test |
-            test debug. 
+            [
+                test debug. 
+            ] ifCurtailed:[
+                result failureOutcomes add: test.
+                self resultHolder value:suiteAndResult; changed.    
+            ].
+
             (test class testSelectorPassed:test selector) ifTrue:[
-                result := TestResult defaultResultClass new.
-                result passed add: test.
-                suiteAndResult := SuiteAndResult suite: suite result: result.       
-                self resultHolder value:suiteAndResult.    
-            ].
+                "/ result := TestResult defaultResultClass new.
+                "/ result passed add: test.
+                "/ suiteAndResult := SuiteAndResult suite: suite result: result.
+                result passedOutcomes add: test.
+                self resultHolder value:suiteAndResult; changed.    
+            ] ifFalse:[
+                (test class testSelectorFailed:test selector) ifTrue:[
+                    "/ result := TestResult defaultResultClass new.
+                    "/ result failures add: test.
+                    "/ suiteAndResult := SuiteAndResult suite: suite result: result.       
+                    result failureOutcomes add: test.
+                    self resultHolder value:suiteAndResult; changed.    
+                ]
+            ]
         ].
     ] ensure:[
         self runningHolder value:false.
@@ -459,7 +476,7 @@
                     suiteAndResult := SuiteAndResult suite:suite result:result.
                 ] ensure:[
                     self progressIndicatorShownHolder value:false.
-                    self resultHolder value:suiteAndResult.
+                    self resultHolder setValue:nil; value:suiteAndResult; changed.
                     self runningHolder value:false.
                 ]
             ] newProcess.
@@ -813,39 +830,41 @@
             invalidateTestCases;      "/ updateTestSuite;
             invalidateSuiteAndResult; "/ updateTestSuiteAndResult;
             updateVisibility.
-        self enqueueDelayedAction:[ self updateTestCases; updateSuiteAndResult ].
+        self hasTestCaseSelected ifTrue:[
+            self enqueueDelayedAction:[ self updateTestCases; updateSuiteAndResult ].
+        ].
          ^ self.
     ].
-    sender == selectedProtocolsHolder ifTrue:[
-        self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
-        self enqueueDelayedAction:[ self updateSuiteAndResult ].
-        ^self
-    ].
+    self hasTestCaseSelected ifTrue:[
+        sender == selectedProtocolsHolder ifTrue:[
+            self invalidateSuiteAndResult. 
+            self enqueueDelayedAction:[ self updateSuiteAndResult ].
+            ^self
+        ].
 
-    sender == selectedMethodsHolder ifTrue:[
-        self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
-        self enqueueDelayedAction:[ self updateSuiteAndResult ].
-        ^self
+        sender == selectedMethodsHolder ifTrue:[
+            self invalidateSuiteAndResult. 
+            self enqueueDelayedAction:[ self updateSuiteAndResult ].
+            ^self
+        ].
+        sender == methodGeneratorHolder ifTrue:[
+            self invalidateSuiteAndResult. 
+            self enqueueDelayedAction:[ self updateSuiteAndResult ].
+            ^self
+        ].
+
+        sender == Smalltalk ifTrue:[
+            aspect == #lastTestRunResult ifTrue:[
+                allTestCases notNil ifTrue:[
+                    (allTestCases includesIdentical: param first) ifTrue:[
+                        self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
+                        self enqueueDelayedAction:[ self updateSuiteAndResult ].
+                        ^self        
+                    ]
+                ].
+            ]        
+        ].
     ].
-    sender == methodGeneratorHolder ifTrue:[
-        self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
-        self enqueueDelayedAction:[ self updateSuiteAndResult ].
-        ^self
-    ].
-
-    sender == Smalltalk ifTrue:[
-        aspect == #lastTestRunResult ifTrue:[
-            allTestCases notNil ifTrue:[
-                (allTestCases includesIdentical: param first) ifTrue:[
-                    self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
-                    self enqueueDelayedAction:[ self updateSuiteAndResult ].
-                    ^self        
-                ]
-            ].
-        ]        
-    ].
-
-
 
     super update:aspect with:param from: sender
 
@@ -1012,6 +1031,11 @@
 !
 
 suiteForRun
+    "if methods are selected, a suite for those methods is built and returned.
+     If protocoly are selected, a suite for all methods in those protocols
+     is built and returned.
+     Otherwise, a suite for all methods in the class is built and returned"
+
     | methods protocols suite selectedClass |
 
     selectedClass := self theSingleTestCase.
@@ -1026,7 +1050,7 @@
         ^suite
     ].
     
-    (protocols := selectedProtocolsHolder value) isEmptyOrNil ifFalse:[
+    (protocols := selectedProtocolsHolder value) notEmptyOrNil ifTrue:[
         suite := TestSuite named: (self suiteNameFromProtocols: protocols).
         (self selectedTestMethodsFromProtocols: protocols inClass:selectedClass) do:[:mthd| 
             | class selector |
@@ -1061,9 +1085,11 @@
 !
 
 suiteForRunFailed
-    |suite|
+    |suite numTests|
 
     suite := TestSuite named:(self suiteNameFromClasses: self allTestCases).
+    numTests := 0.
+
     self allTestCases do:[:testCase |
         (self buildSuiteFromClass:testCase) tests do:[:eachTest |
             | sel cls |
@@ -1071,10 +1097,16 @@
             sel := eachTest selector.
             cls := eachTest class.
             (cls testSelectorPassed:sel) ifFalse:[
-                suite addTest:eachTest
+                suite addTest:eachTest.
+                numTests := numTests + 1.
             ]
         ]
     ].
+    numTests == 1 ifTrue:[
+        suite name:(suite tests first selector)
+    ] ifFalse:[
+        suite name:(suite tests size printString,' tests')
+    ].
     ^suite
 
     "Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1095,26 +1127,51 @@
 !TestRunnerEmbedded::SuiteAndResult methodsFor:'accessing'!
 
 color
-
-    self testCount == 0 ifTrue:
-        [^TestRunnerEmbedded notRunColor].
+    |numTests numRun|
 
-    result ifNil:[^TestRunnerEmbedded notRunColor].
-    self hasErrors ifTrue:[^TestRunnerEmbedded errorColor].
-    self hasFailures ifTrue:[^TestRunnerEmbedded failedColor].
-    self hasPassed ifTrue:[^TestRunnerEmbedded passedColor].
-    ^TestRunnerEmbedded notRunColor
+    self testCount > 0 ifTrue:[
+        result notNil ifTrue:[
+            self hasErrors ifTrue:[^TestRunnerEmbedded errorColor].
+            self hasFailures ifTrue:[^TestRunnerEmbedded failedColor].
+            self hasPassed ifTrue:[
+                numTests := suite tests size.
+                numRun := result passedCount + result failureCount + result errorCount.
+                numRun = numTests ifTrue:[
+                    ^TestRunnerEmbedded passedColor 
+                ]
+            ].
+        ]
+    ].
+    ^ TestRunnerEmbedded notRunColor
 
     "Created: / 15-03-2010 / 15:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 07-09-2010 / 08:25:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 info
+    |numTests numRun|
 
     result ifNil:[^''].
-    (result passedCount + result failureCount + result errorCount) = 1 ifTrue:[^''].
+
+    numTests := suite tests size.
+    numRun := result passedCount + result failureCount + result errorCount.
+    "/ (result passedCount + result failureCount + result errorCount) = 1 ifTrue:[^''].
+    numRun == 0 ifTrue:[
+        numTests == 1 ifTrue:[
+            ^'not run'
+        ].
+        ^'%1 tests, 0 run' bindWith: numTests
+    ].
+    numRun < numTests ifTrue:[
+        ^'%1 tests, %2 run, %3 passed, %4 fail or error'
+            bindWith: numTests
+                with: numRun        
+                with: result passedCount        
+                with: (result failureCount+result errorCount)
+    ].
+
     ^'%1 tests, %2 passed, %3 failed, %4 errors'
-        bindWith: suite tests size
+        bindWith: numTests
             with: result passedCount        
             with: result failureCount 
             with: result errorCount
@@ -1196,14 +1253,14 @@
 !TestRunnerEmbedded class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.33 2013-04-01 20:03:15 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.34 2013-05-21 20:21:03 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.33 2013-04-01 20:03:15 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.34 2013-05-21 20:21:03 cg Exp $'
 !
 
 version_SVN
-    ^ '§Id§'
+    ^ '$Id: Tools__TestRunnerEmbedded.st,v 1.34 2013-05-21 20:21:03 cg Exp $'
 ! !