--- 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