remember individual failed cases.
authorClaus Gittinger <cg@exept.de>
Mon, 11 Nov 2002 10:50:19 +0100
changeset 87 24e88e7f5d88
parent 86 dd19fac3128b
child 88 6aa1f89cde05
remember individual failed cases.
TestCase.st
TestRunner.st
--- a/TestCase.st	Thu Nov 07 19:03:46 2002 +0100
+++ b/TestCase.st	Mon Nov 11 10:50:19 2002 +0100
@@ -7,7 +7,7 @@
 	category:'SUnit-Base'
 !
 
-TestCase class instanceVariableNames:'lastTestrunResultOrNil'
+TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
 
 "
  No other class instance variables are inherited by this class.
@@ -64,28 +64,56 @@
 !
 
 forgetLastTestRunResult
-    lastTestrunResultOrNil ~~ nil ifTrue:[
-        lastTestrunResultOrNil := nil.
+    lastTestRunResultOrNil ~~ nil ifTrue:[
+        lastTestRunResultOrNil := nil.
         Smalltalk changed:#lastTestRunResult with:self.
         self changed:#lastTestRunResult.
     ]
 !
 
-lastTestrunResultOrNil
-    ^ lastTestrunResultOrNil
+lastTestRunResultOrNil
+    ^ lastTestRunResultOrNil
+!
+
+rememberFailedTest:selector
+    lastTestRunsFailedTests isNil ifTrue:[
+        lastTestRunsFailedTests := Set new.
+    ].
+    lastTestRunsFailedTests add:selector.
+    self rememberFailedTestRun
 !
 
 rememberFailedTestRun
-    lastTestrunResultOrNil ~~ false ifTrue:[
-        lastTestrunResultOrNil := false.
+    lastTestRunResultOrNil ~~ false ifTrue:[
+        lastTestRunResultOrNil := false.
         Smalltalk changed:#lastTestRunResult with:self.
         self changed:#lastTestRunResult.
     ]
 !
 
+rememberFailedTestRunWithResult:result
+    self rememberFailedTestRun.
+    (result failures , result errors) do:[:eachFailedTest |
+        |sel|
+
+        sel := eachFailedTest selector.
+        self rememberFailedTest:sel.
+    ].
+!
+
+rememberPassedTest:selector
+    lastTestRunsFailedTests notNil ifTrue:[
+        lastTestRunsFailedTests remove:selector ifAbsent:nil.
+        lastTestRunsFailedTests isEmpty ifTrue:[
+            lastTestRunsFailedTests := nil
+        ]
+    ].
+!
+
 rememberPassedTestRun
-    lastTestrunResultOrNil ~~ true ifTrue:[
-        lastTestrunResultOrNil := true.
+    lastTestRunResultOrNil ~~ true ifTrue:[
+        lastTestRunResultOrNil := true.
+        lastTestRunsFailedTests := nil.
         Smalltalk changed:#lastTestRunResult with:self.
         self changed:#lastTestRunResult.
     ]
@@ -95,6 +123,10 @@
 	^#()
 !
 
+testSelectorFailed:selector
+    ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
+!
+
 testSelectors
         ^self sunitSelectors select: [:each | 'test*' match: each]
 ! !
@@ -147,6 +179,18 @@
 	^self name = #TestCase.
 !
 
+runTests
+    |result|
+
+    result := self suite run.
+
+    result hasPassed ifTrue:[
+        self rememberPassedTestRun
+    ] ifFalse:[
+        self rememberFailedTestRunWithResult:result
+    ].
+!
+
 shouldInheritSelectors
 	"answer true to inherit selectors from superclasses"
 
@@ -374,7 +418,7 @@
 !TestCase class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.28 2002-11-04 21:29:56 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.29 2002-11-11 09:50:11 cg Exp $'
 ! !
 
 TestCase initialize!
--- a/TestRunner.st	Thu Nov 07 19:03:46 2002 +0100
+++ b/TestRunner.st	Mon Nov 11 10:50:19 2002 +0100
@@ -676,7 +676,7 @@
 "/                                    testsWhichPassed add:caseName.
 "/                                    testsWhichFailed remove:caseName ifAbsent:nil.
                                 ] ifFalse:[
-                                    self testFailed:caseName
+                                    self testFailed:caseName withResult:result
                                 ].
                                 errorCountBefore :=  errorCountAfter.
                                 failureCountBefore := failureCountAfter
@@ -836,11 +836,15 @@
     testsWhichFailed := Set new.
 
     TestCase allSubclassesDo:[:cls |
-        cls lastTestrunResultOrNil == true ifTrue:[
-            testsWhichPassed add:(cls name)
-        ] ifFalse:[
-            cls lastTestrunResultOrNil == false ifTrue:[
-                testsWhichFailed add:(cls name)
+        |lastResult className|
+
+        lastResult := cls lastTestRunResultOrNil.
+        lastResult notNil ifTrue:[
+            className := cls name.
+            lastResult == true ifTrue:[
+                testsWhichPassed add:className
+            ] ifFalse:[
+                testsWhichFailed add:className
             ]
         ]
     ].
@@ -902,14 +906,14 @@
     ^ self scriptModel value at:scriptIndex ifAbsent:nil.
 !
 
-testFailed:caseName
+testFailed:caseName withResult:result
     |cls|
-
+.
     self removeFromPassedTests:caseName.
     self addToFailedTests:caseName.
 
     (cls := Smalltalk classNamed:caseName) notNil ifTrue:[
-        cls rememberFailedTestRun
+        cls rememberFailedTestRunWithResult:result.
     ].
 !
 
@@ -1107,7 +1111,7 @@
             result hasPassed ifTrue:[
                 self testPassed:script
             ] ifFalse:[
-                self testFailed:script
+                self testFailed:script withResult:result
             ].
         ].
 !
@@ -1123,5 +1127,5 @@
 !TestRunner class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.44 2002-11-07 18:03:46 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.45 2002-11-11 09:50:19 cg Exp $'
 ! !