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

Object subclass:#TestResultReporter

	instanceVariableNames:'result stream'

	classVariableNames:''

	poolDictionaries:''

	category:'SUnit-Report'

!

!TestResultReporter class methodsFor:'documentation'!

documentation

"

        |aTestResult|

        aTestResult := aUnitTest suite run.

        TestResultReporter report:aTestResult format:#xml on: aStream

"

!

examples

"

    |testResult|

    testResult := RegressionTests::IntegerTest suite run.

"

! !

! !

!TestResultReporter class methodsFor:'reporting'!

report: aTestResult format: format as: stringOrFilename

    self new report: aTestResult format: format as: stringOrFilename

!

report: aTestResult format: format on: stream

    self new report: aTestResult format: format on: stream

    "

     self report:(RegressionTests::IntegerTest runTests) format:#xml on:Transcript

    "

    "Modified (comment): / 30-07-2011 / 09:37:53 / cg"

! !

!TestResultReporter methodsFor:'reporting'!

report:formatSymbol

    "currently supported formatSymbols:

            xml"

    |reportFormatSelector|

    reportFormatSelector := self reportFormatSelector:formatSymbol.

    (self respondsTo: reportFormatSelector)

        ifTrue:[self perform: reportFormatSelector]

        ifFalse:[self error:'Unsupported format: ', formatSymbol].

    "Modified (comment): / 30-07-2011 / 09:37:31 / cg"

!

report: aTestResult format: format as: stringOrFilename

    | s |

    s := stringOrFilename asFilename writeStream.

    [ self report: aTestResult format: format on: s]

	ensure:[s close].

!

report: aTestResult format: aSymbol on: aStream

    result := aTestResult.

    stream := aStream.

    self report: aSymbol

!

reportFormatSelector:format

    ^ ('report' , format asString capitalized) asSymbol

! !

!TestResultReporter methodsFor:'reporting - xml'!

reportXml

    "JUnit-like XML unittest report format"

    stream

        nextPutLine: '<?xml version="1.0"?>';

        nextPutLine: '<unittest-results>'.

    result passed   do:[:each|self reportXmlTest: each result: #success].

    result failures do:[:each|self reportXmlTest: each result: #failure].

    result errors   do:[:each|self reportXmlTest: each result: #error].

    stream

        nextPutLine: '</unittest-results>'

    "Modified (format): / 30-07-2011 / 09:54:16 / cg"

!

reportXmlTest: test result: testResult

    "

    Example:

    <test

        duration='0.0188629627228'

        status='error'

        fixture='bitten.tests.web_ui.SourceFileLinkFormatterTestCase'

        name='test_format_link_not_in_repos_with_line'

        file='/usr/src/trac-bitten-0.6b2.dfsg/bitten/tests/web_ui.py'>

    "

    | testClassName executionTime |

    testClassName := self sunitNameOf: test class.

    "most tests do not know, and return nil here!!"

    executionTime := test executionTime ? 0.0.

    stream

        nextPutAll:'<test duration="'; nextPutAll:executionTime; nextPutLine:'"'; 

        tab; nextPutAll:'status="'; nextPutAll: testResult; nextPutLine:'"';

        tab; nextPutAll:'ficture="'; nextPutAll: testClassName; nextPutLine:'"';

        tab; nextPutAll:'name="'; nextPutAll: test selector; nextPutLine:'"';

        "It seems that some tools requires the file attributes. So we supply one :-)"

        tab; nextPutAll:'file="'; nextPutAll: testClassName , '.st'; nextPutLine:'">'.

    testResult ~= #success ifTrue:[self reportXmlTraceback: test].

    stream nextPutLine:'</test>'.

    "Modified: / 30-07-2011 / 10:10:02 / cg"

!

reportXmlTraceback: test

    "

	Prints a traceback to the stream.

	This is dialect-specific, so we have to check...

    "

    "Smalltalk/X dialect detection..."

    ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX])

	ifTrue:[^self reportXmlTracebackStX: test]

!

reportXmlTracebackStX: test

    stream nextPutLine:'<traceback><!![CDATA['.

    [ test debug ]

	on: GenericException

	do: [:ex|

	    ex suspendedContext fullPrintAllOn: stream].

    stream nextPutLine:']]></traceback>'.

    "Modified: / 07-12-2009 / 14:06:48 / Jan Vrany <jan.vrant@fit.cvut.cz>"

! !

!TestResultReporter methodsFor:'utilities'!

sunitNameOf: aClass

    "No all SUnit versions comes with sunitName

     (at least Smalltalk/X 3.1)"

    ^(aClass respondsTo:#sunitName)

	ifTrue:[aClass sunitName]

	ifFalse:[aClass printString]

! !

!TestResultReporter class methodsFor:'documentation'!

version

!

version_SVN

    ^ '§Id§'

! !