author | vrany |
Sat, 20 Aug 2011 17:20:00 +0200 | |
changeset 391 | fb104ea5136f |
parent 390 | c2c3895aabd6 |
child 417 | b111f3cb1beb |
permissions | -rw-r--r-- |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
1 |
"{ Package: 'stx:goodies/sunit' }" |
0 | 2 |
|
222 | 3 |
TestAsserter subclass:#TestCase |
377 | 4 |
instanceVariableNames:'testSelector' |
5 |
classVariableNames:'' |
|
6 |
poolDictionaries:'' |
|
7 |
category:'SUnit-Base' |
|
0 | 8 |
! |
9 |
||
382 | 10 |
TestCase class instanceVariableNames:'lastOutcomes' |
81 | 11 |
|
12 |
" |
|
13 |
No other class instance variables are inherited by this class. |
|
14 |
" |
|
15 |
! |
|
16 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
17 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
18 |
!TestCase class methodsFor:'initialization'! |
12 | 19 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
20 |
initialize |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
21 |
ResumableTestFailure autoload |
138 | 22 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
23 |
" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
24 |
self initialize |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
25 |
" |
326 | 26 |
! |
27 |
||
28 |
postAutoload |
|
29 |
self projectDefinitionClass loadExtensions |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
30 |
! ! |
138 | 31 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
32 |
!TestCase class methodsFor:'instance creation'! |
2 | 33 |
|
288 | 34 |
asTestCase |
35 |
^ self |
|
36 |
||
37 |
"Created: / 02-08-2011 / 09:12:13 / cg" |
|
38 |
! |
|
39 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
40 |
debug: aSymbol |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
41 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
42 |
^(self selector: aSymbol) debug |
138 | 43 |
! |
2 | 44 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
45 |
run: aSymbol |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
46 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
47 |
^(self selector: aSymbol) run |
138 | 48 |
! |
49 |
||
0 | 50 |
selector: aSymbol |
103 | 51 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
52 |
^self new setTestSelector: aSymbol |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
53 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
54 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
55 |
suite |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
56 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
57 |
^self buildSuite |
0 | 58 |
! ! |
59 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
60 |
!TestCase class methodsFor:'accessing'! |
66 | 61 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
62 |
allTestSelectors |
328
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
63 |
| answer pivotClass lookupRoot | |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
64 |
|
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
65 |
answer := Set withAll: self testSelectors. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
66 |
self shouldInheritSelectors ifTrue:[ |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
67 |
pivotClass := self superclass. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
68 |
lookupRoot := self lookupHierarchyRoot. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
69 |
[pivotClass == lookupRoot] whileFalse:[ |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
70 |
pivotClass := pivotClass superclass. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
71 |
answer addAll: pivotClass testSelectors |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
72 |
] |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
73 |
]. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
74 |
^answer asSortedCollection asOrderedCollection |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
75 |
! |
66 | 76 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
77 |
forgetLastTestRunResult |
390 | 78 |
|
79 |
Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil). |
|
80 |
self changed:#lastTestRunResult. |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
81 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
82 |
"Modified: / 06-08-2006 / 11:40:07 / cg" |
390 | 83 |
"Modified: / 20-08-2011 / 15:10:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
84 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
85 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
86 |
isTestSelector:aSelector |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
87 |
|
290 | 88 |
^aSelector notNil and:[aSelector startsWith:'test'] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
89 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
90 |
"Created: / 06-08-2006 / 11:46:17 / cg" |
222 | 91 |
"Modified: / 05-12-2009 / 18:50:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
290 | 92 |
"Modified: / 02-08-2011 / 17:46:51 / cg" |
222 | 93 |
! |
94 |
||
382 | 95 |
lastTestRunResultOrNil |
222 | 96 |
|
382 | 97 |
"Returns true if all tests passed, false if at least |
98 |
one failed/error or nil if never run |
|
99 |
" |
|
100 |
lastOutcomes isNil ifTrue:[^nil]. |
|
101 |
lastOutcomes size ~= self testSelectors size ifTrue:[^nil]. |
|
102 |
lastOutcomes do:[:outcome| |
|
103 |
outcome result == #pass ifFalse:[ |
|
104 |
^false |
|
105 |
]. |
|
106 |
]. |
|
107 |
^true |
|
222 | 108 |
|
382 | 109 |
"Modified: / 20-08-2011 / 14:59:26 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
110 |
! |
87
24e88e7f5d88
remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents:
82
diff
changeset
|
111 |
|
222 | 112 |
lookupHierarchyRoot |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
113 |
^TestCase |
222 | 114 |
! |
115 |
||
382 | 116 |
rememberOutcome: outcome |
222 | 117 |
|
382 | 118 |
lastOutcomes isNil ifTrue:[ |
119 |
lastOutcomes := OrderedCollection new. |
|
120 |
]. |
|
121 |
"Not a nice code, but portable..." |
|
122 |
1 to: lastOutcomes size do:[:i| |
|
123 |
| each | |
|
222 | 124 |
|
382 | 125 |
each := lastOutcomes at: i. |
126 |
(each testCase class == outcome testCase class and: |
|
127 |
[each testCase selector == outcome testCase selector]) ifTrue:[ |
|
128 |
lastOutcomes at: i put: outcome. |
|
129 |
each result ~= outcome result ifTrue:[ |
|
130 |
self lastTestRunResultChanged: outcome selector. |
|
131 |
]. |
|
132 |
^self. |
|
133 |
]. |
|
222 | 134 |
]. |
382 | 135 |
lastOutcomes add: outcome. |
136 |
self lastTestRunResultChanged: outcome selector. |
|
137 |
^self |
|
222 | 138 |
|
382 | 139 |
"Created: / 20-08-2011 / 12:43:12 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
140 |
! |
81 | 141 |
|
382 | 142 |
rememberedOutcomeFor: selector |
222 | 143 |
|
382 | 144 |
lastOutcomes isNil ifTrue:[^nil]. |
391 | 145 |
^lastOutcomes |
146 |
detect: [:outcome| outcome testCase selector == selector] |
|
147 |
ifNone:[nil]. |
|
87
24e88e7f5d88
remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents:
82
diff
changeset
|
148 |
|
382 | 149 |
"Created: / 20-08-2011 / 14:27:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
150 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
151 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
152 |
resources |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
153 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
154 |
^#() |
222 | 155 |
! |
156 |
||
157 |
shouldFork |
|
158 |
||
159 |
^false |
|
160 |
||
161 |
"Created: / 13-06-2011 / 16:46:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
103 | 162 |
! |
163 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
164 |
sunitVersion |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
165 |
^'4.0' |
222 | 166 |
! |
167 |
||
391 | 168 |
testSelector:selector result: result |
382 | 169 |
|
170 |
lastOutcomes isNil ifTrue:[^false]. |
|
391 | 171 |
^(lastOutcomes |
172 |
detect:[:each| |
|
173 |
each testCase class == self |
|
174 |
and:[each testCase selector == selector |
|
175 |
and:[each result == result]] |
|
176 |
] |
|
177 |
ifNone: [nil]) notNil |
|
178 |
||
179 |
"Created: / 20-08-2011 / 16:15:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
180 |
! |
|
181 |
||
182 |
testSelectorError:selector |
|
183 |
||
184 |
^self testSelector: selector result: #error |
|
222 | 185 |
|
186 |
"Created: / 15-03-2010 / 19:44:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
187 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
188 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
189 |
testSelectorFailed:selector |
222 | 190 |
|
391 | 191 |
^self testSelector: selector result: #fail |
382 | 192 |
|
391 | 193 |
"Modified: / 20-08-2011 / 16:16:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
194 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
195 |
|
222 | 196 |
testSelectorPassed:selector |
382 | 197 |
|
391 | 198 |
^self testSelector: selector result: #pass |
211
3a40b828ce9a
comment/format in: #testSelectors
Claus Gittinger <cg@exept.de>
parents:
209
diff
changeset
|
199 |
|
222 | 200 |
"Created: / 15-03-2010 / 17:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
201 |
! ! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
202 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
203 |
!TestCase class methodsFor:'building suites'! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
204 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
205 |
buildSuite |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
206 |
| suite | |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
207 |
^self isAbstract |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
208 |
ifTrue: |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
209 |
[suite := self suiteClass named: self name asString. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
210 |
self allSubclasses |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
211 |
do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]]. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
212 |
suite] |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
213 |
ifFalse: [self buildSuiteFromSelectors] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
214 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
215 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
216 |
buildSuiteFromMethods: testMethods |
68 | 217 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
218 |
^testMethods |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
219 |
inject: (self suiteClass named: self name asString) |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
220 |
into: [:suite :selector | |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
221 |
suite |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
222 |
addTest: (self selector: selector); |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
223 |
yourself] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
224 |
! |
138 | 225 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
226 |
buildSuiteFromSelectors |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
227 |
^self buildSuiteFromMethods: self allTestSelectors |
68 | 228 |
! |
229 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
230 |
suiteClass |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
231 |
^TestSuite |
68 | 232 |
! ! |
233 |
||
203 | 234 |
!TestCase class methodsFor:'misc ui support'! |
235 |
||
236 |
iconInBrowserSymbol |
|
237 |
<resource: #programImage> |
|
238 |
||
205 | 239 |
|lastResult| |
240 |
||
203 | 241 |
self theNonMetaclass isAbstract ifTrue:[^ super iconInBrowserSymbol]. |
205 | 242 |
|
243 |
lastResult := self lastTestRunResultOrNil. |
|
244 |
lastResult == true ifTrue:[ |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
245 |
^ #testCasePassedIcon |
205 | 246 |
]. |
247 |
lastResult == false ifTrue:[ |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
248 |
^ #testCaseFailedIcon |
205 | 249 |
]. |
203 | 250 |
^ #testCaseClassIcon |
251 |
! ! |
|
252 |
||
222 | 253 |
!TestCase class methodsFor:'private'! |
254 |
||
255 |
addSelector: selector to: collection |
|
256 |
||
257 |
"Adds given selector from collection. Answers |
|
258 |
true iff selector was really added" |
|
259 |
||
260 |
^(collection includes: selector) |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
261 |
ifTrue:[false] |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
262 |
ifFalse:[collection add: selector. true] |
222 | 263 |
|
264 |
"Created: / 15-03-2010 / 18:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
265 |
"Modified: / 21-04-2010 / 23:19:14 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
266 |
! |
|
267 |
||
268 |
lastTestRunResultChanged: selector |
|
269 |
||
270 |
Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector). |
|
271 |
self changed:#lastTestRunResult with:selector. |
|
272 |
||
273 |
"Created: / 15-03-2010 / 19:15:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
274 |
! |
|
275 |
||
276 |
testSelectors |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
277 |
"The API method is allTestSelectors which now includes #shouldInheritSelectors and so handles all cases. Unlike that method, this does not guarantee to return a sorted ordered collection." |
222 | 278 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
279 |
^self sunitSelectors select: [:each | 'test*' sunitMatch: each] |
222 | 280 |
! ! |
281 |
||
197 | 282 |
!TestCase class methodsFor:'quick testing'! |
283 |
||
284 |
assert: aBoolean |
|
285 |
^ self new assert: aBoolean |
|
286 |
||
287 |
" |
|
288 |
TestCase assert: true |
|
289 |
" |
|
290 |
! |
|
291 |
||
292 |
should: aBlock raise: anError |
|
293 |
^ self new should: aBlock raise: anError |
|
294 |
||
295 |
" |
|
296 |
TestCase should:[ self error ] raise: Error |
|
297 |
" |
|
298 |
! ! |
|
299 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
300 |
!TestCase class methodsFor:'testing'! |
103 | 301 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
302 |
isAbstract |
326 | 303 |
"Override to true if a TestCase subclass is Abstract and should not have |
304 |
TestCase instances built from it" |
|
222 | 305 |
|
326 | 306 |
^self sunitName = #TestCase |
222 | 307 |
! |
308 |
||
309 |
isTestCaseLike |
|
310 |
||
311 |
^true |
|
312 |
||
313 |
"Created: / 06-03-2011 / 00:16:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
314 |
! |
103 | 315 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
316 |
rememberResult:result |
382 | 317 |
|
318 |
result outcomesDo:[:outcome|self rememberOutcome: outcome]. |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
319 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
320 |
"Created: / 05-08-2006 / 12:33:08 / cg" |
382 | 321 |
"Modified: / 20-08-2011 / 14:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
322 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
323 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
324 |
runTests |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
325 |
|
391 | 326 |
^self suite run |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
327 |
|
265
125e4f132d46
remember execution time (needed to generate prober reports)
Claus Gittinger <cg@exept.de>
parents:
262
diff
changeset
|
328 |
"Modified: / 30-07-2011 / 09:26:11 / cg" |
391 | 329 |
"Modified: / 20-08-2011 / 16:14:22 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
330 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
331 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
332 |
shouldInheritSelectors |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
333 |
"I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass. If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass." |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
334 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
335 |
^self ~~ self lookupHierarchyRoot |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
336 |
and: [self superclass isAbstract |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
337 |
or: [self testSelectors isEmpty]] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
338 |
! ! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
339 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
340 |
!TestCase methodsFor:'accessing'! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
341 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
342 |
resources |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
343 |
"We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical. Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought. If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate." |
222 | 344 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
345 |
^self class resources |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
346 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
347 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
348 |
selector |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
349 |
^testSelector |
222 | 350 |
! |
351 |
||
352 |
shouldFork |
|
353 |
||
354 |
^self class shouldFork |
|
355 |
||
356 |
"Created: / 13-06-2011 / 16:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
305 | 357 |
! |
358 |
||
359 |
testCount |
|
360 |
||
361 |
^1 |
|
362 |
||
363 |
"Created: / 04-08-2011 / 13:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
364 |
! ! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
365 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
366 |
!TestCase methodsFor:'accessing & queries'! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
367 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
368 |
unfinished |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
369 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
370 |
"indicates an unfinished test" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
371 |
! ! |
97 | 372 |
|
373 |
!TestCase methodsFor:'assertions'! |
|
66 | 374 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
375 |
assert:aBlock completesInSeconds:aNumber |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
376 |
"fail, if aBlock does not finish its work in aNumber seconds" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
377 |
|
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
378 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
379 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
380 |
|done process semaphore| |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
381 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
382 |
done := false. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
383 |
semaphore := Semaphore new. |
174 | 384 |
process := [ |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
385 |
aBlock value. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
386 |
done := true. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
387 |
semaphore signal |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
388 |
] fork. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
389 |
semaphore waitWithTimeout: aNumber. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
390 |
process terminate. |
222 | 391 |
self assert: done |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
392 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
393 |
" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
394 |
self new assert:[Delay waitForSeconds:2] completesInSeconds:1 |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
395 |
" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
396 |
" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
397 |
self new assert:[Delay waitForSeconds:1] completesInSeconds:2 |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
398 |
" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
399 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
400 |
|
222 | 401 |
assert: aBoolean message:messageIfFailing |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
402 |
|
222 | 403 |
^self assert: aBoolean description: messageIfFailing |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
404 |
|
222 | 405 |
"Modified: / 05-12-2009 / 18:16:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
406 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
407 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
408 |
assertFalse:aBoolean |
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
409 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
410 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
411 |
^ self assert:aBoolean not |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
412 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
413 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
414 |
assertFalse:aBoolean named:testName |
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
415 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
416 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
417 |
^ self assert:aBoolean not |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
418 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
419 |
|
222 | 420 |
assertTrue:aBoolean |
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
421 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
422 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
423 |
^ self assert:aBoolean |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
424 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
425 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
426 |
assertTrue:aBoolean named:testName |
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
427 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
428 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
429 |
^ self assert:aBoolean |
66 | 430 |
! ! |
431 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
432 |
!TestCase methodsFor:'dependencies'! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
433 |
|
222 | 434 |
addDependentToHierachy: anObject |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
435 |
"an empty method. for Composite compability with TestSuite" |
222 | 436 |
! |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
437 |
|
222 | 438 |
removeDependentFromHierachy: anObject |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
439 |
"an empty method. for Composite compability with TestSuite" |
222 | 440 |
! ! |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
441 |
|
222 | 442 |
!TestCase methodsFor:'deprecated'! |
443 |
||
444 |
should: aBlock |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
445 |
self assert: aBlock value |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
446 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
447 |
|
222 | 448 |
should: aBlock description: aString |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
449 |
self assert: aBlock value description: aString |
222 | 450 |
! |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
451 |
|
222 | 452 |
shouldnt: aBlock |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
453 |
self deny: aBlock value |
222 | 454 |
! |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
455 |
|
222 | 456 |
shouldnt: aBlock description: aString |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
457 |
self deny: aBlock value description: aString |
222 | 458 |
! |
459 |
||
460 |
signalFailure: aString |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
461 |
TestResult failure sunitSignalWith: aString. |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
462 |
! ! |
67 | 463 |
|
464 |
!TestCase methodsFor:'printing'! |
|
465 |
||
222 | 466 |
getTestName |
467 |
||
468 |
^testSelector. |
|
469 |
||
470 |
"Modified: / 05-12-2009 / 17:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
471 |
! |
|
472 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
473 |
name |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
474 |
^ self class name. |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
475 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
476 |
|
67 | 477 |
printOn: aStream |
478 |
||
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
479 |
aStream |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
480 |
nextPutAll: self class printString; |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
481 |
nextPutAll: '>>#'; |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
482 |
nextPutAll: testSelector |
67 | 483 |
! ! |
484 |
||
485 |
!TestCase methodsFor:'private'! |
|
486 |
||
222 | 487 |
executeShould: aBlock inScopeOf: anExceptionalEvent |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
488 |
"/ ^[aBlock value. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
489 |
"/ false] sunitOn: anExceptionalEvent |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
490 |
"/ do: [:ex | ex sunitExitWith: true] |
103 | 491 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
492 |
"/ [[aBlock value] |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
493 |
"/ on: anExceptionalEvent |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
494 |
"/ do: [:ex | ^true]] |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
495 |
"/ on: TestResult exError |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
496 |
"/ do: [:ex | ^false]. |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
497 |
[aBlock value] |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
498 |
on: anExceptionalEvent |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
499 |
do: [:ex | ^true]. |
103 | 500 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
501 |
^false. |
67 | 502 |
! |
503 |
||
504 |
performTest |
|
328
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
505 |
self perform: testSelector sunitAsSymbol |
67 | 506 |
! |
507 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
508 |
setTestSelector: aSymbol |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
509 |
testSelector := aSymbol |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
510 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
511 |
|
222 | 512 |
signalFailure:aString resumable:isResumable |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
513 |
"/ TestResult failure sunitSignalWith: aString |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
514 |
|
179
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
515 |
<resource: #skipInDebuggersWalkBack> |
caba0f640d13
context skipping in debugger generalized
Claus Gittinger <cg@exept.de>
parents:
174
diff
changeset
|
516 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
517 |
isResumable ifTrue:[ |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
518 |
TestResult resumableFailure |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
519 |
raiseRequestWith:nil |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
520 |
errorString:aString |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
521 |
in:thisContext sender sender |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
522 |
] ifFalse:[ |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
523 |
TestResult failure |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
524 |
raiseErrorString:aString |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
525 |
in:thisContext sender sender |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
526 |
]. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
527 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
528 |
"Modified: / 06-08-2006 / 22:55:55 / cg" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
529 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
530 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
531 |
signalUnavailableResources |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
532 |
|
222 | 533 |
self resources do:[:res | |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
534 |
res isAvailable ifFalse:[ |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
535 |
^ res signalInitializationError |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
536 |
] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
537 |
]. |
67 | 538 |
! ! |
539 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
540 |
!TestCase methodsFor:'queries'! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
541 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
542 |
isTestCase |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
543 |
^ true |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
544 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
545 |
|
221 | 546 |
isTestCaseLike |
547 |
^ true |
|
548 |
||
549 |
"Created: / 29-06-2011 / 20:37:57 / cg" |
|
550 |
! |
|
551 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
552 |
isTestSuite |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
553 |
^ false |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
554 |
! ! |
122 | 555 |
|
67 | 556 |
!TestCase methodsFor:'running'! |
557 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
558 |
debug |
382 | 559 |
|
560 |
| testCase outcome | |
|
561 |
||
562 |
[ |
|
563 |
(testCase := self class selector: testSelector) runCase. |
|
564 |
outcome := TestCaseOutcome new. |
|
565 |
outcome testCase: testCase. |
|
566 |
outcome result: #pass. |
|
567 |
outcome remember. |
|
568 |
] sunitEnsure: [ |
|
569 |
TestResource resetResources: self resources |
|
570 |
]. |
|
254
7f4b9fc9756b
changed: #debug - remembers test as passed if no error occur during debugging
vrany
parents:
240
diff
changeset
|
571 |
|
7f4b9fc9756b
changed: #debug - remembers test as passed if no error occur during debugging
vrany
parents:
240
diff
changeset
|
572 |
"Modified: / 07-07-2011 / 11:10:50 / jv" |
7f4b9fc9756b
changed: #debug - remembers test as passed if no error occur during debugging
vrany
parents:
240
diff
changeset
|
573 |
"Modified: / 07-07-2011 / 11:34:08 / Jan Vrany <jan.vrant@fit.cvut,cz>" |
382 | 574 |
"Modified: / 20-08-2011 / 14:15:51 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
575 |
! |
67 | 576 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
577 |
debugAsFailure |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
578 |
| semaphore | |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
579 |
semaphore := Semaphore new. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
580 |
[semaphore wait. TestResource resetResources: self resources] fork. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
581 |
(self class selector: testSelector) runCaseAsFailure: semaphore. |
67 | 582 |
! |
583 |
||
222 | 584 |
debugUsing:aSymbol |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
585 |
self signalUnavailableResources. |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
586 |
[ |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
587 |
"/ used to be: |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
588 |
"/ (self class selector:testSelector) perform:aSymbol |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
589 |
"/ which is bad for subclasses which need more arguments. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
590 |
"/ why not use: |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
591 |
"/ self copy perform:aSymbol |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
592 |
"/ or even |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
593 |
"/ self perform:aSymbol |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
594 |
"/ (self class selector:testSelector) perform:aSymbol |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
595 |
self perform:aSymbol |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
596 |
] ensure:[ |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
597 |
self resources do:[:each | |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
598 |
each reset |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
599 |
] |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
600 |
] |
194 | 601 |
|
602 |
||
603 |
||
604 |
||
605 |
||
606 |
||
607 |
||
608 |
||
609 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
610 |
! |
103 | 611 |
|
222 | 612 |
failureLog |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
613 |
^SUnitNameResolver class >> #defaultLogDevice |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
614 |
! |
103 | 615 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
616 |
isLogging |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
617 |
"By default, we're not logging failures. If you override this in |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
618 |
a subclass, make sure that you override #failureLog" |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
619 |
^false |
222 | 620 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
621 |
! |
103 | 622 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
623 |
logFailure: aString |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
624 |
self isLogging ifTrue: [ |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
625 |
self failureLog |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
626 |
cr; |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
627 |
nextPutAll: aString; |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
628 |
flush] |
222 | 629 |
|
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
630 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
631 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
632 |
openDebuggerOnFailingTestMethod |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
633 |
"SUnit has halted one step in front of the failing test method. Step over the 'self halt' and |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
634 |
send into 'self perform: testSelector' to see the failure from the beginning" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
635 |
|
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
636 |
self |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
637 |
"/halt; |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
638 |
performTest |
222 | 639 |
|
640 |
"Modified: / 05-12-2009 / 18:40:13 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
67 | 641 |
! |
642 |
||
643 |
run |
|
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
644 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
645 |
^self run: TestResult new |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
646 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
647 |
"Modified: / 29-07-2011 / 12:07:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
67 | 648 |
! |
649 |
||
650 |
run: aResult |
|
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
651 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
652 |
^self run: aResult beforeEachDo: [:test :result|] afterEachDo: [:test :result|] |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
653 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
654 |
"Modified: / 29-07-2011 / 12:07:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
67 | 655 |
! |
656 |
||
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
657 |
run: aResult afterEachDo:block2 |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
658 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
659 |
^self run: aResult beforeEachDo: [:test :result|] afterEachDo:block2 |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
660 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
661 |
"Modified: / 29-07-2011 / 12:07:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
662 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
663 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
664 |
run: aResult beforeEachDo:block1 afterEachDo:block2 |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
665 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
666 |
^self run: aResult beforeEachDo:block1 afterEachDo:block2 resetResources: true |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
667 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
668 |
"Modified: / 29-07-2011 / 12:06:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
669 |
! |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
670 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
671 |
run: result beforeEachDo: before afterEachDo: after resetResources: reset |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
672 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
673 |
"Workhorse for running a testcase. If reset is true, then |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
674 |
the resources are reset, otherwise not" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
675 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
676 |
"1. Execute before block" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
677 |
"This code is ugly in Smalltalk/X but it is so because |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
678 |
it is more portable - numArgs in ANSI (?)" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
679 |
before numArgs == 2 ifTrue:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
680 |
before value: self value: result |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
681 |
] ifFalse:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
682 |
before numArgs == 1 ifTrue:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
683 |
before value: self |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
684 |
] ifFalse:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
685 |
before value. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
686 |
] |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
687 |
]. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
688 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
689 |
"2. Run the testcase" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
690 |
reset ifTrue:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
691 |
[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
692 |
result runCase: self |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
693 |
] sunitEnsure: [ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
694 |
TestResource resetResources: self resources |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
695 |
]. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
696 |
] ifFalse:[ |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
697 |
result runCase: self |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
698 |
]. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
699 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
700 |
"3. Execute after block" |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
701 |
"This code is ugly in Smalltalk/X but it is so because |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
702 |
it is more portable - numArgs in ANSI (?)" |
282
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
703 |
after numArgs == 2 ifTrue:[ |
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
704 |
after value: self value: result |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
705 |
] ifFalse:[ |
282
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
706 |
after numArgs == 1 ifTrue:[ |
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
707 |
after value: self |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
708 |
] ifFalse:[ |
282
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
709 |
after value. |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
710 |
] |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
711 |
]. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
712 |
^result |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
713 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
714 |
"Created: / 29-07-2011 / 12:04:53 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
282
deb55165e73b
changed: #run:beforeEachDo:afterEachDo:resetResources:
Claus Gittinger <cg@exept.de>
parents:
265
diff
changeset
|
715 |
"Modified: / 01-08-2011 / 10:22:09 / cg" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
716 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
717 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
718 |
run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2 |
262
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
719 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
720 |
<resource: #obsolete> |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
721 |
self obsoleteMethodWarning: 'Use #run:beforeEachDo:afterEachDo: instead'. |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
722 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
723 |
^self run: aResult beforeEachDo:block1 afterEachDo:block2 |
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
724 |
|
3c46acd3f64a
TestSuite/TestCase run* method refactored (cleanup, possible bug fixes)
vrany
parents:
254
diff
changeset
|
725 |
"Modified: / 29-07-2011 / 12:06:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
726 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
727 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
728 |
runCase |
328
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
729 |
self resources do: [:each | each availableFor: self]. |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
730 |
|
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
731 |
[ |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
732 |
self setUp. |
377 | 733 |
self performTest. |
328
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
734 |
] sunitEnsure: [ |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
735 |
self tearDown |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
736 |
] |
66cae160c956
added: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
326
diff
changeset
|
737 |
|
377 | 738 |
"Modified (comment): / 18-08-2011 / 20:35:20 / cg" |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
739 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
740 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
741 |
runCaseAsFailure |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
742 |
self setUp. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
743 |
[[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
744 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
745 |
"Modified: / 21.6.2000 / 10:04:33 / Sames" |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
746 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
747 |
|
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
748 |
runCaseAsFailure: aSemaphore |
331
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
749 |
[self resources do: [:each | each availableFor: self]. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
750 |
[self setUp. |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
751 |
self openDebuggerOnFailingTestMethod] |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
752 |
sunitEnsure: [self tearDown]] |
ea59d5e02844
moved: #withStandardOutputAndTranscriptRedirectedDo:
Claus Gittinger <cg@exept.de>
parents:
328
diff
changeset
|
753 |
sunitEnsure: [aSemaphore signal]. |
139
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
754 |
! |
5a48f282d789
back to 1.42 - last checked in version was bogus
Claus Gittinger <cg@exept.de>
parents:
138
diff
changeset
|
755 |
|
67 | 756 |
setUp |
757 |
! |
|
758 |
||
759 |
tearDown |
|
50 | 760 |
! ! |
761 |
||
12 | 762 |
!TestCase class methodsFor:'documentation'! |
763 |
||
290 | 764 |
version |
391 | 765 |
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.78 2011-08-20 15:20:00 vrany Exp $' |
290 | 766 |
! |
767 |
||
203 | 768 |
version_CVS |
391 | 769 |
^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.78 2011-08-20 15:20:00 vrany Exp $' |
222 | 770 |
! |
771 |
||
772 |
version_SVN |
|
773 |
^ '§Id: TestCase.st 218 2011-06-13 15:45:06Z vranyj1 §' |
|
12 | 774 |
! ! |
81 | 775 |
|
2 | 776 |
TestCase initialize! |