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

Object subclass:#TestResultReporter

	instanceVariableNames:'result stream'

	classVariableNames:''

	poolDictionaries:''

	category:'SUnit-Report'

!

!TestResultReporter class methodsFor:'documentation'!

documentation

"

    Currently supported formats are:

        #xml_junit  - a junit-like format

        #xml        - same, for backward compatibility

        #tap        - perl TAP unit test format; 

                      very naive and simple, but there are tools for it...

    public API entry:

        |aTestResult|

        aTestResult := aUnitTest suite run.

        TestResultReporter report:aTestResult format:#xml on: aStream

    modifications:

        cg: I think the name 'xml' is too unspecific; 

            I may want to add a whole bunch of additional xml-based formats. 

            So I changed #xml to xml_junit (but still support the original #xml for bw-compatibility).

            You may be especially interested in xml_perfPublisher, which is great to present

            nice reports in jenkins/hudson...

    [author:]

        Jan Vranji

        documentation & tap format added by Claus Gittinger

    [see also:]

        TAP 

            http://testanything.org/wiki/index.php/Main_Page

            http://search.cpan.org/~petdance/Test-Harness-2.64/lib/Test/Harness/TAP.pod

"

!

examples

"

                                                                               [exBegin]

    |testResult|

    testResult := RegressionTests::IntegerTest suite run.

    TestResultReporter report:testResult format:#xml_junit on:Transcript. 

                                                                               [exEnd]

                                                                               [exBegin]

    |testResult|

    testResult := RegressionTests::IntegerTest suite run.

    TestResultReporter report:testResult format:#tap on:Transcript.      

                                                                               [exEnd]

                                                                               [exBegin]

    |testResult|

    testResult := RegressionTests::IntegerTest suite run.

    TestResultReporter report:testResult format:#xml_perfPublisher on:Transcript.

                                                                               [exEnd]

"

!

format_tap

"

    sample output for one of the st/x regression-tests looks like:

1..49

ok 1 - RegressionTests::IntegerTest-testComparing (0ms)

ok 2 - RegressionTests::IntegerTest-testConstants (0ms)

ok 3 - RegressionTests::IntegerTest-testCreationFromBytes1 (0ms)

ok 4 - RegressionTests::IntegerTest-testDivision (0ms)

ok 5 - RegressionTests::IntegerTest-testEncodeDecode (0ms)

ok 6 - RegressionTests::IntegerTest-testFactorial (0ms)

ok 7 - RegressionTests::IntegerTest-testGCD (0ms)

ok 8 - RegressionTests::IntegerTest-testILC (0ms)

ok 9 - RegressionTests::IntegerTest-testInline1 (0ms)

ok 10 - RegressionTests::IntegerTest-testInteger1 (0ms)

ok 11 - RegressionTests::IntegerTest-testIntegerMisc (0ms)

...

ok 47 - RegressionTests::IntegerTest-test_gcdBug1 (0ms)

ok 48 - RegressionTests::IntegerTest-test_gcdBug2 (0ms)

ok 49 - RegressionTests::IntegerTest-test_gcdBug3 (0ms)

"

!

format_xml_junit

"

    sample output for one of the st/x regression-tests looks like:

<?xml version='1.0'?>

<unittest-results>

<test duration='0'

    status='success'

    ficture='RegressionTests::IntegerTest'

    name='testComparing'

    file='RegressionTests::IntegerTest.st'>

</test>

<test duration='0'

    status='success'

    ficture='RegressionTests::IntegerTest'

    name='testConstants'

    file='RegressionTests::IntegerTest.st'>

</test>

<test duration='0'

    status='success'

    ficture='RegressionTests::IntegerTest'

    name='testCreationFromBytes1'

    file='RegressionTests::IntegerTest.st'>

</test>

<test duration='0'

    status='success'

    ficture='RegressionTests::IntegerTest'

    name='testDivision'

    file='RegressionTests::IntegerTest.st'>

</test>

<test duration='0'

    status='success'

    ficture='RegressionTests::IntegerTest'

    name='testEncodeDecode'

    file='RegressionTests::IntegerTest.st'>

</test>

...

</unittest-results>

"

! !

!TestResultReporter class methodsFor:'queries'!

