"{ Package: 'stx:goodies/sunit' }"

TestResult subclass:#TestResultStX
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'SUnit-Smalltalk/X'
!


!TestResultStX methodsFor:'outcome'!

rememberEndTime

    ^outcome endTime: Timestamp now

    "Created: / 16-08-2011 / 17:36:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

rememberException:detail
    "common for failure and error:
     called when a test fails. testCase is the failed 
     testcase, detail is platform specific object describing 
     the failure. Actually, on all platforms exeptt GemStone, 
     detail is an instance of an exception that caused the failure"

    |backtrace|

    ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
        "remember the backtrace (as string, to prevent objects from being kept forwever
         from being garbage collected, the signal (i.e. the exception class) and the
         exceptions message (description).
         Would like to have an exceptionInfo obejct for that, but that might be hard to 
         get returned back into the main stream sunit package..."
        
        backtrace := String streamContents:[:s |
                        |con topReached|

                        "could use printAllOn:s, but noone is interested in contexts above the
                         testcase's runtest context"
                        topReached := false.
                        con := detail suspendedContext.
                        [ 
                            con notNil and:[topReached not]
                        ] whileTrue:[
                            con printOn:s.
                            s cr.
                            topReached := (con selector == outcome selector)
                                          and:[con receiver == outcome].
                            con := con sender.
                        ]
                     ].
        outcome exceptionDetail:(Dictionary new
                                    at:#exception put:detail signal;
                                    at:#description put:detail description;
                                    at:#backtrace put:backtrace;
                                    yourself).
        ^ self.
    ].

    "add other dialect specifics here"

    "Created: / 06-08-2011 / 11:29:23 / cg"
    "Created: / 16-08-2011 / 17:32:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

rememberOutput: aString

    outcome collectedOutput: aString

    "Created: / 16-08-2011 / 18:18:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

rememberStartTime

    ^outcome startTime: Timestamp now

    "Created: / 16-08-2011 / 17:36:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TestResultStX methodsFor:'running'!

performCase: aTestCase

    | savedStdout savedTranscript collector|

    savedStdout := Stdout.
    savedTranscript := Transcript.
    collector := WriteStream on:(String new:100).
    [
        Stdout := SplittingWriteStream on:collector and: Stdout.
        Transcript := SplittingWriteStream on:collector and: Transcript.
        super performCase: aTestCase.
    ] ensure:[
        Stdout := savedStdout.
        Transcript := savedTranscript.
        self rememberOutput: collector contents.
    ].

    "Created: / 16-08-2011 / 18:18:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TestResultStX class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResultStX.st,v 1.1 2011-08-16 17:54:09 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResultStX.st,v 1.1 2011-08-16 17:54:09 vrany Exp $'
! !