"

COPYRIGHT (c) 2020 LabWare

"

"{ Package: 'stx:goodies/builder/reports' }"

"{ NameSpace: Builder }"

ReportFormat subclass:#TestReportFormat

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Builder-Reports-Formats'

!

TestReportFormat subclass:#JUnit

	instanceVariableNames:'position failures errors skipped startTime stopTime'

	classVariableNames:''

	poolDictionaries:''

	privateIn:TestReportFormat

!

TestReportFormat subclass:#PerfPublisher

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:TestReportFormat

!

TestReportFormat subclass:#PythonUnittest

	instanceVariableNames:'index'

	classVariableNames:''

	poolDictionaries:''

	privateIn:TestReportFormat

!

TestReportFormat subclass:#TAP

	instanceVariableNames:'index'

	classVariableNames:''

	poolDictionaries:''

	privateIn:TestReportFormat

!

!TestReportFormat class methodsFor:'documentation'!

copyright

"

COPYRIGHT (c) 2020 LabWare

"

! !

!TestReportFormat class methodsFor:'testing'!

isAbstract

    ^self == TestReportFormat

    "Created: / 04-08-2011 / 11:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat methodsFor:'accessing - defaults'!

defaultFileSuffix

    "superclass HDReportFormat says that I am responsible to implement this method"

    ^ 'xml'

    "Modified: / 04-08-2011 / 12:48:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat methodsFor:'writing'!

writeTestCase: testcase outcome: outcome time: time exception: exception

    | stacktrace |

    exception isNil ifTrue:[

        stacktrace := nil.        

    ] ifFalse:[

        stacktrace :=

            (String streamContents:[:s|

                self writeStackTrace: exception of: testcase on: s

            ])

    ].

    ^self writeTestCase: testcase outcome: outcome time: time exception: exception 

             stacktrace: stacktrace

    "Created: / 03-08-2011 / 19:44:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeTestCase: testcase outcome: outcome time: time exception: exception stacktrace: stacktrace

    "Write an outcome of a given test.

     Argumments:

        testcase....the testcase <TestCase>

        outcome.....the testcase outcome <TestCaseOutcome>

        time........time taken to run the test in milliseconds

        exception...exception that caused error/failure or nil if N/A < Exception | nil >

        backtrace...stacktrace info or nil if N/A <String | nil >"

    self subclassResponsibility

    "Created: / 03-08-2011 / 19:43:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 06-06-2014 / 00:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat methodsFor:'writing - utilities'!

