author | fm |
Mon, 21 Sep 2009 10:10:10 +0200 | |
changeset 202 | 46947f02aaa4 |
parent 164 | 40ae3ba82e24 |
child 222 | 8e6f482297fa |
permissions | -rw-r--r-- |
0 | 1 |
"{ Package: 'stx:goodies/sunit' }" |
2 |
||
3 |
Object subclass:#TestSuite |
|
103 | 4 |
instanceVariableNames:'tests resources name' |
0 | 5 |
classVariableNames:'' |
6 |
poolDictionaries:'' |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
7 |
category:'SUnit-Base' |
0 | 8 |
! |
9 |
||
103 | 10 |
TestSuite comment:'This is a Composite of Tests, either TestCases or other TestSuites. The common protocol is #run: aTestResult and the dependencies protocol' |
11 |
! |
|
14 | 12 |
|
103 | 13 |
|
14 |
!TestSuite class methodsFor:'Creation'! |
|
56 | 15 |
|
16 |
named: aString |
|
103 | 17 |
|
18 |
^self new |
|
19 |
name: aString; |
|
20 |
yourself |
|
21 |
||
56 | 22 |
! ! |
23 |
||
68 | 24 |
!TestSuite methodsFor:'accessing'! |
0 | 25 |
|
26 |
addTest: aTest |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
27 |
self tests add: aTest |
103 | 28 |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
29 |
! |
0 | 30 |
|
31 |
addTests: aCollection |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
32 |
aCollection do: [:eachTest | self addTest: eachTest] |
103 | 33 |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
34 |
! |
0 | 35 |
|
47 | 36 |
defaultResources |
37 |
^self tests |
|
38 |
inject: Set new |
|
103 | 39 |
into: [:coll :testCase | |
47 | 40 |
coll |
41 |
addAll: testCase resources; |
|
42 |
yourself] |
|
103 | 43 |
|
47 | 44 |
! |
45 |
||
37 | 46 |
name |
103 | 47 |
|
37 | 48 |
^ name ? 'a TestSuite'. |
49 |
! |
|
50 |
||
103 | 51 |
name: aString |
52 |
||
53 |
name := aString |
|
54 |
||
37 | 55 |
! |
56 |
||
137 | 57 |
nameOfTest |
58 |
^ self name |
|
59 |
! |
|
60 |
||
47 | 61 |
resources |
62 |
resources isNil ifTrue: [resources := self defaultResources]. |
|
63 |
^resources |
|
103 | 64 |
|
47 | 65 |
! |
66 |
||
67 |
resources: anObject |
|
68 |
resources := anObject |
|
103 | 69 |
|
47 | 70 |
! |
71 |
||
140 | 72 |
testName |
73 |
^ self name |
|
74 |
||
75 |
"Created: / 12-09-2006 / 11:38:09 / cg" |
|
76 |
! |
|
77 |
||
0 | 78 |
tests |
79 |
tests isNil ifTrue: [tests := OrderedCollection new]. |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
80 |
^tests |
103 | 81 |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
82 |
! ! |
0 | 83 |
|
68 | 84 |
!TestSuite methodsFor:'dependencies'! |
0 | 85 |
|
86 |
addDependentToHierachy: anObject |
|
32 | 87 |
self addDependent: anObject. |
103 | 88 |
self tests do: [ :each | each addDependentToHierachy: anObject] |
0 | 89 |
! |
90 |
||
91 |
removeDependentFromHierachy: anObject |
|
32 | 92 |
self removeDependent: anObject. |
103 | 93 |
self tests do: [ :each | each removeDependentFromHierachy: anObject] |
0 | 94 |
! ! |
95 |
||
122 | 96 |
!TestSuite methodsFor:'queries'! |
97 |
||
98 |
isTestCase |
|
99 |
^ false |
|
100 |
! |
|
101 |
||
102 |
isTestSuite |
|
103 |
^ true |
|
104 |
! ! |
|
105 |
||
68 | 106 |
!TestSuite methodsFor:'running'! |
0 | 107 |
|
108 |
run |
|
49 | 109 |
| result | |
103 | 110 |
|
111 |
self signalUnavailableResources. |
|
112 |
||
49 | 113 |
result := TestResult new. |
114 |
[self run: result] ensure: [self resources do: [:each | each reset]]. |
|
115 |
^result |
|
6
78bb1397e43d
added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents:
0
diff
changeset
|
116 |
! |
0 | 117 |
|
118 |
run: aResult |
|
103 | 119 |
self tests do: [:each | |
32 | 120 |
self changed: each. |
121 |
each run: aResult] |
|
40 | 122 |
! |
123 |
||
124 |
run: aResult afterEachDo:block2 |
|
125 |
self tests do: |
|
126 |
[:each | |
|
127 |
self changed: each. |
|
122 | 128 |
each run: aResult afterEachDo:block2. |
129 |
"/ block2 value:each value:aResult |
|
40 | 130 |
] |
131 |
||
132 |
"Modified: / 21.6.2000 / 10:14:01 / Sames" |
|
62 | 133 |
! |
134 |
||
135 |
run: aResult beforeEachDo:block1 afterEachDo:block2 |
|
202 | 136 |
|
164 | 137 |
|class| |
202 | 138 |
|
164 | 139 |
class := Smalltalk classNamed:name. |
140 |
class perform:#setUp ifNotUnderstood:nil. |
|
202 | 141 |
|
142 |
[ |
|
143 |
self tests do: |
|
144 |
[:each | |
|
145 |
self changed: each. |
|
146 |
block1 value:each value:aResult. |
|
147 |
each run: aResult beforeEachDo:block1 afterEachDo:block2. |
|
148 |
"/ each run: aResult. |
|
149 |
block2 value:each value:aResult. |
|
150 |
]. |
|
151 |
] ensure: [self resources do:[:e|e reset]]. |
|
152 |
||
164 | 153 |
class perform:#tearDown ifNotUnderstood:nil |
122 | 154 |
! |
155 |
||
156 |
run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2 |
|
157 |
self tests do: |
|
158 |
[:each | |
|
159 |
self changed: each. |
|
160 |
each run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2. |
|
161 |
] |
|
0 | 162 |
! ! |
163 |
||
68 | 164 |
!TestSuite methodsFor:'testing'! |
49 | 165 |
|
166 |
areAllResourcesAvailable |
|
167 |
^self resources |
|
168 |
inject: true |
|
169 |
into: [:total :each | each isAvailable & total] |
|
103 | 170 |
! |
171 |
||
172 |
signalUnavailableResources |
|
173 |
||
174 |
self resources do:[:res | |
|
175 |
res isAvailable ifFalse:[ |
|
176 |
^ res signalInitializationError |
|
177 |
] |
|
178 |
]. |
|
49 | 179 |
! ! |
180 |
||
14 | 181 |
!TestSuite class methodsFor:'documentation'! |
182 |
||
183 |
version |
|
202 | 184 |
^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.18 2009-09-21 08:10:10 fm Exp $' |
14 | 185 |
! ! |