Mercurial Mercurial > hg > stx-goodies-builder / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
reports/Builder__CoverageReport.st
changeset 166 5bf6af786b93
parent 148 50cf14e8d665
child 185 f1415a086e05 
--- 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'!
hg/stx-goodies-builder