forked from pharo-project/pharo
/
ClassTestCase.class.st
140 lines (103 loc) · 3.65 KB
/
ClassTestCase.class.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
"
This class is intended for unit tests of individual classes and their metaclasses.
It provides methods to determine the coverage of the unit tests.
Subclasses are expected to re-implement #classesToBeTested and #selectorsToBeIgnored.
They should also implement to confirm that all methods have been tested.
#testCoverage
super testCoverage.
"
Class {
#name : #ClassTestCase,
#superclass : #AbstractEnvironmentTestCase,
#category : #'SUnit-Core-Utilities'
}
{ #category : #testing }
ClassTestCase class >> isAbstract [
"Override to true if a TestCase subclass is Abstract and should not have
TestCase instances built from it"
^self name = #ClassTestCase
]
{ #category : #testing }
ClassTestCase class >> mustTestCoverage [
^ false
]
{ #category : #private }
ClassTestCase >> categoriesForClass: aClass [
^ aClass organization allMethodSelectors collect:
[:each | aClass organization categoryOfElement: each].
]
{ #category : #coverage }
ClassTestCase >> classToBeTested [
^ self subclassResponsibility
]
{ #category : #utilities }
ClassTestCase >> differentMethodsWithSameSelectorBetween: firstClass and: secondClass [
| repeatedSelectors differentMethodsWithSameSelector |
repeatedSelectors := firstClass localSelectors intersection: secondClass localSelectors.
differentMethodsWithSameSelector := repeatedSelectors select: [ :selector | | m1 m2|
m1 := firstClass>>selector.
m2 := secondClass>>selector.
m1 sourceCode ~= m2 sourceCode].
^differentMethodsWithSameSelector.
]
{ #category : #utilities }
ClassTestCase >> repeatedMethodsThatDoNotAccessInstanceVariablesBetween: firstClass and: secondClass [
| repeatedSelectors repeatedMethodsThatDoNotAccessInstanceVariables |
repeatedSelectors := firstClass localSelectors intersection: secondClass localSelectors.
repeatedMethodsThatDoNotAccessInstanceVariables := repeatedSelectors select: [ :selector | | m1 m2|
m1 := firstClass>>selector.
m2 := secondClass>>selector.
((m1 sourceCode = m2 sourceCode) and: [ m1 hasInstVarRef not ]) and: [ m2 hasInstVarRef not ]].
^repeatedMethodsThatDoNotAccessInstanceVariables.
]
{ #category : #coverage }
ClassTestCase >> selectorsNotTested [
^ self selectorsToBeTested difference: self selectorsTested.
]
{ #category : #coverage }
ClassTestCase >> selectorsTested [
| literals |
literals := Set new.
self class
selectorsAndMethodsDo: [ :s :m | (s beginsWith: 'test')
ifTrue: [ literals addAll: (m messages)] ].
^ literals asArray sort
]
{ #category : #coverage }
ClassTestCase >> selectorsToBeIgnored [
^ #()
]
{ #category : #coverage }
ClassTestCase >> selectorsToBeTested [
^ ( { self classToBeTested. self classToBeTested class } flatCollect: [:c | c selectors])
difference: self selectorsToBeIgnored
]
{ #category : #private }
ClassTestCase >> targetClass [
[ ^ self classToBeTested ]
on: Error
do: [
| className |
className := self class name asString copyFrom: 1 to: self class name size - 4.
^ testingEnvironment at: className asString asSymbol ]
]
{ #category : #tests }
ClassTestCase >> testCoverage [
| untested |
self class mustTestCoverage ifTrue:
[ untested := self selectorsNotTested.
self assert: untested isEmpty
description: untested size asString, ' selectors are not covered' ]
]
{ #category : #tests }
ClassTestCase >> testNew [
self targetClass new
]
{ #category : #tests }
ClassTestCase >> testUnCategorizedMethods [
| uncategorizedMethods |
uncategorizedMethods := self targetClass selectorsInProtocol: Protocol unclassified.
self
assert: uncategorizedMethods isEmpty
description: uncategorizedMethods asString
]