68
|
1 |
"{ Package: 'stx:goodies/builder/reports' }"
|
|
2 |
|
|
3 |
"{ NameSpace: Builder }"
|
|
4 |
|
|
5 |
TestReport subclass:#CoverageReport
|
|
6 |
instanceVariableNames:'packages wrappers covered'
|
|
7 |
classVariableNames:''
|
|
8 |
poolDictionaries:''
|
|
9 |
category:'Builder-Reports-Unfinished'
|
|
10 |
!
|
|
11 |
|
|
12 |
|
|
13 |
!CoverageReport methodsFor:'generating'!
|
|
14 |
|
|
15 |
generate
|
|
16 |
| coverage |
|
|
17 |
covered := (wrappers select: [ :each | each hasRun ])
|
|
18 |
collect: [ :each | each reference ].
|
|
19 |
coverage := StandardFileStream
|
|
20 |
forceNewFileNamed: suite name , '-Coverage.xml'.
|
|
21 |
[ self generateOn: coverage ]
|
|
22 |
ensure: [ coverage close ]
|
|
23 |
!
|
|
24 |
|
|
25 |
generateDataOn: aStream
|
|
26 |
| items |
|
|
27 |
aStream tab; nextPutAll: '<data>'; nextPut: Character lf.
|
|
28 |
aStream tab; tab; nextPutAll: '<all name="all classes">'; nextPut: Character lf.
|
|
29 |
self
|
|
30 |
generateType: 'class' indent: 3
|
|
31 |
total: (items := (packages gather: [ :each | each classes ]) asSet) size
|
|
32 |
actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
|
|
33 |
count: [ :each | items includes: each ])
|
|
34 |
on: aStream.
|
|
35 |
self
|
|
36 |
generateType: 'method' indent: 3
|
|
37 |
total: (items := (packages gather: [ :each | each methods ]) asSet) size
|
|
38 |
actual: (covered count: [ :each | items includes: each ])
|
|
39 |
on: aStream.
|
|
40 |
packages do: [ :each | self generatePackage: each on: aStream ].
|
|
41 |
aStream tab; tab; nextPutAll: '</all>'; nextPut: Character lf.
|
|
42 |
aStream tab; nextPutAll: '</data>'; nextPut: Character lf
|
|
43 |
!
|
|
44 |
|
|
45 |
generateOn: aStream
|
|
46 |
aStream nextPutAll: '<?xml version="1.0" encoding="UTF-8"?>'; nextPut: Character lf.
|
|
47 |
aStream nextPutAll: '<report>'; nextPut: Character lf.
|
|
48 |
self generateStatsOn: aStream.
|
|
49 |
self generateDataOn: aStream.
|
|
50 |
aStream nextPutAll: '</report>'; nextPut: Character lf
|
|
51 |
!
|
|
52 |
|
|
53 |
generatePackage: aPackage class: aClass on: aStream
|
|
54 |
| items |
|
|
55 |
aStream tab: 4; nextPutAll: '<class name="'; nextPutAll: (self encode: aClass name); nextPutAll: '">'; nextPut: Character lf.
|
|
56 |
self
|
|
57 |
generateType: 'class' indent: 5
|
|
58 |
total: 1
|
|
59 |
actual: ((covered anySatisfy: [ :each | each actualClass theNonMetaClass = aClass ])
|
|
60 |
ifTrue: [ 1 ] ifFalse: [ 0 ])
|
|
61 |
on: aStream.
|
|
62 |
self
|
|
63 |
generateType: 'method' indent: 5
|
|
64 |
total: (items := aPackage coreMethodsForClass: aClass) size
|
|
65 |
actual: (covered count: [ :each | items includes: each ])
|
|
66 |
on: aStream.
|
|
67 |
items do: [ :each | self generatePackage: each method: each on: aStream ].
|
|
68 |
aStream tab: 4; nextPutAll: '</class>'; nextPut: Character lf
|
|
69 |
!
|
|
70 |
|
|
71 |
generatePackage: aPackage method: aReference on: aStream
|
|
72 |
| items |
|
|
73 |
aStream tab: 5; nextPutAll: '<method name="'; nextPutAll: (self encode: aReference selector); nextPutAll: '">'; nextPut: Character lf.
|
|
74 |
self
|
|
75 |
generateType: 'method' indent: 6
|
|
76 |
total: 1
|
|
77 |
actual: ((covered includes: aReference) ifTrue: [ 1 ] ifFalse: [ 0 ])
|
|
78 |
on: aStream.
|
|
79 |
aStream tab: 5; nextPutAll: '</method>'; nextPut: Character lf
|
|
80 |
!
|
|
81 |
|
|
82 |
generatePackage: aPackage on: aStream
|
|
83 |
| items |
|
|
84 |
aStream tab: 3; nextPutAll: '<package name="'; nextPutAll: (self encode: (aPackage packageName copyReplaceAll: '-' with: '.')); nextPutAll: '">'; nextPut: Character lf.
|
|
85 |
self
|
|
86 |
generateType: 'class' indent: 4
|
|
87 |
total: (items := aPackage classes asSet) size
|
|
88 |
actual: ((covered collect: [ :each | each actualClass theNonMetaClass ]) asSet
|
|
89 |
count: [ :each | items includes: each ])
|
|
90 |
on: aStream.
|
|
91 |
self
|
|
92 |
generateType: 'method' indent: 4
|
|
93 |
total: (items := aPackage methods asSet) size
|
|
94 |
actual: (covered count: [ :each | items includes: each ])
|
|
95 |
on: aStream.
|
|
96 |
aPackage classes
|
|
97 |
do: [ :class | self generatePackage: aPackage class: class on: aStream ].
|
|
98 |
aStream tab: 3; nextPutAll: '</package>'; nextPut: Character lf
|
|
99 |
!
|
|
100 |
|
|
101 |
generateStatsOn: aStream
|
|
102 |
aStream tab; nextPutAll: '<stats>'; nextPut: Character lf.
|
|
103 |
aStream tab; tab; nextPutAll: '<packages value="'; print: (packages size); nextPutAll: '"/>'; nextPut: Character lf.
|
|
104 |
aStream tab; tab; nextPutAll: '<classes value="'; print: (packages detectSum: [ :each | each classes size ]); nextPutAll: '"/>'; nextPut: Character lf.
|
|
105 |
aStream tab; tab; nextPutAll: '<methods value="'; print: (packages detectSum: [ :each | each methods size ]); nextPutAll: '"/>'; nextPut: Character lf.
|
|
106 |
aStream tab; nextPutAll: '</stats>'; nextPut: Character lf.
|
|
107 |
!
|
|
108 |
|
|
109 |
generateType: aString indent: anInteger total: totalInteger actual: actualInteger on: aStream
|
|
110 |
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
|
|
111 |
! !
|
|
112 |
|
|
113 |
!CoverageReport methodsFor:'private'!
|
|
114 |
|
|
115 |
addTestsIn: aTestAsserter to: aSet
|
|
116 |
(aTestAsserter isKindOf: TestSuite) ifTrue: [
|
|
117 |
aTestAsserter tests
|
|
118 |
do: [ :each | self addTestsIn: each to: aSet ] ].
|
|
119 |
(aTestAsserter isKindOf: TestCase) ifTrue: [
|
|
120 |
(aTestAsserter class respondsTo: #packageNamesUnderTest) ifTrue: [
|
|
121 |
aTestAsserter class packageNamesUnderTest
|
|
122 |
do: [ :each | aSet add: (self halt:'Not ported')"(PackageInfo named: each)" ] ] ].
|
|
123 |
^ aSet
|
|
124 |
|
|
125 |
"Modified: / 08-03-2011 / 22:12:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
126 |
!
|
|
127 |
|
|
128 |
ignoredSelectors
|
|
129 |
^ #(packageNamesUnderTest classNamesNotUnderTest)
|
|
130 |
!
|
|
131 |
|
|
132 |
methodsIn: aPackage
|
|
133 |
aPackage isNil ifTrue: [ ^ #() ].
|
|
134 |
^ aPackage methods reject: [ :method |
|
|
135 |
(self ignoredSelectors includes: method methodSymbol)
|
|
136 |
or: [ method compiledMethod isAbstract
|
|
137 |
or: [ method compiledMethod refersToLiteral: #ignoreForCoverage ] ] ]
|
|
138 |
!
|
|
139 |
|
|
140 |
packagesIn: aTestAsserter
|
|
141 |
^ self addTestsIn: aTestAsserter to: Set new
|
|
142 |
! !
|
|
143 |
|
|
144 |
!CoverageReport methodsFor:'running'!
|
|
145 |
|
|
146 |
setUp
|
|
147 |
super setUp.
|
|
148 |
wrappers := ((packages := self packagesIn: suite)
|
|
149 |
gather: [ :package | self methodsIn: package ])
|
|
150 |
collect: [ :each | HDTestCoverage on: each ].
|
|
151 |
wrappers do: [ :each | each install ]
|
|
152 |
!
|
|
153 |
|
|
154 |
tearDown
|
|
155 |
wrappers do: [ :each | each uninstall ].
|
|
156 |
super tearDown.
|
|
157 |
self generate
|
|
158 |
! !
|
|
159 |
|
|
160 |
!CoverageReport class methodsFor:'documentation'!
|
|
161 |
|
|
162 |
version
|
|
163 |
^ '$Header$'
|
|
164 |
!
|
|
165 |
|
|
166 |
version_CVS
|
|
167 |
^ '$Header$'
|
|
168 |
!
|
|
169 |
|
|
170 |
version_SVN
|
|
171 |
^ '§Id: Builder__CoverageReport.st 283 2011-11-07 08:54:02Z vranyj1 §'
|
|
172 |
! !
|