supportedFormats

   "return a list of formats and short-info-string, as per supported format symbol"

    ^ #(

        (#'xml_junit'           'a junit-like format')

        (#'xml_perfPublisher'   'xml-based format for jenkins/hudson')

        (#'tap'                 'perl TAP unit test format')

    )

    "Created: / 30-07-2011 / 10:18:18 / cg"

! !

!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_junit, tap"

    |reportFormatSelector|

    reportFormatSelector := self reportFormatSelector:formatSymbol.

    (self respondsTo: reportFormatSelector)

        ifTrue:[self perform: reportFormatSelector]

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

    "Modified (comment): / 30-07-2011 / 11:40:42 / 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 - tap'!

reportTap

    "TAP (perl unit test) report format"

    |idx reportWithStatus|

    "example:

        1..4

        ok 1 - Input file opened

        not ok 2 - First line of the input valid

        ok 3 - Read the rest of the file

        not ok 4 - Summarized correctly # TODO Not written yet

    "

    "/ what about not-executed tests - why only runCount ?

    stream nextPutLine: ('1..%1' bindWith:result runCount).

    reportWithStatus := 

        [:tests :status |

            tests do:[:each | self reportTapTest: each index: idx result: status. idx := idx + 1 ]

        ].

    idx := 1.

    reportWithStatus value:result passed value:#success.

    reportWithStatus value:result failures value:#failure.

    reportWithStatus value:result errors value:#error.

    "Created: / 30-07-2011 / 10:12:31 / cg"

!

reportTapTest: test index:index result: testResult

    | testClassName executionTime  testDescription statusString|

    testClassName := self sunitNameOf: test class.

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

    executionTime := test executionTime ? 0.0.

    testDescription := '%1-%2 (%3ms)'

                            bindWith:testClassName

                            with:test selector

                            with:executionTime.

    statusString := (testResult == #success)

                        ifTrue:['ok']

                        ifFalse:['not ok'].

    stream nextPutLine:('%1 %2 - %3'

                            bindWith:statusString

                            with:index

                            with:testDescription).

    "Created: / 30-07-2011 / 10:28:06 / cg"

! !

!TestResultReporter methodsFor:'reporting - xml-junit'!

reportXml

    "backward compatible: JUnit-like XML unittest report format"

    self reportXml_junit

    "Created: / 30-07-2011 / 11:41:24 / cg"

!

reportXml_junit

    "JUnit-like XML unittest report format"

    stream

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

        nextPutLine: '<unittest-results>'.

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

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

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

    stream

        nextPutLine: '</unittest-results>'

    "Created: / 30-07-2011 / 11:37:10 / cg"

!

reportXml_junitTest: 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 reportXml_junitTraceback: test].

    stream nextPutLine:'</test>'.

    "Created: / 30-07-2011 / 11:37:47 / cg"

!

reportXml_junitTraceback: 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 reportXml_junitTracebackStX: test]

    "Created: / 30-07-2011 / 11:37:36 / cg"

!

reportXml_junitTracebackStX: 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>"

    "Created: / 30-07-2011 / 11:37:26 / cg"

! !

!TestResultReporter methodsFor:'reporting - xml-perfPublisher'!

reportXml_perfPublisher

    "xml-based format for hudson/jenkins"

    |reportName reportCategory testClass startTime|

    reportName := result name.

    reportCategory := 'uncategorized'.  "/ it is a required attribute; so what should we use ?

    (testClass := Smalltalk at:reportName asSymbol) isBehavior ifTrue:[

        reportCategory := testClass category.  "/ at least, something to show

    ].

    "/ compute the startTime from the earliest time found in the set of tests

    startTime := result timestamp.

    startTime isNil ifTrue:[

        startTime := (result tests 

                        collect:[:each | each startTime]

                        thenSelect:[:timeOrNil | timeOrNil notNil]) min.

    ].

    startTime := (startTime ? Time now) asTime.

    stream

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

        nextPutLine:('<report name="%1" categ="%2">' bindWith:reportName with:reportCategory);

        nextPutLine:('  <start>');

        nextPutLine:('    <date format="YYYYMMDD" val="%1">' bindWith:(Date today printStringFormat:'%y%m%d'));

        nextPutLine:('    <time format="HHMMSS" val="%1">' bindWith:(startTime printStringFormat:'%h%m%s'));

        nextPutLine:('  </start>').

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

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

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

    stream

        nextPutLine: '</report>'

    "Created: / 30-07-2011 / 11:45:15 / cg"

!

reportXml_perfPublisher: test result: testResult

    "

    Example:

    <test

        name='test_format_link_not_in_repos_with_line'

        executed='exec-status'

      <result>  

        <success passed='result-status' state='result-state'/>

      </result>  

    </test>  

    "

    | testClassName executionTime testName testDescription executionState 

    testClassName := self sunitNameOf: test class.

    testName := test selector.

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

    executionTime := test executionTime ? 0.0.

    testDescription := '%1-%2' bindWith:testClassName with:testName.

    successPassed := (testResult == #success) ifTrue:['yes'] ifFalse:['no'].

    successState := 'foo'.

    "/ caveat: the following needs to be made dialect-specific

    compilerName := 'Smalltalk/X'.

    compilerVersion := Smalltalk versionString.

    compilerConfiguration := Smalltalk configuration.

    compilerVersionDate := Smalltalk versionDate.

    sysInfo := OperatingSystem getSystemInfo.

    osType := (sysInfo at:#osType ifAbsent:'?').

    osVersion := (sysInfo at:#release ifAbsent:'?').

    stream

        nextPutLine:('<test name="%1" executed="yes">' bindWith: testName);

        nextPutLine:('  <description><!![CDATA[%1]]</description>' bindWith: testDescription);

        nextPutLine:'  <platform>';

        nextPutLine:'    <os>';

        nextPutLine:'    </os>';

        nextPutLine:'    </processor>';

                            bindWith:compilerName with:compilerVersion 

                            with:compilerVersionDate with:compilerConfiguration);

        nextPutLine:'  </platform>';

        nextPutLine:'  <result>';

        nextPutLine:'  </result>'.

"/

"/             nextPutAll:'duration="'; nextPutAll:executionTime; nextPutLine:'"'; 

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

"/        tab; nextPutAll:'ficture="'; nextPutAll: testClassName; 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 reportXml_junitTraceback: test].

    stream nextPutLine:'</test>'.

    "Created: / 30-07-2011 / 12:19:03 / cg"

! !

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

!

version_SVN

    ^ '§Id§'

! !