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