TestResult.st
changeset 136 483eb95e98b7
parent 132 2d980116a3f5
child 183 657b3b690c83
--- a/TestResult.st	Mon Aug 28 16:52:50 2006 +0200
+++ b/TestResult.st	Mon Aug 28 16:54:31 2006 +0200
@@ -154,15 +154,20 @@
 !TestResult methodsFor:'running'!
 
 runCase:aTestCase 
-    |testCasePassed|
+    |testCasePassed failure error|
 
-    testCasePassed := 
+    testCasePassed := true.
+    failure := error := false.
+
             [
                 [
                     aTestCase runCase.
-                    true
+
                 ] on:self class failure do:[:ex | 
-                    self failures add:aTestCase.
+                    testCasePassed ifTrue:
+                     [failure := true.
+                      testCasePassed := false].
+
                     ex handleFailureWith:false
                 ]
             ] on:self class error do:[:ex |
@@ -174,15 +179,26 @@
                 (HaltInterrupt accepts:ex signal) ifTrue:[ 
                     ex reject 
                 ].
-                self errors add:aTestCase.
+                error := true.
+                testCasePassed := false.
                 ex returnWith:false
             ].
 
+    error
+     ifTrue:
+       [self errors add: aTestCase]
+     ifFalse:
+       [failure ifTrue: [self failures add: aTestCase]].
+
     testCasePassed ifTrue:[
         self passed add:aTestCase
     ]
 
     "Modified: / 06-08-2006 / 10:42:42 / cg"
+    "Modified: / 28-08-2006 / 16:40:00 / boris"
+
+  " a test case should be registered either as passed or as failed or as error.
+    Note that several resumable failures may preceed one final error "
 ! !
 
 !TestResult methodsFor:'testing'!
@@ -225,5 +241,5 @@
 !TestResult class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.17 2006-08-07 10:59:28 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.18 2006-08-28 14:54:31 boris Exp $'
 ! !