"{ 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 $'

! !