Initial version of code coverage report.
It mimics Cobertura report so it can be used in Jenkins with
proper plugin. However, it's very basic with limited functionality.
--- a/reports/Builder__CoverageReport.st Tue Jun 25 20:26:00 2013 +0200
+++ b/reports/Builder__CoverageReport.st Tue Jun 25 20:26:10 2013 +0200
@@ -2,161 +2,121 @@
"{ NameSpace: Builder }"
-TestReport subclass:#CoverageReport
- instanceVariableNames:'wrappers covered'
+Report subclass:#CoverageReport
+ instanceVariableNames:'instrumentedMethods'
classVariableNames:''
poolDictionaries:''
- category:'Builder-Reports-Unfinished'
+ category:'Builder-Reports'
!
-!CoverageReport methodsFor:'generating'!
+!CoverageReport methodsFor:'accessing-defaults'!
+
+defaultFileSuffix
+
+ "Return a default filename suffix. Note that format suffix will be
+ appended too if not file is explicitely specified"
+
+ ^'Coverage'
-generate
- | coverage |
- covered := (wrappers select: [ :each | each hasRun ])
- collect: [ :each | each reference ].
- coverage := StandardFileStream
- forceNewFileNamed: suite name , '-Coverage.xml'.
- [ self generateOn: coverage ]
- ensure: [ coverage close ]
+ "Created: / 25-06-2013 / 01:12:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+defaultFormat
+ "raise an error: must be redefined in concrete subclass(es)"
+
+ ^ Builder::CoverageReportFormat::Cobertura new
+
+ "Modified: / 25-06-2013 / 01:31:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-generateDataOn: aStream
- | items |
- aStream tab; nextPutAll: '<data>'; nextPut: Character lf.
- aStream tab; tab; nextPutAll: '<all name="all classes">'; nextPut: Character lf.
- self
- generateType: 'class' indent: 3
- total: (items := (packages gather: [ :each | each classes ]) asSet) size
- actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
- count: [ :each | items includes: each ])
- on: aStream.
- self
- generateType: 'method' indent: 3
- total: (items := (packages gather: [ :each | each methods ]) asSet) size
- actual: (covered count: [ :each | items includes: each ])
- on: aStream.
- packages do: [ :each | self generatePackage: each on: aStream ].
- aStream tab; tab; nextPutAll: '</all>'; nextPut: Character lf.
- aStream tab; nextPutAll: '</data>'; nextPut: Character lf
-!
+defaultName
+
+ packages isNil ifTrue:[
+ ^'someClasses'.
+ ].
-generateOn: aStream
- aStream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; nextPut: Character lf.
- aStream nextPutAll: '<report>'; nextPut: Character lf.
- self generateStatsOn: aStream.
- self generateDataOn: aStream.
- aStream nextPutAll: '</report>'; nextPut: Character lf
-!
+ ^String streamContents:[:s|
+ packages do:[:packageOrClass|
+ s nextPutAll: packageOrClass printString
+ ] separatedBy:[
+ s nextPut:$,;space
+ ]
+ ]
-generatePackage: aPackage class: aClass on: aStream
- | items |
- aStream tab: 4; nextPutAll: '<class name="'; nextPutAll: (self encode: aClass name); nextPutAll: '">'; nextPut: Character lf.
- self
- generateType: 'class' indent: 5
- total: 1
- actual: ((covered anySatisfy: [ :each | each actualClass theNonMetaClass = aClass ])
- ifTrue: [ 1 ] ifFalse: [ 0 ])
- on: aStream.
- self
- generateType: 'method' indent: 5
- total: (items := aPackage coreMethodsForClass: aClass) size
- actual: (covered count: [ :each | items includes: each ])
- on: aStream.
- items do: [ :each | self generatePackage: each method: each on: aStream ].
- aStream tab: 4; nextPutAll: '</class>'; nextPut: Character lf
+ "Created: / 25-06-2013 / 01:29:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!CoverageReport methodsFor:'initialization'!
+
+initialize
+ instrumentedMethods := Set new.
+
+ "Created: / 25-06-2013 / 01:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-06-2013 / 13:21:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-generatePackage: aPackage method: aReference on: aStream
- | items |
- aStream tab: 5; nextPutAll: '<method name="'; nextPutAll: (self encode: aReference selector); nextPutAll: '">'; nextPut: Character lf.
- self
- generateType: 'method' indent: 6
- total: 1
- actual: ((covered includes: aReference) ifTrue: [ 1 ] ifFalse: [ 0 ])
- on: aStream.
- aStream tab: 5; nextPutAll: '</method>'; nextPut: Character lf
-!
+setupForClasses:classes
+ "raise an error: must be redefined in concrete subclass(es)"
-generatePackage: aPackage on: aStream
- | items |
- aStream tab: 3; nextPutAll: '<package name="'; nextPutAll: (self encode: (aPackage packageName copyReplaceAll: '-' with: '.')); nextPutAll: '">'; nextPut: Character lf.
- self
- generateType: 'class' indent: 4
- total: (items := aPackage classes asSet) size
- actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
- count: [ :each | items includes: each ])
- on: aStream.
- self
- generateType: 'method' indent: 4
- total: (items := aPackage methods asSet) size
- actual: (covered count: [ :each | items includes: each ])
- on: aStream.
- aPackage classes
- do: [ :class | self generatePackage: aPackage class: class on: aStream ].
- aStream tab: 3; nextPutAll: '</package>'; nextPut: Character lf
+ classes do:[:each | self instrumentClass: each].
+
+ "Modified: / 25-06-2013 / 16:22:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-generateStatsOn: aStream
- aStream tab; nextPutAll: '<stats>'; nextPut: Character lf.
- aStream tab; tab; nextPutAll: '<packages value="'; print: (packages size); nextPutAll: '"/>'; nextPut: Character lf.
- aStream tab; tab; nextPutAll: '<classes value="'; print: (packages detectSum: [ :each | each classes size ]); nextPutAll: '"/>'; nextPut: Character lf.
- aStream tab; tab; nextPutAll: '<methods value="'; print: (packages detectSum: [ :each | each methods size ]); nextPutAll: '"/>'; nextPut: Character lf.
- aStream tab; nextPutAll: '</stats>'; nextPut: Character lf.
-!
+setupForPackages:pkgs
+ "raise an error: must be redefined in concrete subclass(es)"
-generateType: aString indent: anInteger total: totalInteger actual: actualInteger on: aStream
- aStream tab: anInteger; nextPutAll: '<coverage type="'; nextPutAll: aString; nextPutAll: ', %" value="'; print: (totalInteger = 0 ifTrue: [ 0 ] ifFalse: [ (100.0 * actualInteger / totalInteger) rounded ]); nextPutAll: '% ('; print: actualInteger; nextPut: $/; print: totalInteger; nextPutAll: ')"/>'; nextPut: Character lf
+ pkgs do:[:each | self instrumentPackage: each ].
+
+ "Modified: / 25-06-2013 / 16:22:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!CoverageReport methodsFor:'private'!
+!CoverageReport methodsFor:'instrumentation'!
-addTestsIn: aTestAsserter to: aSet
- (aTestAsserter isKindOf: TestSuite) ifTrue: [
- aTestAsserter tests
- do: [ :each | self addTestsIn: each to: aSet ] ].
- (aTestAsserter isKindOf: TestCase) ifTrue: [
- (aTestAsserter class respondsTo: #packageNamesUnderTest) ifTrue: [
- aTestAsserter class packageNamesUnderTest
- do: [ :each | aSet add: (self halt:'Not ported')"(PackageInfo named: each)" ] ] ].
- ^ aSet
+instrumentClass:class
+ class instAndClassMethods do:[:method|
+ self instrumentMethod: method
+ ]
- "Modified: / 08-03-2011 / 22:12:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 25-06-2013 / 01:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-ignoredSelectors
- ^ #(packageNamesUnderTest classNamesNotUnderTest)
+instrumentMethod:method
+
+ | class selector |
+
+ class := method mclass.
+ selector := method selector.
+ method isInstrumented ifFalse:[
+ InstrumentingCompiler compileMethod: method.
+ ].
+ instrumentedMethods add: (class compiledMethodAt: selector)
+
+ "Created: / 25-06-2013 / 01:44:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-06-2013 / 13:21:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-methodsIn: aPackage
- aPackage isNil ifTrue: [ ^ #() ].
- ^ aPackage methods reject: [ :method |
- (self ignoredSelectors includes: method methodSymbol)
- or: [ method compiledMethod isAbstract
- or: [ method compiledMethod refersToLiteral: #ignoreForCoverage ] ] ]
-!
+instrumentPackage:pkg
+ Smalltalk allMethodsDo:[:method|
+ method package asSymbol == pkg asSymbol ifTrue:[
+ self instrumentMethod: method.
+ ]
+ ]
-packagesIn: aTestAsserter
- ^ self addTestsIn: aTestAsserter to: Set new
+ "Created: / 25-06-2013 / 01:42:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-06-2013 / 17:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CoverageReport methodsFor:'running'!
-setUp
-"/ super setUp.
-"/ wrappers := ((packages := self packagesIn: suite)
-"/ gather: [ :package | self methodsIn: package ])
-"/ collect: [ :each | HDTestCoverage on: each ].
-"/ wrappers do: [ :each | each install ]
+runReport
+ "Actually run the report. What to do (what classes/packages to check)
+ must be stored instance variables"
- "Modified: / 15-05-2013 / 19:01:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+ format write: instrumentedMethods.
-tearDown
- wrappers do: [ :each | each uninstall ].
- super tearDown.
- self generate
+ "Modified: / 25-06-2013 / 13:13:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CoverageReport class methodsFor:'documentation'!