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

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


!TestResultStX class methodsFor:'utilities'!

sourceFilenameOfClass:aClass
    "that is ST/X specific"
    "no Smalltalk/X dialect detection needed..."

    |sourceStream testClassSourceFile|

    sourceStream := aClass sourceStream.
    sourceStream notNil ifTrue:[
        [
            sourceStream := sourceStream stream.
            sourceStream isFileStream ifTrue:[
                testClassSourceFile := sourceStream pathName asFilename pathName.
            ].
        ] ensure:[
            sourceStream close.
        ]
    ].
    ^ testClassSourceFile
! !

!TestResultStX methodsFor:'accessing'!

endTime
    ^ endTime
!

endTime:aTimestamp
    "sets the overall (suite) end time"

    endTime := aTimestamp.
!

executionTime
    "return the execution time (in seconds). If asked before or during a run, return nil"

    |t1 t2|

    (t1 := self startTime) isNil ifTrue:[^ nil].
    (t2 := self endTime) isNil ifTrue:[^ nil].
    ^ t2 secondDeltaFrom: t1

    "
     |a b|

     a := Timestamp now.
     Delay waitForMilliseconds:567.
     b := Timestamp now.
     b - a   
    "
!

startTime
    ^ timestamp
!

startTime:aTimestamp
    "sets the overall (suite) start time"

    timestamp := aTimestamp.
! !

!TestResultStX methodsFor:'outcome'!

printLineForContextForJavaCompatibleStackTrace:con on:aStream
    "why in java-backtrace format?
     Because then jenkins will be able to extract sourcefile and linenumber
     and generate links in the report page.
     I am not willing to write another plugin for this - using junit compatible format"

    |cls classSourceFile method s lineNumberOfMethod lineNumberInFile relPath|

    "/ used to be:
    "/ con printOn:aStream.

    "/ be careful: some tests generate methods on the fly, which are unbound!!
    "/ or even (javascript/other languages) may not have a method at all!!!!

    con fixAllLineNumbers.
    (method := con method) notNil ifTrue:[
        cls := method mclass.
        cls notNil ifTrue:[
            relPath := cls package copyReplaceAll:$: with:$/.
            relPath := relPath copyReplaceAll:$\ with:$/.
            relPath := (relPath asFilename construct:cls theNonMetaclass classFilename) name.

            classSourceFile := Smalltalk getPackageFileName:relPath.
            classSourceFile isNil ifTrue:[    
                classSourceFile := self class sourceFilenameOfClass:cls.
            ].
            classSourceFile notNil ifTrue:[
                method sourcePosition notNil ifTrue:[
                    "/ sigh - we have the lineNumber within the method,
                    "/ and the characterPosition of the method's start.
                    "/ need to calculate the absolute lineNumber in the file
                    s := LineNumberReadStream on:(classSourceFile asFilename readStream).
                    [
                        [s position < method sourcePosition] whileTrue:[
                            s nextLine
                        ].
                        lineNumberOfMethod := s lineNumber.
                    ] ensure:[
                        s close.
                    ].
                ]
            ]
        ].
    ].

    "/ output something (will not generate a ref to the source file)
    aStream nextPutAll:('%1 >> %2 [%3]' 
                            bindWith: (con receiverPrintString)
                            with: (con selector)
                            with: (con lineNumber) ).

    classSourceFile notNil ifTrue:[
        lineNumberOfMethod notNil ifTrue:[
            lineNumberInFile := lineNumberOfMethod + con lineNumber - 1.
            aStream nextPutAll:(' (%1:%2)'
                                bindWith: classSourceFile
                                with: lineNumberInFile)
        ] ifFalse:[
            aStream nextPutAll:(' (%1)'
                                bindWith: classSourceFile)
        ].
    ].
    aStream cr.

    "Modified: / 05-08-2012 / 12:00:00 / cg"
!

rememberEndTime
    "remembers the endTime of the current test (in outcome)"

    ^outcome endTime: Timestamp now

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

rememberException:ex
    "common for failure and error:
     called when a test fails. testCase is the failed 
     testcase, ex is platform specific object describing 
     the failure. Actually, on all platforms exeptt GemStone, 
     ex 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 := ex suspendedContext.
                        [ 
                            con notNil and:[topReached not]
                        ] whileTrue:[
                            self printLineForContextForJavaCompatibleStackTrace:con on:s.
                            topReached := (con selector == outcome selector)
                                          and:[con receiver == outcome
                                               or:[ con receiver == outcome testCase ]].
                            con := con sender.
                        ]
                     ].

        outcome exceptionDetail:(Dictionary new
                                    at:#exception put:ex signal;
                                    at:#description put:ex 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
    "remembers the startTime of the current test (in outcome)"

    ^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.7 2012-11-07 01:09:14 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResultStX.st,v 1.7 2012-11-07 01:09:14 cg Exp $'
! !