reports/Builder__TestReportFormat.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Mar 2019 13:54:38 +0100
changeset 542 aa25a71be62a
parent 514 f50803f4bb59
permissions -rw-r--r--
#DOCUMENTATION by cg
class: stx_goodies_builder_quickSelfTest
class definition

class: stx_goodies_builder_quickSelfTest class
added:18 methods
     1 "{ Package: 'stx:goodies/builder/reports' }"
     2 
     3 "{ NameSpace: Builder }"
     4 
     5 ReportFormat subclass:#TestReportFormat
     6 	instanceVariableNames:''
     7 	classVariableNames:''
     8 	poolDictionaries:''
     9 	category:'Builder-Reports-Formats'
    10 !
    11 
    12 TestReportFormat subclass:#JUnit
    13 	instanceVariableNames:'position failures errors skipped startTime stopTime'
    14 	classVariableNames:''
    15 	poolDictionaries:''
    16 	privateIn:TestReportFormat
    17 !
    18 
    19 TestReportFormat subclass:#PerfPublisher
    20 	instanceVariableNames:''
    21 	classVariableNames:''
    22 	poolDictionaries:''
    23 	privateIn:TestReportFormat
    24 !
    25 
    26 TestReportFormat subclass:#PythonUnittest
    27 	instanceVariableNames:'index'
    28 	classVariableNames:''
    29 	poolDictionaries:''
    30 	privateIn:TestReportFormat
    31 !
    32 
    33 TestReportFormat subclass:#TAP
    34 	instanceVariableNames:'index'
    35 	classVariableNames:''
    36 	poolDictionaries:''
    37 	privateIn:TestReportFormat
    38 !
    39 
    40 
    41 !TestReportFormat class methodsFor:'testing'!
    42 
    43 isAbstract
    44 
    45     ^self == TestReportFormat
    46 
    47     "Created: / 04-08-2011 / 11:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    48 ! !
    49 
    50 !TestReportFormat methodsFor:'accessing - defaults'!
    51 
    52 defaultFileSuffix
    53     "superclass HDReportFormat says that I am responsible to implement this method"
    54 
    55     ^ 'xml'
    56 
    57     "Modified: / 04-08-2011 / 12:48:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    58 ! !
    59 
    60 !TestReportFormat methodsFor:'writing'!
    61 
    62 writeTestCase: testcase outcome: outcome time: time exception: exception
    63 
    64     | stacktrace |
    65     exception isNil ifTrue:[
    66         stacktrace := nil.
    67     ] ifFalse:[
    68         stacktrace :=
    69             (String streamContents:[:s|
    70                 self writeStackTrace: exception of: testcase on: s
    71             ])
    72     ].
    73 
    74     ^self writeTestCase: testcase outcome: outcome time: time exception: exception
    75              stacktrace: stacktrace
    76 
    77     "Created: / 03-08-2011 / 19:44:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    78 !
    79 
    80 writeTestCase: testcase outcome: outcome time: time exception: exception stacktrace: stacktrace
    81 
    82     "Write an outcome of a given test.
    83      Argumments:
    84         testcase....the testcase <TestCase>
    85         outcome.....the testcase outcome <TestCaseOutcome>
    86         time........time taken to run the test in milliseconds
    87         exception...exception that caused error/failure or nil if N/A < Exception | nil >
    88         backtrace...stacktrace info or nil if N/A <String | nil >"
    89 
    90     self subclassResponsibility
    91 
    92     "Created: / 03-08-2011 / 19:43:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    93     "Modified (comment): / 06-06-2014 / 00:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    94 ! !
    95 
    96 !TestReportFormat methodsFor:'writing - utilities'!
    97 
    98 writeContext: context on: s
    99 
   100     |home mthd src|
   101     [
   102     context printOn: s.
   103     s cr.
   104     s nextPutAll:'receiver: '. context receiver printOn: s. s cr.
   105     s nextPutAll:'selector: '. context selector printOn: s. s cr.
   106     s nextPutAll:'args: '; cr.
   107     context args keysAndValuesDo:[:idx :eachArg |
   108         s nextPutAll:'  '. idx printOn: s. s nextPutAll:': '. eachArg printOn: s.s cr.
   109     ].
   110     s nextPutAll:'vars: '; cr.
   111     context vars keysAndValuesDo:[:idx :eachVar |
   112         s nextPutAll:'  '. idx printOn: s. s nextPutAll:': '.
   113         eachVar isString ifTrue:[
   114             eachVar storeOn: s.
   115         ] ifFalse:[
   116             eachVar printOn: s.
   117         ].
   118         s cr.
   119     ].
   120     s nextPutAll:'source: '; cr.
   121 
   122     [
   123     home := context methodHome.
   124     mthd := home method.
   125     mthd isNil ifTrue:[
   126          s nextPutAll: '** no source **'. s cr. s cr.
   127         ^ self.
   128     ].
   129     src := mthd source.
   130     src isNil ifTrue:[
   131         s nextPutAll: '** no source **'. s cr. s cr.
   132         ^ self.
   133     ].
   134     ] on: Error do:[:ex|
   135         s
   136             nextPutAll: '** error when getting source: ';
   137             nextPutAll:  ex description;
   138             nextPutAll: '**';
   139             cr; cr.
   140         ^ self.
   141     ].
   142     src := src asCollectionOfLines.
   143     src keysAndValuesDo:[:lNr :line |
   144         lNr == context lineNumber ifTrue:[
   145             s nextPutAll:'>> '.
   146         ] ifFalse:[
   147             s nextPutAll:'   '.
   148         ].
   149         s nextPutAll: line; cr.
   150     ].
   151     s cr.
   152     ] on: Error do:[:ex|
   153         s   cr;
   154             nextPutAll:'!!!!!!ERROR WHEN GETTING STACK TRACE!!!!!!'; cr;
   155             nextPutAll: ex description; cr
   156     ]
   157 
   158     "Created: / 03-08-2011 / 14:53:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   159 !
   160 
   161 writeStackTrace:err of:aTestCase on: str
   162 
   163     | context stop |
   164 
   165     context := err signalerContext.
   166     stop := false.
   167 
   168     [ context notNil ] whileTrue:[
   169         self writeContext: context on: str.
   170         str cr; cr.
   171 
   172         context receiver == aTestCase ifTrue:[
   173             context selector == aTestCase selector ifTrue:[ ^ self ].
   174             context selector == #setUp ifTrue:[ ^ self ].
   175         ].
   176         context := context sender.
   177 
   178     ].
   179 
   180     "Created: / 03-08-2011 / 14:53:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   181 ! !
   182 
   183 !TestReportFormat::JUnit class methodsFor:'accessing'!
   184 
   185 symbolicNames
   186     ^ #( #junit #junit40 )
   187 
   188     "Created: / 04-08-2011 / 11:45:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   189 ! !
   190 
   191 !TestReportFormat::JUnit class methodsFor:'documentation'!
   192 
   193 version_SVN
   194     ^ '$Id$'
   195 ! !
   196 
   197 !TestReportFormat::JUnit methodsFor:'initialization'!
   198 
   199 initialize
   200 
   201     super initialize.
   202     errors := 0.
   203     failures := 0.
   204     skipped := 0.
   205 
   206     "Created: / 03-08-2011 / 15:26:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   207     "Modified: / 21-11-2012 / 15:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   208 ! !
   209 
   210 !TestReportFormat::JUnit methodsFor:'writing'!
   211 
   212 writeFooter
   213     stopTime := OperatingSystem getMillisecondTime.
   214     stream
   215         tab;
   216         nextPutAll:'<system-out><!![CDATA[]]></system-out>';
   217         nextPut:Character lf.
   218     stream
   219         tab;
   220         nextPutAll:'<system-err><!![CDATA[]]></system-err>';
   221         nextPut:Character lf.
   222     stream nextPutAll:'</testsuite>'.
   223     stream stream position:position.
   224     stream
   225         nextPutAll:' failures="';
   226         print:failures;
   227         nextPutAll:'" errors="';
   228         print:errors;
   229         nextPutAll:'" skipped="';
   230         print:skipped;
   231         nextPutAll:'" time="';
   232         print:(Time milliseconds:stopTime since:startTime) / 1000.0;
   233         nextPutAll:'">'.
   234     stream close.
   235 
   236     "Created: / 03-08-2011 / 14:22:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   237     "Modified: / 21-11-2012 / 15:34:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   238 !
   239 
   240 writeHeader
   241     stream
   242         nextPutAll:'<?xml version="1.0" encoding="UTF-8"?>';
   243         nextPut:Character lf.
   244     stream
   245         nextPutAll:'<testsuite name="';
   246         nextPutAll:(Report encode:report name);
   247         nextPutAll:'" tests="';
   248         print:report suite countTests;
   249         nextPutAll:('" hostname="%1"' bindWith:OperatingSystem getHostName);
   250         nextPutAll:'>'.
   251      "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."
   252     position := stream stream position - 1.
   253     stream
   254         nextPutAll:(String new:100 withAll:$ );
   255         nextPut:Character lf.
   256     stream
   257         nextPutLine: '  <properties>';
   258         nextPutLine: '    <property name="programmingLanguage" value="Smalltalk" />';
   259         nextPutLine: '    <property name="smalltalk.vendor" value="exept Software AG" />';
   260         nextPutLine: '    <property name="smalltalk.compiler" value="Smalltalk/X" />';
   261         nextPutLine:('    <property name="smalltalk.version" value="%1" />'bindWith:Smalltalk versionString);
   262         nextPutLine:('    <property name="os.name" value="%1" />' bindWith:OperatingSystem osName);
   263         nextPutLine:('    <property name="os.arch" value="%1" />' bindWith:OperatingSystem getCPUType);
   264         nextPutLine:('    <property name="user.name" value="%1" />' bindWith:OperatingSystem getLoginName);
   265         nextPutLine:('    <property name="user.language" value="%1" />' bindWith:Smalltalk language).
   266 "/    stream
   267 "/        nextPutLine:('    <property name="smalltalk.libbasic.version" value="%1" />'bindWith:stx_libbasic versionString).
   268     stream
   269         nextPutLine: '  </properties>'.
   270 
   271     startTime := OperatingSystem getMillisecondTime.
   272 
   273     "Created: / 03-08-2011 / 19:14:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   274     "Modified: / 06-06-2014 / 01:14:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   275 !
   276 
   277 writeTestCase:testcase outcome:outcome time:time exception: exception stacktrace:stacktrace
   278     | result |
   279 
   280     outcome result == TestResult statePass ifTrue:[
   281         result := #pass.
   282     ] ifFalse:[
   283         outcome result == TestResult stateFail ifTrue:[
   284             result := #failure.
   285             failures := failures + 1
   286         ] ifFalse:[
   287             outcome result == TestResult stateError ifTrue:[
   288                 result := #error.
   289                 errors := errors + 1.
   290             ] ifFalse:[
   291                 outcome result == TestResult stateSkip ifTrue:[
   292                     result := #skip.
   293                     skipped := skipped + 1
   294                 ] ifFalse:[
   295                     self error: 'Invalid test result'.
   296                 ]
   297             ].
   298         ].
   299     ].
   300 
   301     stream tab;
   302             nextPutAll: '<testcase classname="';
   303             nextPutAll: (self encode: testcase nameForHDTestReport);
   304             nextPutAll: '" name="';
   305             nextPutAll: (self encode: testcase selectorForHDTestReport);
   306             nextPutAll: '" time="'; print: (time ? 0) / 1000.0; nextPutAll: '">'; cr.
   307 
   308     result == #skip ifTrue:[
   309         stream tab; tab; nextPutAll: '<skipped/>'.
   310     ] ifFalse:[
   311         result ~~ #pass ifTrue:[
   312             | type message |
   313 
   314             exception isNil ifTrue:[
   315                 type := 'unknown exception'.
   316                 message := 'unknown exception occurred (no exception details available)'
   317             ] ifFalse:[
   318                 type := exception class name.
   319                 message := exception messageText ifNil:[ exception description ].
   320             ].
   321 
   322 
   323             stream tab; tab;
   324                 nextPut:$<; nextPutAll: result;
   325                 nextPutAll:' type="';
   326                 nextPutAll:(self encode:type);
   327                 nextPutAll:'" message="';
   328                 nextPutAll:(self encode: message);
   329                 nextPutAll:'"><!![CDATA['; cr.
   330             self writeCDATA: (stacktrace ? 'stacktrace not available').
   331             stream
   332                 nextPutAll:']]></'; nextPutAll: result; nextPutAll:'>';
   333                 nextPut:Character lf
   334         ].
   335     ].
   336     report keepStdout ifTrue:[
   337         outcome collectedOutput notEmptyOrNil ifTrue:[
   338             stream nextPutAll:'    <system-out><!![CDATA['; cr.
   339             self writeCDATA: outcome collectedOutput.
   340             stream nextPutAll:']]> </system-out>'; cr.
   341         ].
   342     ].
   343 
   344     stream tab;
   345             nextPutAll: '</testcase>'; cr.
   346 
   347 
   348     stream flush
   349 
   350     "Created: / 03-08-2011 / 19:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   351     "Modified: / 16-09-2014 / 18:55:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   352 ! !
   353 
   354 !TestReportFormat::JUnit methodsFor:'writing - utilities'!
   355 
   356 writeCDATA: string
   357     | start stop |
   358 
   359     start := 1.
   360     stop := start.
   361     [ (stop := (string indexOf: $] startingAt: stop)) ~~ 0 ] whileTrue:[
   362         ((stop < (string size - 1))
   363             and:[(string at: stop + 1) == $]
   364                 and:[(string at: stop + 2) == $>]]) ifTrue:[
   365                     " Okay, found CDATA end token "
   366                     stream nextPutAll: string startingAt: start to: stop + 1.
   367                     stream nextPutAll: ']]><!![CDATA[>'.
   368                     start := stop := stop + 3.
   369                 ] ifFalse:[
   370                     stop := stop + 1.
   371                 ].
   372     ].
   373     start < string size ifTrue:[
   374         stream nextPutAll: string startingAt: start to: string size.
   375     ].
   376 
   377     "
   378     String streamContents:[:s | Builder::TestReportFormat::JUnit new report: nil stream: s; writeCDATA:'ABCD']
   379     String streamContents:[:s | Builder::TestReportFormat::JUnit new report: nil stream: s; writeCDATA:']]]]']
   380     String streamContents:[:s | Builder::TestReportFormat::JUnit new report: nil stream: s; writeCDATA:'Some <[CDATA[ CDATA ]]> Some Text and stray terminator ]]> here']
   381     "
   382 
   383     "Created: / 05-07-2013 / 16:54:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   384 ! !
   385 
   386 !TestReportFormat::PerfPublisher class methodsFor:'accessing'!
   387 
   388 symbolicNames
   389     "Returns a collection of symbolic names for this format"
   390 
   391     ^ #(perfPublisher)
   392 
   393     "Modified: / 04-08-2011 / 11:52:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   394 ! !
   395 
   396 !TestReportFormat::PerfPublisher class methodsFor:'documentation'!
   397 
   398 version_SVN
   399     ^ '$Id$'
   400 ! !
   401 
   402 !TestReportFormat::PerfPublisher methodsFor:'writing'!
   403 
   404 writeFooter
   405 
   406     stream nextPutLine: '</report>'
   407 
   408     "Modified: / 03-08-2011 / 20:12:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   409 !
   410 
   411 writeHeader
   412 
   413     |reportName reportCategory testClass|
   414 
   415     reportName := report suite name.
   416     reportCategory := 'uncategorized'.  "/ it is a required attribute; so what should we use ?
   417 
   418     (testClass := Smalltalk at:reportName asSymbol) isBehavior ifTrue:[
   419         reportCategory := testClass category.  "/ at least, something to show
   420     ].
   421 
   422     stream
   423         nextPutLine: '<?xml version="1.0"?>';
   424         nextPutLine:('<report name="%1" categ="%2">' bindWith:reportName with:reportCategory);
   425         nextPutLine:('  <start>');
   426         nextPutLine:('    <date format="YYYYMMDD" val="%1" />' bindWith:(Date today printStringFormat:'%y%m%d'));
   427         nextPutLine:('    <time format="HHMMSS" val="%1" />' bindWith:(Time now printStringFormat:'%h%m%s'));
   428         nextPutLine:('  </start>').
   429 
   430     "Modified: / 03-08-2011 / 20:12:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   431 !
   432 
   433 writeTestCase:testcase outcome:outcome time:time exception:exception stacktrace:stacktrace
   434 
   435     "
   436     Example:
   437     <test
   438         name='test_format_link_not_in_repos_with_line'
   439         executed='exec-status'
   440       <result>
   441         <success passed='result-status' state='result-state'/>
   442         <errorlog><!![CDATA[EXEMPLE OF ERROR LOG]]></errorlog>
   443       </result>
   444     </test>
   445     "
   446 
   447     |testClassName executionTime testName testDescription
   448      successPassed successState exceptionInfo
   449      compilerName compilerVersion compilerConfiguration compilerVersionDate
   450      timeUnit timeMeasure
   451      sysInfo osType osVersion cpuType|
   452 
   453     testClassName := testcase printString.
   454     testName := testcase selector.
   455 
   456     "most tests do not know, and return nil here!!"
   457     executionTime := time.    "/ millis
   458     testDescription := '%1-%2' bindWith:testClassName with:testName.
   459 
   460     successPassed := (outcome result == TestResult statePass) ifTrue:['yes'] ifFalse:['no'].
   461     (outcome result ~~ TestResult statePass) ifTrue:[
   462         exceptionInfo := stacktrace ? 'No stacktrace available'.
   463     ].
   464 
   465     successState := 'foo'.
   466 
   467     "/ caveat: the following needs to be made dialect-specific
   468     compilerName := 'Smalltalk/X'.
   469     compilerVersion := Smalltalk versionString.
   470     compilerConfiguration := Smalltalk configuration.
   471     compilerVersionDate := Smalltalk versionDate.
   472 
   473     sysInfo := OperatingSystem getSystemInfo.
   474     osType := (sysInfo at:#osType ifAbsent:'?').
   475     osVersion := (sysInfo at:#release ifAbsent:'?').
   476 
   477     cpuType := (sysInfo at:#cpuType ifAbsent:'?').
   478     "/ cpuSpeed := (sysInfo at:#cpuSpeed ifAbsent:'?').
   479 
   480     timeUnit := 'ms'.
   481     timeMeasure := executionTime.
   482 
   483     stream
   484         nextPutLine:('<test name="%1" executed="yes">' bindWith: testName);
   485         nextPutLine:('  <description><!![CDATA[%1]]></description>' bindWith: testDescription);
   486         nextPutLine:'  <platform>';
   487         nextPutLine:'    <os>';
   488         nextPutLine:('      <type><!![CDATA[%1]]></type>' bindWith:osType);
   489         nextPutLine:('      <version><!![CDATA[%1]]></version>' bindWith:osVersion);
   490         nextPutLine:'    </os>';
   491         nextPutLine:('    <processor arch="%1">' bindWith:cpuType);
   492         "/ nextPutLine:('      <frequency> unit="Mhz" cpufreq="%1" />' bindWith:cpuSpeed);
   493         nextPutLine:'    </processor>';
   494         nextPutLine:('    <compiler name="%1" version="%2" versiondate="%3" configuration="%4" />'
   495                             bindWith:compilerName with:compilerVersion
   496                             with:compilerVersionDate with:compilerConfiguration);
   497         "/ nextPutLine:'    <environment />';
   498         nextPutLine:'  </platform>';
   499         nextPutLine:'  <result>';
   500         nextPutLine:('    <success passed="%1" state="100" />'
   501                             bindWith:successPassed with:successState);
   502         "/ cg: in the perfPublisher documentation, I found "mesure".
   503         "/ I am not sure, if that was a typo, or is actually what is expected...
   504         "/ to be on the save side, I generate both a mesure and a measure attribute,
   505         "/ so it will work, even if they ever fix perfPublisher's xml parser.
   506         nextPutLine:('    <executiontime unit="%1" mesure="%2" measure="%2" isRelevant="yes" />'
   507                             bindWith:timeUnit with:timeMeasure).
   508 
   509     exceptionInfo notNil ifTrue:[
   510         stream
   511             nextPutLine:'    <errorlog><!![CDATA[';
   512             nextPutAll:exceptionInfo;
   513             nextPutLine:']]></errorlog>'.
   514         ].
   515     stream
   516         nextPutLine:'  </result>'.
   517 
   518     stream nextPutLine:'</test>'.
   519 
   520     "Modified: / 06-06-2014 / 00:47:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   521 ! !
   522 
   523 !TestReportFormat::PythonUnittest class methodsFor:'accessing'!
   524 
   525 symbolicNames
   526     "Returns a collection of symbolic names for this format"
   527 
   528     ^ #(python python-unittest)
   529 
   530     "Modified: / 04-08-2011 / 11:52:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   531 ! !
   532 
   533 !TestReportFormat::PythonUnittest class methodsFor:'documentation'!
   534 
   535 version_SVN
   536     ^ '$Id$'
   537 ! !
   538 
   539 !TestReportFormat::PythonUnittest methodsFor:'writing'!
   540 
   541 writeFooter
   542 
   543     stream
   544         nextPutLine: '</unittest-results>'
   545 
   546     "Modified: / 03-08-2011 / 20:19:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   547 !
   548 
   549 writeHeader
   550 
   551     stream
   552         nextPutLine: '<?xml version="1.0"?>';
   553         nextPutLine: '<unittest-results>'.
   554 
   555     "Modified: / 03-08-2011 / 20:19:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   556 !
   557 
   558 writeTestCase:testcase outcome:outcome time:time exception:exception stacktrace:stacktrace
   559 
   560     "
   561     Example:
   562     <test
   563         duration='0.0188629627228'
   564         status='error'
   565         fixture='bitten.tests.web_ui.SourceFileLinkFormatterTestCase'
   566         name='test_format_link_not_in_repos_with_line'
   567         file='/usr/src/trac-bitten-0.6b2.dfsg/bitten/tests/web_ui.py'>
   568     "
   569 
   570     | testClassName result |
   571 
   572     testClassName := testcase class printString.
   573 
   574     outcome result == TestResult statePass ifTrue:[
   575         result := #success.
   576     ] ifFalse:[
   577         outcome result == TestResult stateFail ifTrue:[
   578             result := #failure.
   579         ] ifFalse:[
   580             outcome result == TestResult stateError ifTrue:[
   581                 result := #error.
   582             ] ifFalse:[
   583                 outcome result == TestResult stateSkip ifTrue:[
   584                     result := #skip.
   585                 ] ifFalse:[
   586                     self error: 'Invalid test result'.
   587                 ]
   588             ].
   589         ].
   590     ].
   591 
   592     stream
   593         nextPutAll:'<test duration="'; nextPutAll:time; nextPutLine:'"';
   594         tab; nextPutAll:'status="'; nextPutAll: result; nextPutLine:'"';
   595         tab; nextPutAll:'ficture="'; nextPutAll: testClassName; nextPutLine:'"';
   596         tab; nextPutAll:'name="'; nextPutAll: testcase selector; nextPutLine:'"';
   597         "It seems that some tools requires the file attributes. So we supply one :-)"
   598         tab; nextPutAll:'file="'; nextPutAll: testClassName , '.st'; nextPutLine:'">'.
   599 
   600     outcome == #pass ifFalse:[
   601         stream nextPutLine:'<traceback><!![CDATA['.
   602         stream nextPutAll: stacktrace ? 'No stacktrace available'.
   603         stream nextPutLine:']]></traceback>'.
   604     ].
   605 
   606     stream nextPutLine:'</test>'.
   607 
   608     "Modified: / 06-06-2014 / 00:50:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   609 ! !
   610 
   611 !TestReportFormat::TAP class methodsFor:'accessing'!
   612 
   613 symbolicNames
   614     "Returns a collection of symbolic names for this format"
   615 
   616     ^ #(tap TAP)
   617 
   618     "Modified: / 04-08-2011 / 11:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   619 ! !
   620 
   621 !TestReportFormat::TAP class methodsFor:'documentation'!
   622 
   623 version_SVN
   624     ^ '$Id$'
   625 ! !
   626 
   627 !TestReportFormat::TAP methodsFor:'accessing - defaults'!
   628 
   629 defaultFileSuffix
   630     "superclass HDReportFormat says that I am responsible to implement this method"
   631 
   632     ^ 'tap'
   633 
   634     "Modified: / 04-08-2011 / 12:47:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   635 ! !
   636 
   637 !TestReportFormat::TAP methodsFor:'writing'!
   638 
   639 writeFooter
   640 
   641     "nothing to do"
   642 
   643     "Modified: / 03-08-2011 / 20:05:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   644 !
   645 
   646 writeHeader
   647 
   648     stream nextPutAll: '1..'; nextPutAll: report suite countTests printString; cr.
   649     index := 0
   650 
   651     "Modified: / 04-08-2011 / 13:49:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   652 !
   653 
   654 writeTestCase:testcase outcome:outcome time:time exception:exception stacktrace:stacktrace
   655 
   656     | result testDescription statusString |
   657 
   658     index := index + 1.
   659     outcome result == TestResult statePass ifTrue:[
   660         result := #pass.
   661     ] ifFalse:[
   662         outcome result == TestResult stateFail ifTrue:[
   663             result := #failure.
   664         ] ifFalse:[
   665             outcome result == TestResult stateError ifTrue:[
   666                 result := #error.
   667             ] ifFalse:[
   668                 outcome result == TestResult stateSkip ifTrue:[
   669                     result := #skip.
   670                 ] ifFalse:[
   671                     self error: 'Invalid test result'.
   672                 ]
   673             ].
   674         ].
   675     ].
   676 
   677     testDescription := '%1-%2 (%3ms)'
   678                             bindWith:testcase printString
   679                             with:testcase selector
   680                             with:time.
   681 
   682     statusString := (result == #pass)
   683                         ifTrue:['ok']
   684                         ifFalse:['not ok'].
   685 
   686     stream nextPutLine:('%1 %2 - %3'
   687                             bindWith:statusString
   688                             with:index
   689                             with:testDescription).
   690 
   691     "Modified: / 06-06-2014 / 00:46:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   692 ! !
   693 
   694 !TestReportFormat class methodsFor:'documentation'!
   695 
   696 version
   697     ^ '$Header$'
   698 !
   699 
   700 version_CVS
   701     ^ '$Header$'
   702 !
   703 
   704 version_SVN
   705     ^ '$Id$'
   706 ! !
   707