writeContext: context on: s

    |home mthd src rcvr vars args argAndVarNames srcFirstLineNr |

    [

    context printOn: s.

    s cr.

    s nextPutAll:'receiver: '. context receiver printOn: s. s cr.

    s nextPutAll:'selector: '. context selector storeOn: s. s cr.

    args := context args.

    vars := context vars.

    rcvr := context receiver.

    argAndVarNames := context argAndVarNames.

    s nextPutAll:'args: '; cr.

    self writeContextArgs: context on: s.

    s nextPutAll:'vars: '; cr.

    self writeContextVars: context on: s.

    s nextPutAll:'inst: '; cr.

    rcvr class allInstVarNames keysAndValuesDo:[ :idx :eachNam |

        self writeVariable: eachNam index: idx value: (rcvr instVarNamed: eachNam) on: s.         

    ].

    home := context methodHome.

    mthd := home method.  

    (report notNil and:[report keepBytecode]) ifTrue:[

        s nextPutAll:'bytecode: '; cr.    

        mthd notNil ifTrue:[ 

            (mthd isJavaMethod and:[mthd class ~~ JavaNativeMethod]) ifFalse:[ 

                Decompiler decompile: mthd to: s.

            ] ifTrue:[ 

                (Smalltalk at: #JavaByteCodeDisassembler) notNil ifTrue:[ 

                    (Smalltalk at: #JavaByteCodeDisassembler) diassemble: mthd to: s.

                ] ifFalse:[ 

                    s nextPutAll: ' ** no JavaByteCodeDisassembler **'  

                ].

            ].

        ].

    ].

    s cr.

    s nextPutAll:'source: '; cr.    

    [

    mthd isNil ifTrue:[

         s nextPutAll: '** no source **'. s cr. s cr.

        ^ self.

    ].

    src := mthd source.

    src isNil ifTrue:[

        s nextPutAll: '** no source **'. s cr. s cr.

        ^ self.

    ].

    ] on: Error do:[:ex|

        s 

            nextPutAll: '** error when getting source: ';

            nextPutAll:  ex description;

            nextPutAll: '**';

            cr; cr.

        ^ self.

    ].

    src := src asCollectionOfLines.

    srcFirstLineNr := 1.

    src size > 40 ifTrue:[ 

        | last |

        srcFirstLineNr := (context lineNumber - 15) max: 1.

        last := (srcFirstLineNr + 29) min: src size.

        src := src copyFrom: srcFirstLineNr to: last.

    ].

    src keysAndValuesDo:[:lNr :line |

        s nextPutAll:'  '. 

        (lNr + srcFirstLineNr - 1) printOn: s leftPaddedTo:4.

        lNr == context lineNumber ifTrue:[

            s nextPutAll:'>> '.

        ] ifFalse:[

            s nextPutAll:'   '.

        ].

        s nextPutAll: line; cr.

    ].

    s cr.

    ] on: Error do:[:ex|

        s   cr;

    ]. 

    "

    String streamContents:[ :s | Builder::TestReportFormat new writeContext: thisContext on: s ]

    "

    "Created: / 03-08-2011 / 14:53:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-03-2016 / 14:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeContextArgs: context on: s

    | current |

    current := context.

    [ current notNil ] whileTrue:[

        | args names |

        args := current args.

        names := current argAndVarNames.

        args keysAndValuesDo:[:idx :eachArg |

            self writeVariable: (names at: idx ifAbsent:['???']) index: idx value: eachArg on: s. 

        ].

        current := current home.

        current notNil ifTrue:[ s cr ].

    ]

    "Created: / 02-06-2020 / 11:33:55 / Jan Vrany <jan.vrany@labware.com>"

!

writeContextVars: context on: s

    | current |

    current := context.

    [ current notNil ] whileTrue:[

        | vars names nargs |

        vars := current vars.

        names := current argAndVarNames.

        nargs := current numArgs.

        vars keysAndValuesDo:[:idx :eachArg |

            self writeVariable: (names at: idx + nargs ifAbsent:['???']) index: idx value: eachArg on: s. 

        ].

        current := current home.

        current notNil ifTrue:[ s cr ].

    ]

    "Created: / 02-06-2020 / 11:36:29 / Jan Vrany <jan.vrany@labware.com>"

!

writeStackTrace:err of:aTestCase on: str

    | context |

    context := err signalerContext.

    [ context notNil ] whileTrue:[

        self writeContext: context on: str.

        str cr; cr.

        (context receiver notNil and:[context receiver == aTestCase ]) ifTrue:[

            context selector == aTestCase selector ifTrue:[ ^ self ].

            context selector == #setUp ifTrue:[ ^ self ].

        ].

        context := context sender.

    ].

    "

    [ Error signal ] on: Error do:[:ex| String streamContents:[ :s | Builder::TestReportFormat new writeStackTrace: ex of: nil on: s ] ]

    "

    "Created: / 03-08-2011 / 14:53:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-03-2016 / 14:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-06-2020 / 11:03:30 / Jan Vrany <jan.vrany@labware.com>"

!

writeVariable: name index: index value: value on: s

    s nextPutAll:'  '. 

    index printOn: s leftPaddedTo:4 . s space. 

    name printOn: s paddedTo:12. s nextPutAll:': '. 

    value isString ifTrue:[ 

        value storeOn: s

    ] ifFalse:[

        value printOn: s.

    ].

    s cr.

    "Created: / 02-06-2020 / 10:53:08 / Jan Vrany <jan.vrany@labware.com>"

! !

!TestReportFormat::JUnit class methodsFor:'accessing'!

symbolicNames

    ^ #( #junit #junit40 )

    "Created: / 04-08-2011 / 11:45:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat::JUnit class methodsFor:'documentation'!

version_SVN

    ^ '$Id$'

! !

!TestReportFormat::JUnit methodsFor:'initialization'!

initialize

    super initialize.

    errors := 0.

    failures := 0.

    skipped := 0.

    "Created: / 03-08-2011 / 15:26:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-11-2012 / 15:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat::JUnit methodsFor:'writing'!

writeFooter

    stopTime := OperatingSystem getMillisecondTime.

    stream

        tab;

        nextPutAll:'<system-out><!![CDATA[]]></system-out>';

        nextPut:Character lf.

    stream

        tab;

        nextPutAll:'<system-err><!![CDATA[]]></system-err>';

        nextPut:Character lf.

    stream nextPutAll:'</testsuite>'.

    stream stream position:position.

    stream

        nextPutAll:' failures="';

        print:failures;

        nextPutAll:'" errors="';

        print:errors;

        nextPutAll:'" skipped="';

        print:skipped;

        nextPutAll:'" time="';

        print:(Time milliseconds:stopTime since:startTime) / 1000.0;

        nextPutAll:'">'.

    stream close.

    "Created: / 03-08-2011 / 14:22:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-11-2012 / 15:34:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeHeader

    stream

        nextPutAll:'<?xml version="1.0" encoding="UTF-8"?>';

        nextPut:Character lf.

    stream

        nextPutAll:'<testsuite name="';

        nextPutAll:(Report encode:report name);

        nextPutAll:'" tests="';

        print:report suite testCount;

        nextPutAll:('" hostname="%1"' bindWith:OperatingSystem getHostName);

        nextPutAll:'>'.

     "Now this is ugly. We want to update the time and the number of failures and errors, but still at the same time stream a valid XML. So remember this position and add some whitespace, that we can fill later."

    position := stream stream position - 1.

    stream

        nextPutAll:(String new:100 withAll:$ );

        nextPut:Character lf.

    stream

        nextPutLine: '  <properties>';

        nextPutLine: '    <property name="programmingLanguage" value="Smalltalk" />';

        nextPutLine: '    <property name="smalltalk.vendor" value="exept Software AG" />';

        nextPutLine: '    <property name="smalltalk.compiler" value="Smalltalk/X" />';

        nextPutLine:('    <property name="smalltalk.version" value="%1" />'bindWith:Smalltalk versionString);

        nextPutLine:('    <property name="os.name" value="%1" />' bindWith:OperatingSystem osName);

        nextPutLine:('    <property name="os.arch" value="%1" />' bindWith:OperatingSystem getCPUType);

        nextPutLine:('    <property name="user.name" value="%1" />' bindWith:OperatingSystem getLoginName);

        nextPutLine:('    <property name="user.language" value="%1" />' bindWith:Smalltalk language).

"/    stream

"/        nextPutLine:('    <property name="smalltalk.libbasic.version" value="%1" />'bindWith:stx_libbasic versionString).

    stream

        nextPutLine: '  </properties>'.       

    startTime := OperatingSystem getMillisecondTime.

    "Created: / 03-08-2011 / 19:14:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-06-2014 / 01:14:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeTestCase:testcase outcome:outcome time:time exception: exception stacktrace:stacktrace

    | result |

    outcome result == TestResult statePass ifTrue:[

        result := #pass.

    ] ifFalse:[

        outcome result == TestResult stateFail ifTrue:[

            result := #failure.

            failures := failures + 1

        ] ifFalse:[

            outcome result == TestResult stateError ifTrue:[

                result := #error.

                errors := errors + 1.

            ] ifFalse:[

                outcome result == TestResult stateSkip ifTrue:[

                    result := #skip.

                    skipped := skipped + 1

                ] ifFalse:[

                    self error: 'Invalid test result'.

                ]

            ].

        ].

    ].

    stream tab;

            nextPutAll: '<testcase classname="';

            nextPutAll: (self encode: testcase nameForHDTestReport);

            nextPutAll: '" name="';

            nextPutAll: (self encode: testcase selectorForHDTestReport);

            nextPutAll: '" time="'; print: (time ? 0) / 1000.0; nextPutAll: '">'; cr.

    result == #skip ifTrue:[

        stream tab; tab; nextPutAll: '<skipped/>'.

    ] ifFalse:[

        result ~~ #pass ifTrue:[

            | type message |

            exception isNil ifTrue:[

                type := 'unknown exception'.

                message := 'unknown exception occurred (no exception details available)'

            ] ifFalse:[

                type := exception class name.

                message := exception messageText notNil ifTrue:[ exception description ] ifFalse:[ 'no exception'].

            ].

            stream tab; tab;

                nextPut:$<; nextPutAll: result;

                nextPutAll:' type="';

                nextPutAll:(self encode:type);

                nextPutAll:'" message="';

                nextPutAll:(self encode: message);

                nextPutAll:'"><!![CDATA['; cr.

            "/ Write system identification here so one can tell on which system                     

            "/ it failed. Jenkins JUnit plugin infortunately does not show this

            "/ info in it's own UI

            self writeCDATA: ('Hostname: ' , OperatingSystem getHostName , Character cr).

            self writeCDATA: ('OS:       ' , OperatingSystem osName , Character cr).

            self writeCDATA: ('Arch:     ' , OperatingSystem getCPUType , Character cr, Character cr).

            self writeCDATA: (stacktrace ? 'stacktrace not available').

            stream

                nextPutAll:']]></'; nextPutAll: result; nextPutAll:'>';

                nextPut:Character lf

        ].

    ].

    report keepStdout ifTrue:[

        outcome collectedOutput notEmptyOrNil ifTrue:[

            stream nextPutAll:'    <system-out><!![CDATA['; cr.

            self writeCDATA: outcome collectedOutput.

            stream nextPutAll:']]> </system-out>'; cr.

        ].

    ].

    stream tab;

            nextPutAll: '</testcase>'; cr.

    stream flush

    "Created: / 03-08-2011 / 19:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 19-08-2017 / 14:38:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestReportFormat::JUnit methodsFor:'writing - utilities'!

writeCDATA: string

    | start stop |

    start := 1. 

    stop := start.

    [ (stop := (string indexOf: $] startingAt: stop)) ~~ 0 ] whileTrue:[

        ((stop < (string size - 1)) 

            and:[(string at: stop + 1) == $]

                and:[(string at: stop + 2) == $>]]) ifTrue:[

                    " Okay, found CDATA end token "

                    stream nextPutAll: string startingAt: start to: stop + 1.

                    stream nextPutAll: ']]><!![CDATA[>'.

                    start := stop := stop + 3.

                ] ifFalse:[

                    stop := stop + 1.

                ].

    ].

    start < string size ifTrue:[

        stream nextPutAll: string startingAt: start to: string size.        

    ].