TestResult.st
changeset 292 f81494b22e60
parent 270 edb137bd861e
child 297 87eb8f911bcf
--- a/TestResult.st	Tue Aug 02 18:14:37 2011 +0200
+++ b/TestResult.st	Tue Aug 02 18:14:47 2011 +0200
@@ -46,7 +46,7 @@
 !TestResult class methodsFor:'others'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.22 2011-07-30 10:40:46 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.23 2011-08-02 16:14:47 cg Exp $'
 ! !
 
 !TestResult methodsFor:'accessing'!
@@ -157,6 +157,46 @@
 
 !TestResult methodsFor:'printing'!
 
+exceptionInfoStringFor:anException
+    ^ String streamContents:[:s |
+        |con endReached|
+
+        endReached := false.
+        con := anException suspendedContext.
+        [ con isNil or:[ endReached ]] whileFalse:[
+            s showCR:con printString.
+            con := con sender.
+            (con selector == #performTest) ifTrue:[
+                endReached := true.
+            ].
+            (con sender notNil and:[con sender selector == #performTest]) ifTrue:[
+                endReached := true.
+            ].
+        ]
+    ].
+
+    "Created: / 02-08-2011 / 18:05:15 / cg"
+!
+
+exceptionInfoStringFor:anException in:aTestCase
+    ^ String streamContents:[:s |
+        |con endReached|
+
+        endReached := false.
+        con := anException suspendedContext.
+        [ con isNil or:[ endReached ]] whileFalse:[
+            s showCR:con printString.
+            ((con selector == aTestCase selector) 
+            and:[ con receiver == aTestCase ]) ifTrue:[
+                endReached := true.
+            ].
+            con := con sender.
+        ]
+    ].
+
+    "Created: / 02-08-2011 / 18:10:46 / cg"
+!
+
 printOn: aStream
 
 	aStream
@@ -176,10 +216,15 @@
 !TestResult methodsFor:'running'!
 
 runCase: aTestCase
-	[aTestCase runCase.
-	self addPass: aTestCase]
-		sunitOn: self class failure , self class error
-		do: [:ex | ex sunitAnnounce: aTestCase toResult: self].
+        [aTestCase runCase.
+        self addPass: aTestCase]
+                sunitOn: self class failure , self class error
+                do: [:ex | 
+                    aTestCase exceptionInfoString:(self exceptionInfoStringFor:ex in:aTestCase).
+                    ex sunitAnnounce: aTestCase toResult: self
+                ].
+
+    "Modified: / 02-08-2011 / 18:10:09 / cg"
 ! !
 
 !TestResult methodsFor:'testing'!
@@ -216,7 +261,7 @@
 !TestResult class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.22 2011-07-30 10:40:46 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.23 2011-08-02 16:14:47 cg Exp $'
 !
 
 version_SVN