|
1 "{ Package: 'stx:goodies/xmlsuite/relaxng' }" |
|
2 |
|
3 "{ NameSpace: RNG }" |
|
4 |
|
5 TestCase subclass:#ValidationTests |
|
6 instanceVariableNames:'testItems' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'Relax NG-Tests' |
|
10 ! |
|
11 |
|
12 ValidationTests class instanceVariableNames:'testDirectory testDefsModifTS testItems' |
|
13 |
|
14 " |
|
15 The following class instance variables are inherited by this class: |
|
16 |
|
17 TestCase - lastTestRunResultOrNil lastTestRunsFailedTests |
|
18 Object - |
|
19 " |
|
20 ! |
|
21 |
|
22 XMLv2::ContentHandler subclass:#TestDefsParser |
|
23 instanceVariableNames:'testItems currentItem context currentAssertMessage' |
|
24 classVariableNames:'' |
|
25 poolDictionaries:'' |
|
26 privateIn:ValidationTests |
|
27 ! |
|
28 |
|
29 Object subclass:#TestItem |
|
30 instanceVariableNames:'name schemaFile xmlFile exception errorLine result asserts' |
|
31 classVariableNames:'' |
|
32 poolDictionaries:'' |
|
33 privateIn:ValidationTests |
|
34 ! |
|
35 |
|
36 !ValidationTests class methodsFor:'documentation'! |
|
37 |
|
38 documentation |
|
39 " |
|
40 documentation to be added. |
|
41 |
|
42 [author:] |
|
43 Jan Vrany (janfrog@john) |
|
44 |
|
45 [instance variables:] |
|
46 |
|
47 [class variables:] |
|
48 |
|
49 [see also:] |
|
50 |
|
51 " |
|
52 ! |
|
53 |
|
54 history |
|
55 "Created: / 27-04-2005 / 19:14:44 / janfrog" |
|
56 ! ! |
|
57 |
|
58 !ValidationTests class methodsFor:'accessing'! |
|
59 |
|
60 _allTestSelectors |
|
61 |
|
62 self allTestFiles collect:[:f|f baseName asSymbol] |
|
63 |
|
64 "Created: / 27-04-2005 / 19:36:10 / janfrog" |
|
65 ! |
|
66 |
|
67 allTestSelectors |
|
68 |
|
69 ^self allTestItems collect:[:e|e name ] |
|
70 |
|
71 "Created: / 27-04-2005 / 19:47:52 / janfrog" |
|
72 "Modified: / 14-05-2005 / 10:37:30 / janfrog" |
|
73 ! |
|
74 |
|
75 askForTestDirectory |
|
76 |
|
77 | dir | |
|
78 |
|
79 ^(dir := Dialog requestDirectoryName:'Select directory with tests') isEmpty |
|
80 ifTrue:['.' asFilename] |
|
81 ifFalse:[ |
|
82 dir asFilename exists ifFalse:[ |
|
83 Dialog warn:'Selected dir does not exist'. |
|
84 self askForTestDirectory. |
|
85 ] ifTrue:[dir] |
|
86 ] |
|
87 |
|
88 "Created: / 27-04-2005 / 19:33:48 / janfrog" |
|
89 ! |
|
90 |
|
91 standardTestDirectory |
|
92 |
|
93 ^((Smalltalk getPackageDirectoryForPackage:self package) |
|
94 construct:'/resources/tests') asFilename |
|
95 |
|
96 "Created: / 27-04-2005 / 19:30:25 / janfrog" |
|
97 ! |
|
98 |
|
99 testDirectory |
|
100 |
|
101 testDirectory ifNil:[ |
|
102 (testDirectory := self standardTestDirectory) |
|
103 exists ifFalse:[ |
|
104 testDirectory := self askForTestDirectory |
|
105 ] |
|
106 ]. |
|
107 ^testDirectory |
|
108 |
|
109 " |
|
110 testDirectory := nil |
|
111 " |
|
112 |
|
113 "Created: / 27-04-2005 / 19:27:53 / janfrog" |
|
114 "Modified: / 14-05-2005 / 10:19:42 / janfrog" |
|
115 "Modified: / 16-05-2005 / 09:38:23 / masca" |
|
116 ! |
|
117 |
|
118 testFileNamed:aString |
|
119 |
|
120 ^(self testDirectory construct:aString) asFilename |
|
121 |
|
122 "Created: / 14-05-2005 / 10:41:49 / janfrog" |
|
123 ! |
|
124 |
|
125 testWithName:aSymbol |
|
126 |
|
127 ^self allTestItems detect:[:i|i name = aSymbol] |
|
128 |
|
129 "Created: / 14-05-2005 / 10:38:19 / janfrog" |
|
130 ! ! |
|
131 |
|
132 !ValidationTests class methodsFor:'private'! |
|
133 |
|
134 allTestItems |
|
135 |
|
136 | handler | |
|
137 |
|
138 (testDefsModifTS isNil |
|
139 or:[self testDefsFile modificationTime > testDefsModifTS]) ifTrue:[ |
|
140 handler := TestDefsParser new. |
|
141 XMLv2::XMLReader new |
|
142 setContentHandler:handler; |
|
143 parseStream:(self testDefsFile readStream). |
|
144 testItems := handler testItems. |
|
145 testDefsModifTS := self testDefsFile modificationTime. |
|
146 ]. |
|
147 ^testItems |
|
148 |
|
149 "Created: / 14-05-2005 / 10:12:13 / janfrog" |
|
150 ! |
|
151 |
|
152 testDefsFile |
|
153 |
|
154 ^self testFileNamed:'test-defs.xml' |
|
155 |
|
156 "Created: / 14-05-2005 / 10:12:54 / janfrog" |
|
157 ! ! |
|
158 |
|
159 !ValidationTests methodsFor:'initialize / release'! |
|
160 |
|
161 setUp |
|
162 "common setup - invoked before testing." |
|
163 |
|
164 super setUp |
|
165 |
|
166 "Created: / 27-04-2005 / 19:14:44 / janfrog" |
|
167 ! |
|
168 |
|
169 tearDown |
|
170 "common cleanup - invoked after testing." |
|
171 |
|
172 super tearDown |
|
173 |
|
174 "Created: / 27-04-2005 / 19:14:44 / janfrog" |
|
175 ! ! |
|
176 |
|
177 !ValidationTests methodsFor:'private'! |
|
178 |
|
179 doesNotUnderstand:aMessage |
|
180 |
|
181 ('test*' match:aMessage selector ) |
|
182 ifFalse:[^super doesNotUnderstand:aMessage]. |
|
183 |
|
184 self performTest:(self class testWithName:aMessage selector). |
|
185 |
|
186 "Created: / 27-04-2005 / 19:46:38 / janfrog" |
|
187 "Modified: / 14-05-2005 / 10:38:39 / janfrog" |
|
188 ! |
|
189 |
|
190 performTest:aTestItem |
|
191 |xmlFile schema exception line result| |
|
192 |
|
193 [ |
|
194 schema := Schema fromFile:(self class testFileNamed:aTestItem schemaFile). |
|
195 xmlFile := self class testFileNamed:aTestItem xmlFile. |
|
196 result := self validate:xmlFile usingSchema:schema |
|
197 ] on:Error do:[:ex | |
|
198 exception := ex. |
|
199 line := ex errorLine. |
|
200 (aTestItem exceptionClass == UndefinedObject) ifTrue:[ |
|
201 ex pass |
|
202 ]. |
|
203 ]. |
|
204 self assert:exception class == aTestItem exceptionClass. |
|
205 self assert:line = aTestItem errorLine. |
|
206 aTestItem asserts keysAndValuesDo:[:msg :assertBlock | |
|
207 self |
|
208 assert:(assertBlock value:result) |
|
209 message:msg. |
|
210 ] |
|
211 |
|
212 "Created: / 14-05-2005 / 10:36:47 / janfrog" |
|
213 "Modified: / 14-05-2005 / 22:03:14 / janfrog" |
|
214 ! |
|
215 |
|
216 validate:xmlFile usingSchema:schema |
|
217 ^ schema validateFile:xmlFile |
|
218 |
|
219 "Created: / 14-05-2005 / 14:08:11 / janfrog" |
|
220 ! ! |
|
221 |
|
222 !ValidationTests methodsFor:'tests'! |
|
223 |
|
224 _test_all |
|
225 |
|
226 self class allTestFiles do:[:f| |
|
227 self performTestIn:f. |
|
228 ] |
|
229 |
|
230 "Created: / 27-04-2005 / 19:46:50 / janfrog" |
|
231 ! ! |
|
232 |
|
233 !ValidationTests::TestDefsParser methodsFor:'SAX2 events'! |
|
234 |
|
235 characters:aString |
|
236 |
|
237 (context == #addAssert:) ifTrue:[ |
|
238 currentItem addAssert:(currentAssertMessage->aString) |
|
239 ] ifFalse:[ |
|
240 |
|
241 currentItem perform:context with:aString |
|
242 ] |
|
243 |
|
244 "Created: / 14-05-2005 / 10:10:26 / janfrog" |
|
245 "Modified: / 14-05-2005 / 15:03:34 / janfrog" |
|
246 ! |
|
247 |
|
248 startDocument |
|
249 |
|
250 testItems := OrderedCollection new |
|
251 |
|
252 "Created: / 14-05-2005 / 10:01:07 / janfrog" |
|
253 ! |
|
254 |
|
255 startElement:localName namespace:namespace prefix:prefix attributes:attributes |
|
256 |
|
257 localName = 'test-defs' ifTrue:[^self]. |
|
258 localName = 'test' ifTrue:[ |
|
259 currentItem := testItems add:ValidationTests::TestItem new. |
|
260 currentItem setName:(attributes getValueByURI:namespace localName:'name'). |
|
261 currentItem setResult:(attributes getValueByURI:namespace localName:'res'). |
|
262 ^self |
|
263 ]. |
|
264 localName = 'schema' ifTrue:[^context := #setSchemaFile:]. |
|
265 localName = 'doc' ifTrue:[^context := #setXMLFile:]. |
|
266 localName = 'exception' ifTrue:[^context := #setExceptionName:]. |
|
267 localName = 'line' ifTrue:[^context := #setErrorLine:]. |
|
268 localName = 'assert' ifTrue:[ |
|
269 currentAssertMessage := (attributes getValueByURI:namespace localName:'msg'). |
|
270 ^context := #addAssert: |
|
271 ]. |
|
272 |
|
273 self error:'Unexpected element' |
|
274 |
|
275 "Modified: / 14-05-2005 / 14:13:21 / janfrog" |
|
276 ! ! |
|
277 |
|
278 !ValidationTests::TestDefsParser methodsFor:'accessing'! |
|
279 |
|
280 testItems |
|
281 ^ testItems |
|
282 |
|
283 "Created: / 14-05-2005 / 10:01:46 / janfrog" |
|
284 ! ! |
|
285 |
|
286 !ValidationTests::TestItem methodsFor:'accessing'! |
|
287 |
|
288 asserts |
|
289 ^ asserts ifNil:[asserts := Dictionary new] |
|
290 |
|
291 "Created: / 14-05-2005 / 14:08:55 / janfrog" |
|
292 ! |
|
293 |
|
294 errorLine |
|
295 ^ errorLine |
|
296 |
|
297 "Created: / 14-05-2005 / 10:35:39 / janfrog" |
|
298 ! |
|
299 |
|
300 exceptionClass |
|
301 ^ exception ? (nil class) |
|
302 |
|
303 "Created: / 14-05-2005 / 11:38:25 / janfrog" |
|
304 ! |
|
305 |
|
306 name |
|
307 ^ name |
|
308 |
|
309 "Created: / 14-05-2005 / 10:35:39 / janfrog" |
|
310 ! |
|
311 |
|
312 result |
|
313 ^ result |
|
314 |
|
315 "Created: / 14-05-2005 / 10:35:39 / janfrog" |
|
316 ! |
|
317 |
|
318 schemaFile |
|
319 ^ schemaFile |
|
320 |
|
321 "Created: / 14-05-2005 / 10:35:39 / janfrog" |
|
322 ! |
|
323 |
|
324 xmlFile |
|
325 ^ xmlFile |
|
326 |
|
327 "Created: / 14-05-2005 / 10:35:39 / janfrog" |
|
328 ! ! |
|
329 |
|
330 !ValidationTests::TestItem methodsFor:'printing'! |
|
331 |
|
332 printOn:aStream |
|
333 |
|
334 aStream |
|
335 nextPutAll:'RNG test: ',name ; cr; |
|
336 nextPutAll:'schema: ',schemaFile ; cr; |
|
337 nextPutAll:'xml file:' , xmlFile ; cr. |
|
338 |
|
339 result = #fail ifTrue:[ |
|
340 aStream |
|
341 nextPutAll:'exception class: ',exception name ; cr; |
|
342 nextPutAll:'errorLine: ',errorLine printString. |
|
343 |
|
344 ] |
|
345 |
|
346 "Created: / 14-05-2005 / 10:22:55 / janfrog" |
|
347 ! ! |
|
348 |
|
349 !ValidationTests::TestItem methodsFor:'setting'! |
|
350 |
|
351 addAssert:assoc |
|
352 |
|
353 assoc value:(Compiler evaluate:'[:res| ',assoc value,']'). |
|
354 |
|
355 self asserts add:assoc. |
|
356 |
|
357 "Created: / 14-05-2005 / 14:06:28 / janfrog" |
|
358 ! |
|
359 |
|
360 setErrorLine:aString |
|
361 |
|
362 errorLine := aString asNumber |
|
363 |
|
364 "Created: / 14-05-2005 / 10:33:06 / janfrog" |
|
365 ! |
|
366 |
|
367 setExceptionName:aString |
|
368 |
|
369 exception := Smalltalk at:aString asSymbol |
|
370 |
|
371 "Created: / 14-05-2005 / 10:32:13 / janfrog" |
|
372 ! |
|
373 |
|
374 setName:aString |
|
375 |
|
376 name := ('test_',aString) asSymbol |
|
377 |
|
378 "Created: / 14-05-2005 / 10:31:43 / janfrog" |
|
379 ! |
|
380 |
|
381 setResult:aString |
|
382 |
|
383 result := aString asSymbol |
|
384 |
|
385 "Created: / 14-05-2005 / 10:33:47 / janfrog" |
|
386 ! |
|
387 |
|
388 setSchemaFile:aString |
|
389 |
|
390 schemaFile := aString |
|
391 |
|
392 "Created: / 14-05-2005 / 10:31:52 / janfrog" |
|
393 ! |
|
394 |
|
395 setXMLFile:aString |
|
396 |
|
397 xmlFile := aString |
|
398 |
|
399 "Created: / 14-05-2005 / 10:31:59 / janfrog" |
|
400 ! ! |
|
401 |
|
402 !ValidationTests class methodsFor:'documentation'! |
|
403 |
|
404 version |
|
405 ^ '$Header: /opt/data/cvs/stx/goodies/xmlsuite/relaxng/RNG__ValidationTests.st,v 1.1.1.1 2005-11-01 22:07:16 vranyj1 Exp $' |
|
406 ! ! |