reports/Builder__CoverageReportFormat.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Mar 2019 13:54:38 +0100
changeset 542 aa25a71be62a
parent 256 2082732c7c0c
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:#CoverageReportFormat
     6 	instanceVariableNames:''
     7 	classVariableNames:''
     8 	poolDictionaries:''
     9 	category:'Builder-Reports-Formats'
    10 !
    11 
    12 CoverageReportFormat subclass:#Cobertura
    13 	instanceVariableNames:'currentPackage currentClass currentClassLinesBuffer currentMethod
    14 		infos'
    15 	classVariableNames:''
    16 	poolDictionaries:''
    17 	privateIn:CoverageReportFormat
    18 !
    19 
    20 Parser subclass:#MethodAnalyzer
    21 	instanceVariableNames:'intervals branches'
    22 	classVariableNames:''
    23 	poolDictionaries:''
    24 	privateIn:CoverageReportFormat::Cobertura
    25 !
    26 
    27 
    28 !CoverageReportFormat class methodsFor:'testing'!
    29 
    30 isAbstract
    31 
    32     ^self == CoverageReportFormat
    33 
    34     "Created: / 04-08-2011 / 11:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    35     "Modified: / 25-06-2013 / 01:26:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    36     "Modified (format): / 30-07-2013 / 09:19:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    37 ! !
    38 
    39 !CoverageReportFormat::Cobertura class methodsFor:'accessing'!
    40 
    41 symbolicNames
    42     "Returns a collection of symbolic names for this format"
    43 
    44     ^ self shouldImplement
    45 ! !
    46 
    47 !CoverageReportFormat::Cobertura class methodsFor:'documentation'!
    48 
    49 documentation
    50 " }
    51 
    52  Replace 'Object', 'NewClass1' and
    53  the empty string arguments by true values.
    54 
    55  Install (or change) the class by 'accepting',
    56  either via the menu or the keyboard (usually CMD-A).
    57 
    58  You can also change the category simply by editing
    59  the categoryString and accepting.
    60 
    61  To be nice to others (and yourself later), do not forget to
    62  add some documentation; preferably under the classes documentation
    63  protocol.
    64  (see the `create documentation stubs' item in the methodList menu;
    65   switch from instance to class to find this menu item.)
    66 
    67  Notice, that ST/X uses the convention to document the class using
    68  comment-only class methods (however, ST80 comments are supported and
    69  can be changed via the class-documentation menu).
    70 
    71 "
    72 ! !
    73 
    74 !CoverageReportFormat::Cobertura methodsFor:'accessing - defaults'!
    75 
    76 defaultFileSuffix
    77     "superclass Builder::ReportFormat says that I am responsible to implement this method"
    78 
    79     ^ 'xml'
    80 
    81     "Modified: / 25-06-2013 / 02:02:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    82 ! !
    83 
    84 !CoverageReportFormat::Cobertura methodsFor:'private'!
    85 
    86 sourceInfoForClass: class inPackage: package
    87     | infosPerPackage cls |
    88 
    89     cls := class.
    90     cls isMetaclass ifTrue:[
    91         cls := cls theNonMetaclass
    92     ].
    93     cls isPrivate ifTrue:[
    94         cls := cls topOwningClass.
    95     ].
    96     infosPerPackage := infos at: package ifAbsentPut:[Dictionary new].
    97     ^ infosPerPackage at: class ifAbsentPut: [ReportSourceInfo forClass: cls inPackage: package].
    98 
    99     "Created: / 29-07-2013 / 18:43:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   100 !
   101 
   102 sourceInfoForExtensionsinPackage: package
   103     | infosPerPackage |
   104 
   105     infosPerPackage := infos at: package ifAbsentPut:[Dictionary new].
   106     ^ infosPerPackage at: 'extensions.st' ifAbsentPut: [ReportSourceInfo forExtensionsInPackage: package].
   107 
   108     "Created: / 29-07-2013 / 18:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   109 ! !
   110 
   111 !CoverageReportFormat::Cobertura methodsFor:'writing'!
   112 
   113 write: instrumentedMethods
   114     | packageMap |
   115 
   116     packageMap := Dictionary new.
   117     infos := Dictionary new.
   118     instrumentedMethods do:[:method|
   119         | classMap methodSet |
   120         classMap := packageMap at: method package ifAbsentPut: [ Dictionary new ].
   121         methodSet := classMap at: method mclass theNonMetaclass ifAbsentPut: [ Set new ].
   122         methodSet add: method.
   123     ].
   124 
   125     packageMap keys asSortedCollection do:[:package|
   126         | classMap |            
   127 
   128         self writePackage: package with:[            
   129             ((classMap := packageMap at: package) keys asSortedCollection:[:a :b| a name < b name ]) do:[:class|
   130                 self writeClass: class with:[
   131                     | methodSetOrdered |
   132 
   133 "/                    methodSetOrdered := (classMap at: class) asSortedCollection:[:a :b | (info offsetOfMethod: a) < (info offsetOfMethod: b)].
   134                     methodSetOrdered := (classMap at: class) asSortedCollection:[:a :b | a selector < b selector].
   135                     methodSetOrdered do:[:method|
   136                         self writeMethod: method.
   137                     ]                    
   138                 ]
   139             ]
   140         ]
   141     ]
   142 
   143     "Created: / 25-06-2013 / 13:17:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   144     "Modified: / 29-07-2013 / 18:49:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   145     "Modified (format): / 15-12-2014 / 10:21:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   146 !
   147 
   148 writeClass: class with: content
   149 
   150     | className classFileName classPathName |
   151 
   152     className := class name.
   153     classFileName := class isPrivate 
   154                         ifTrue:[(Smalltalk fileNameForClass: class topOwningClass) , '.st']
   155                         ifFalse:[(Smalltalk fileNameForClass: class) , '.st'].
   156     class package ~~ currentPackage ifTrue:[
   157         classFileName := 'extensions.st'
   158     ].
   159     classPathName := ((currentPackage copyReplaceAll: $: with: Filename separator) replaceAll: $/ with: Filename separator) 
   160                         , Filename separator , classFileName.
   161 
   162     stream nextPutAll:'        <class name="'; nextPutAll: className; nextPutAll: '" filename="'; nextPutAll: classPathName; nextPutLine:'" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.
   163     stream nextPutLine:'          <methods>'.
   164     currentClass := class.
   165     currentClassLinesBuffer := String new writeStream.
   166     content value.               
   167     currentClass := nil.
   168     stream nextPutLine:'          </methods>'.
   169     stream nextPutLine:'          <lines>'.
   170     stream nextPutAll: currentClassLinesBuffer contents.
   171     stream nextPutLine:'          </lines>'.
   172     currentClassLinesBuffer := nil.
   173     stream nextPutLine:'        </class>'
   174 
   175     "Created: / 25-06-2013 / 12:29:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   176     "Modified: / 27-06-2013 / 00:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   177 !
   178 
   179 writeFooter
   180     stream nextPutAll:'  </packages>
   181 </coverage>'
   182 
   183     "Modified: / 25-06-2013 / 11:57:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   184 !
   185 
   186 writeHeader
   187     stream nextPutAll:'<?xml version="1.0"?>
   188 <!!--DOCTYPE coverage SYSTEM "http://cobertura.sourceforge.net/xml/coverage-03.dtd"-->
   189 
   190 <coverage line-rate="1.0" branch-rate="1.0" version="1.9" timestamp="'; nextPutAll: Timestamp now utcSecondsSince1970 printString; nextPutLine:'">'.
   191     stream nextPutLine:'  <sources>'.
   192     Smalltalk packagePath do:[:each|
   193         stream 
   194             nextPutAll: '<source>';
   195             nextPutAll: each asFilename asAbsoluteFilename pathName;
   196             nextPutAll: '</source>';
   197             cr.                
   198     ].
   199     stream nextPutLine:'  </sources>'.
   200     stream nextPutLine:'  <packages>'.
   201 
   202     "Modified: / 26-06-2013 / 17:50:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   203 !
   204 
   205 writeLine: lineNr hits: nhits on: s
   206 
   207     s nextPutAll:'            <line number="'; nextPutAll: lineNr printString; nextPutAll:'" hits="'; nextPutAll: nhits printString; nextPutLine:'" branch="false" />'.
   208 
   209     "Created: / 27-06-2013 / 00:03:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   210 !
   211 
   212 writeMethod: method
   213 
   214     | info firstCharOffset firstLineNr lastLineNr analyzer lines name |
   215 
   216     name := method selector.
   217     method mclass isMetaclass ifTrue:[
   218         name := name , ' [class method]'.
   219     ].
   220 
   221     stream nextPutAll:'        <method name="'; nextPutAll: (self encode: name); nextPutLine: '" signature="" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.
   222     stream nextPutLine:'          <lines>'.
   223     currentMethod := method.
   224 
   225     info := method package == method mclass package 
   226                 ifTrue:[self sourceInfoForClass: method mclass inPackage: method package]
   227                 ifFalse:[self sourceInfoForExtensionsinPackage: method package]. 
   228 
   229     firstCharOffset := info offsetOfMethod: method.
   230     firstLineNr := (info lineAndColumnOfOffset: firstCharOffset) x.
   231     lastLineNr := (info lineAndColumnOfOffset: firstCharOffset + method source size) x.
   232 
   233     lines := Array new: lastLineNr - firstLineNr + 1 withAll: nil.
   234     analyzer := MethodAnalyzer new.
   235     analyzer parseMethod: method source in: method mclass.
   236     analyzer intervals do:[:interval|
   237         | start stop |
   238         start := info lineAndColumnOfOffset: firstCharOffset + interval first - 1.
   239         stop := info lineAndColumnOfOffset: firstCharOffset + interval last - 1.
   240         start x to: stop x do:[:lineNr|
   241             lines at: lineNr - firstLineNr + 1 put: -1.
   242         ].
   243     ].
   244 
   245     (method statementInvocationInfo copy sort:[:a :b | a startPosition < b startPosition]) do:[:eachBlockInfo |
   246         | startLine endLine |
   247 
   248         startLine := (info lineAndColumnOfOffset: firstCharOffset + eachBlockInfo startPosition - 1) x.
   249         endLine := (info lineAndColumnOfOffset: firstCharOffset + eachBlockInfo endPosition - 1) x.
   250         startLine to: endLine do:[:lineNr|
   251 
   252             (lines at: (lineNr - firstLineNr + 1)) == -1 ifTrue:[
   253                 lines at: (lineNr - firstLineNr + 1) put: (eachBlockInfo count)
   254             ] ifFalse:[
   255                 lines at: (lineNr - firstLineNr + 1) put: (((lines at: (lineNr - firstLineNr + 1)) ? (SmallInteger maxVal)) min: eachBlockInfo count)
   256             ]
   257         ]            
   258     ].
   259     1 to: lines size do:[:i|
   260         (lines at: i) notNil ifTrue:[
   261             (lines at: i) == -1 ifTrue:[
   262                 lines at: i put: 0.
   263             ].
   264             self writeLine: (i + firstLineNr - 1) hits: ((lines at: i)) on: stream.
   265             self writeLine: (i + firstLineNr - 1) hits: ((lines at: i)) on: currentClassLinesBuffer.
   266         ]
   267     ].
   268 
   269     currentMethod := nil.
   270     stream nextPutLine:'          </lines>'.
   271     stream nextPutLine:'        </method>'
   272 
   273     "Created: / 25-06-2013 / 13:17:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   274     "Modified: / 30-07-2013 / 09:12:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   275 !
   276 
   277 writePackage: packageName with: aBlock
   278 
   279     stream nextPutAll:'    <package name="'; nextPutAll: packageName; nextPutLine: '" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.
   280     stream nextPutLine:'      <classes>'.
   281     currentPackage := packageName.
   282     aBlock value.               
   283     currentPackage := nil.
   284     stream nextPutLine:'      </classes>'.
   285     stream nextPutLine:'    </package>'
   286 
   287     "Created: / 25-06-2013 / 11:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   288     "Modified: / 25-06-2013 / 13:24:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   289 ! !
   290 
   291 !CoverageReportFormat::Cobertura::MethodAnalyzer methodsFor:'accessing'!
   292 
   293 branches
   294     ^ branches
   295 !
   296 
   297 intervals
   298     ^ intervals
   299 ! !
   300 
   301 !CoverageReportFormat::Cobertura::MethodAnalyzer methodsFor:'code generation hooks'!
   302 
   303 statementListRewriteHookFor:aStatementNode
   304     "invoked whenever a statement list node has been generated;
   305      gives subclasses a chance to rewrite (instrument) it"
   306 
   307     | stmt |
   308 
   309     intervals isNil ifTrue:[
   310         intervals := OrderedCollection new.
   311     ].
   312     stmt := aStatementNode.
   313     [ stmt notNil ] whileTrue:[
   314         intervals add: (stmt startPosition to: stmt endPosition).
   315         stmt := stmt nextStatement.
   316     ].
   317     ^ aStatementNode
   318 
   319     "Created: / 29-07-2013 / 10:16:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   320     "Modified: / 29-07-2013 / 11:25:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   321 ! !
   322 
   323 !CoverageReportFormat class methodsFor:'documentation'!
   324 
   325 version
   326     ^ '$Header$'
   327 !
   328 
   329 version_CVS
   330     ^ '$Header$'
   331 ! !
   332