|
1 "{ Package: 'squeak:petitparser' }" |
|
2 |
|
3 PPAbstractParseTest subclass:#PPParserTest |
|
4 instanceVariableNames:'' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitTests-Tests' |
|
8 ! |
|
9 |
|
10 |
|
11 !PPParserTest methodsFor:'testing'! |
|
12 |
|
13 testAction |
|
14 | block parser | |
|
15 block := [ :char | char asUppercase ]. |
|
16 parser := #any asParser ==> block. |
|
17 self assert: parser block = block. |
|
18 |
|
19 self assert: parser parse: 'a' to: $A. |
|
20 self assert: parser parse: 'b' to: $B |
|
21 ! |
|
22 |
|
23 testAnd |
|
24 | parser | |
|
25 parser := 'foo' asParser flatten , 'bar' asParser flatten and. |
|
26 |
|
27 self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3. |
|
28 self assert: parser fail: 'foobaz'. |
|
29 |
|
30 parser := 'foo' asParser and. |
|
31 self assert: parser and = parser |
|
32 ! |
|
33 |
|
34 testAnswer |
|
35 | parser | |
|
36 parser := $a asParser answer: $b. |
|
37 |
|
38 self assert: parser parse: 'a' to: $b. |
|
39 |
|
40 self assert: parser fail: ''. |
|
41 self assert: parser fail: 'b' |
|
42 ! |
|
43 |
|
44 testBlock |
|
45 | parser | |
|
46 parser := [ :s | s next ] asParser. |
|
47 |
|
48 self assert: parser parse: 'ab' to: $a end: 1. |
|
49 self assert: parser parse: 'b' to: $b. |
|
50 self assert: parser parse: '' to: nil |
|
51 ! |
|
52 |
|
53 testChoice |
|
54 | parser | |
|
55 parser := $a asParser / $b asParser. |
|
56 |
|
57 self assert: parser parse: 'a' to: $a. |
|
58 self assert: parser parse: 'b' to: $b. |
|
59 |
|
60 self assert: parser parse: 'ab' to: $a end: 1. |
|
61 self assert: parser parse: 'ba' to: $b end: 1. |
|
62 |
|
63 self assert: parser fail: ''. |
|
64 self assert: parser fail: 'c'. |
|
65 self assert: parser fail: 'ca' |
|
66 ! |
|
67 |
|
68 testDelimitedBy |
|
69 | parser | |
|
70 parser := $a asParser delimitedBy: $b asParser. |
|
71 |
|
72 self assert: parser parse: 'a' to: #($a). |
|
73 self assert: parser parse: 'aba' to: #($a $b $a). |
|
74 self assert: parser parse: 'ababa' to: #($a $b $a $b $a). |
|
75 |
|
76 self assert: parser parse: 'ab' to: #($a $b). |
|
77 self assert: parser parse: 'abab' to: #($a $b $a $b). |
|
78 self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b). |
|
79 |
|
80 self assert: parser parse: 'ac' to: #($a) end: 1. |
|
81 self assert: parser parse: 'abc' to: #($a $b) end: 2. |
|
82 self assert: parser parse: 'abac' to: #($a $b $a) end: 3. |
|
83 self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4. |
|
84 |
|
85 self assert: parser fail: ''. |
|
86 self assert: parser fail: 'b'. |
|
87 self assert: parser fail: 'c' |
|
88 ! |
|
89 |
|
90 testEndOfInput |
|
91 | parser | |
|
92 parser := PPEndOfInputParser on: $a asParser. |
|
93 self assert: parser end = parser. |
|
94 |
|
95 self assert: parser parse: 'a' to: $a. |
|
96 self assert: parser fail: ''. |
|
97 self assert: parser fail: 'aa' |
|
98 ! |
|
99 |
|
100 testEndOfInputAfterMatch |
|
101 | parser | |
|
102 parser := 'stuff' asParser end. |
|
103 self assert: parser parse: 'stuff' to: 'stuff'. |
|
104 self assert: parser fail: 'stufff'. |
|
105 self assert: parser fail: 'fluff' |
|
106 ! |
|
107 |
|
108 testEpsilon |
|
109 | parser | |
|
110 parser := nil asParser. |
|
111 |
|
112 self assert: parser parse: '' to: nil. |
|
113 |
|
114 self assert: parser parse: 'a' to: nil end: 0. |
|
115 self assert: parser parse: 'ab' to: nil end: 0 |
|
116 ! |
|
117 |
|
118 testFailing |
|
119 | parser result | |
|
120 parser := PPFailingParser message: 'Plonk'. |
|
121 self assert: parser message = 'Plonk'. |
|
122 |
|
123 self assert: parser fail: ''. |
|
124 self assert: parser fail: 'a'. |
|
125 self assert: parser fail: 'aa'. |
|
126 |
|
127 result := parser parse: 'a'. |
|
128 self assert: result message = 'Plonk'. |
|
129 self assert: result printString = 'Plonk at 0' |
|
130 ! |
|
131 |
|
132 testFlatten |
|
133 | parser | |
|
134 parser := $a asParser flatten. |
|
135 |
|
136 self assert: parser parse: 'a' to: 'a'. |
|
137 self assert: parser parse: #($a) to: #($a). |
|
138 |
|
139 self assert: parser fail: ''. |
|
140 self assert: parser fail: 'b' |
|
141 ! |
|
142 |
|
143 testLiteralObject |
|
144 | parser | |
|
145 parser := PPLiteralObjectParser |
|
146 on: $a |
|
147 message: 'letter "a" expected'. |
|
148 self assert: parser literal = $a. |
|
149 self assert: parser message = 'letter "a" expected'. |
|
150 |
|
151 self assert: parser parse: 'a' to: $a. |
|
152 self assert: parser fail: 'b' |
|
153 |
|
154 ! |
|
155 |
|
156 testLiteralObjectCaseInsensitive |
|
157 | parser | |
|
158 parser := $a asParser caseInsensitive. |
|
159 |
|
160 self assert: parser parse: 'a' to: $a. |
|
161 self assert: parser parse: 'A' to: $A. |
|
162 |
|
163 self assert: parser fail: ''. |
|
164 self assert: parser fail: 'b'. |
|
165 self assert: parser fail: 'B' |
|
166 |
|
167 ! |
|
168 |
|
169 testLiteralSequence |
|
170 | parser | |
|
171 parser := PPLiteralSequenceParser |
|
172 on: 'abc' |
|
173 message: 'sequence "abc" expected'. |
|
174 self assert: parser size = 3. |
|
175 self assert: parser literal = 'abc'. |
|
176 self assert: parser message = 'sequence "abc" expected'. |
|
177 |
|
178 self assert: parser parse: 'abc' to: 'abc'. |
|
179 self assert: parser fail: 'ab'. |
|
180 self assert: parser fail: 'abd' |
|
181 ! |
|
182 |
|
183 testLiteralSequenceCaseInsensitive |
|
184 | parser | |
|
185 parser := 'abc' asParser caseInsensitive. |
|
186 |
|
187 self assert: parser parse: 'abc' to: 'abc'. |
|
188 self assert: parser parse: 'ABC' to: 'ABC'. |
|
189 self assert: parser parse: 'abC' to: 'abC'. |
|
190 self assert: parser parse: 'AbC' to: 'AbC'. |
|
191 |
|
192 self assert: parser fail: 'ab'. |
|
193 self assert: parser fail: 'abd' |
|
194 ! |
|
195 |
|
196 testMax |
|
197 | parser | |
|
198 parser := $a asParser max: 2. |
|
199 self assert: parser min = 0. |
|
200 self assert: parser max = 2. |
|
201 |
|
202 self assert: parser parse: '' to: #(). |
|
203 self assert: parser parse: 'a' to: #($a). |
|
204 self assert: parser parse: 'aa' to: #($a $a). |
|
205 self assert: parser parse: 'aaa' to: #($a $a) end: 2. |
|
206 self assert: parser parse: 'aaaa' to: #($a $a) end: 2. |
|
207 |
|
208 self assert: (parser printString endsWith: '[0, 2]') |
|
209 ! |
|
210 |
|
211 testMemoized |
|
212 | count parser twice | |
|
213 count := 0. |
|
214 parser := [ :s | count := count + 1. s next ] asParser memoized. |
|
215 twice := parser and , parser. |
|
216 |
|
217 count := 0. |
|
218 self assert: parser parse: 'a' to: $a. |
|
219 self assert: count = 1. |
|
220 |
|
221 count := 0. |
|
222 self assert: twice parse: 'a' to: #($a $a). |
|
223 self assert: count = 1. |
|
224 |
|
225 self assert: parser memoized = parser |
|
226 ! |
|
227 |
|
228 testMin |
|
229 | parser | |
|
230 parser := $a asParser min: 2. |
|
231 self assert: parser min = 2. |
|
232 self assert: parser max > parser min. |
|
233 |
|
234 self assert: parser fail: ''. |
|
235 self assert: parser fail: 'a'. |
|
236 self assert: parser parse: 'aa' to: #($a $a). |
|
237 self assert: parser parse: 'aaa' to: #($a $a $a). |
|
238 self assert: parser parse: 'aaaa' to: #($a $a $a $a). |
|
239 |
|
240 self assert: (parser printString endsWith: '[2, *]') |
|
241 ! |
|
242 |
|
243 testMinMax |
|
244 | parser | |
|
245 parser := $a asParser min: 2 max: 4. |
|
246 self assert: parser min = 2. |
|
247 self assert: parser max = 4. |
|
248 |
|
249 self assert: parser fail: ''. |
|
250 self assert: parser fail: 'a'. |
|
251 self assert: parser parse: 'aa' to: #($a $a). |
|
252 self assert: parser parse: 'aaa' to: #($a $a $a). |
|
253 self assert: parser parse: 'aaaa' to: #($a $a $a $a). |
|
254 self assert: parser parse: 'aaaaa' to: #($a $a $a $a) end: 4. |
|
255 self assert: parser parse: 'aaaaaa' to: #($a $a $a $a) end: 4. |
|
256 |
|
257 self assert: (parser printString endsWith: '[2, 4]') |
|
258 ! |
|
259 |
|
260 testNegate |
|
261 | parser | |
|
262 parser := 'foo' asParser negate. |
|
263 |
|
264 self assert: parser parse: 'f' to: $f end: 1. |
|
265 self assert: parser parse: 'fo' to: $f end: 1. |
|
266 self assert: parser parse: 'fob' to: $f end: 1. |
|
267 self assert: parser parse: 'ffoo' to: $f end: 1. |
|
268 |
|
269 self assert: parser fail: ''. |
|
270 self assert: parser fail: 'foo' |
|
271 ! |
|
272 |
|
273 testNot |
|
274 | parser | |
|
275 parser := 'foo' asParser flatten , 'bar' asParser flatten not. |
|
276 |
|
277 self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3. |
|
278 self assert: parser fail: 'foobar' |
|
279 ! |
|
280 |
|
281 testOptional |
|
282 | parser | |
|
283 parser := $a asParser optional. |
|
284 |
|
285 self assert: parser parse: '' to: nil. |
|
286 self assert: parser parse: 'a' to: $a. |
|
287 |
|
288 self assert: parser parse: 'aa' to: $a end: 1. |
|
289 self assert: parser parse: 'ab' to: $a end: 1. |
|
290 self assert: parser parse: 'b' to: nil end: 0. |
|
291 self assert: parser parse: 'bb' to: nil end: 0. |
|
292 self assert: parser parse: 'ba' to: nil end: 0 |
|
293 ! |
|
294 |
|
295 testPermutation |
|
296 | parser | |
|
297 parser := #any asParser , #any asParser , #any asParser. |
|
298 |
|
299 self assert: (parser permutation: #()) parse: '123' to: #(). |
|
300 self assert: (parser permutation: #(1)) parse: '123' to: #($1). |
|
301 self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3). |
|
302 self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1). |
|
303 self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2). |
|
304 self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1). |
|
305 |
|
306 self should: [ parser permutation: #(0) ] raise: Error. |
|
307 self should: [ parser permutation: #(4) ] raise: Error. |
|
308 self should: [ parser permutation: #($2) ] raise: Error |
|
309 ! |
|
310 |
|
311 testPluggable |
|
312 | block parser | |
|
313 block := [ :stream | stream position ]. |
|
314 parser := block asParser. |
|
315 self assert: parser block = block |
|
316 ! |
|
317 |
|
318 testPlus |
|
319 | parser | |
|
320 parser := $a asParser plus. |
|
321 self assert: parser min = 1. |
|
322 self assert: parser max > parser min. |
|
323 |
|
324 self assert: parser parse: 'a' to: #($a). |
|
325 self assert: parser parse: 'aa' to: #($a $a). |
|
326 self assert: parser parse: 'aaa' to: #($a $a $a). |
|
327 |
|
328 self assert: parser parse: 'ab' to: #($a) end: 1. |
|
329 self assert: parser parse: 'aab' to: #($a $a) end: 2. |
|
330 self assert: parser parse: 'aaab' to: #($a $a $a) end: 3. |
|
331 |
|
332 self assert: parser fail: ''. |
|
333 self assert: parser fail: 'b'. |
|
334 self assert: parser fail: 'ba' |
|
335 ! |
|
336 |
|
337 testPlusGreedy |
|
338 | parser | |
|
339 parser := #word asParser plusGreedy: #digit asParser. |
|
340 |
|
341 self assert: parser fail: ''. |
|
342 self assert: parser fail: '1'. |
|
343 self assert: parser fail: 'a'. |
|
344 self assert: parser fail: 'ab'. |
|
345 |
|
346 self assert: parser parse: 'a1' to: #($a) end: 1. |
|
347 self assert: parser parse: 'ab1' to: #($a $b) end: 2. |
|
348 self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. |
|
349 self assert: parser parse: 'a12' to: #($a $1) end: 2. |
|
350 self assert: parser parse: 'ab12' to: #($a $b $1) end: 3. |
|
351 self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4. |
|
352 self assert: parser parse: 'a123' to: #($a $1 $2) end: 3. |
|
353 self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4. |
|
354 self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5. |
|
355 ! |
|
356 |
|
357 testPlusLazy |
|
358 | parser | |
|
359 parser := #word asParser plusLazy: #digit asParser. |
|
360 |
|
361 self assert: parser fail: ''. |
|
362 self assert: parser fail: '1'. |
|
363 self assert: parser fail: 'a'. |
|
364 self assert: parser fail: 'ab'. |
|
365 |
|
366 self assert: parser parse: 'a1' to: #($a) end: 1. |
|
367 self assert: parser parse: 'ab1' to: #($a $b) end: 2. |
|
368 self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. |
|
369 self assert: parser parse: 'a12' to: #($a) end: 1. |
|
370 self assert: parser parse: 'ab12' to: #($a $b) end: 2. |
|
371 self assert: parser parse: 'abc12' to: #($a $b $c) end: 3. |
|
372 self assert: parser parse: 'a123' to: #($a) end: 1. |
|
373 self assert: parser parse: 'ab123' to: #($a $b) end: 2. |
|
374 self assert: parser parse: 'abc123' to: #($a $b $c) end: 3 |
|
375 ! |
|
376 |
|
377 testSeparatedBy |
|
378 | parser | |
|
379 parser := $a asParser separatedBy: $b asParser. |
|
380 |
|
381 self assert: parser parse: 'a' to: #($a). |
|
382 self assert: parser parse: 'aba' to: #($a $b $a). |
|
383 self assert: parser parse: 'ababa' to: #($a $b $a $b $a). |
|
384 |
|
385 self assert: parser parse: 'ab' to: #($a) end: 1. |
|
386 self assert: parser parse: 'abab' to: #($a $b $a) end: 3. |
|
387 self assert: parser parse: 'ac' to: #($a) end: 1. |
|
388 self assert: parser parse: 'abac' to: #($a $b $a) end: 3. |
|
389 |
|
390 self assert: parser fail: ''. |
|
391 self assert: parser fail: 'c' |
|
392 ! |
|
393 |
|
394 testSequence |
|
395 | parser | |
|
396 parser := $a asParser , $b asParser. |
|
397 |
|
398 self assert: parser parse: 'ab' to: #($a $b). |
|
399 |
|
400 self assert: parser parse: 'aba' to: #($a $b) end: 2. |
|
401 self assert: parser parse: 'abb' to: #($a $b) end: 2. |
|
402 |
|
403 self assert: parser fail: ''. |
|
404 self assert: parser fail: 'a'. |
|
405 self assert: parser fail: 'aa'. |
|
406 self assert: parser fail: 'ba'. |
|
407 self assert: parser fail: 'bab' |
|
408 ! |
|
409 |
|
410 testStar |
|
411 | parser | |
|
412 parser := $a asParser star. |
|
413 self assert: parser min = 0. |
|
414 self assert: parser max > parser min. |
|
415 |
|
416 self assert: parser parse: '' to: #(). |
|
417 self assert: parser parse: 'a' to: #($a). |
|
418 self assert: parser parse: 'aa' to: #($a $a). |
|
419 self assert: parser parse: 'aaa' to: #($a $a $a). |
|
420 |
|
421 self assert: parser parse: 'b' to: #() end: 0. |
|
422 self assert: parser parse: 'ab' to: #($a) end: 1. |
|
423 self assert: parser parse: 'aab' to: #($a $a) end: 2. |
|
424 self assert: parser parse: 'aaab' to: #($a $a $a) end: 3 |
|
425 ! |
|
426 |
|
427 testStarGreedy |
|
428 | parser | |
|
429 parser := #word asParser starGreedy: #digit asParser. |
|
430 |
|
431 self assert: parser fail: ''. |
|
432 self assert: parser fail: 'a'. |
|
433 self assert: parser fail: 'ab'. |
|
434 |
|
435 self assert: parser parse: '1' to: #() end: 0. |
|
436 self assert: parser parse: 'a1' to: #($a) end: 1. |
|
437 self assert: parser parse: 'ab1' to: #($a $b) end: 2. |
|
438 self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. |
|
439 self assert: parser parse: '12' to: #($1) end: 1. |
|
440 self assert: parser parse: 'a12' to: #($a $1) end: 2. |
|
441 self assert: parser parse: 'ab12' to: #($a $b $1) end: 3. |
|
442 self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4. |
|
443 self assert: parser parse: '123' to: #($1 $2) end: 2. |
|
444 self assert: parser parse: 'a123' to: #($a $1 $2) end: 3. |
|
445 self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4. |
|
446 self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5 |
|
447 ! |
|
448 |
|
449 testStarLazy |
|
450 | parser | |
|
451 parser := #word asParser starLazy: #digit asParser. |
|
452 |
|
453 self assert: parser fail: ''. |
|
454 self assert: parser fail: 'a'. |
|
455 self assert: parser fail: 'ab'. |
|
456 |
|
457 self assert: parser parse: '1' to: #() end: 0. |
|
458 self assert: parser parse: 'a1' to: #($a) end: 1. |
|
459 self assert: parser parse: 'ab1' to: #($a $b) end: 2. |
|
460 self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. |
|
461 self assert: parser parse: '12' to: #() end: 0. |
|
462 self assert: parser parse: 'a12' to: #($a) end: 1. |
|
463 self assert: parser parse: 'ab12' to: #($a $b) end: 2. |
|
464 self assert: parser parse: 'abc12' to: #($a $b $c) end: 3. |
|
465 self assert: parser parse: '123' to: #() end: 0. |
|
466 self assert: parser parse: 'a123' to: #($a) end: 1. |
|
467 self assert: parser parse: 'ab123' to: #($a $b) end: 2. |
|
468 self assert: parser parse: 'abc123' to: #($a $b $c) end: 3 |
|
469 ! |
|
470 |
|
471 testTimes |
|
472 | parser | |
|
473 parser := $a asParser times: 2. |
|
474 |
|
475 self assert: parser fail: ''. |
|
476 self assert: parser fail: 'a'. |
|
477 self assert: parser parse: 'aa' to: #($a $a). |
|
478 self assert: parser parse: 'aaa' to: #($a $a) end: 2 |
|
479 ! |
|
480 |
|
481 testToken |
|
482 | parser | |
|
483 parser := $a asParser token. |
|
484 self assert: parser tokenClass = PPToken. |
|
485 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
486 self assert: parser fail: 'b'. |
|
487 self assert: parser fail: ''. |
|
488 |
|
489 parser := $a asParser token: PPToken. |
|
490 self assert: parser tokenClass = PPToken. |
|
491 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
492 self assert: parser fail: ''. |
|
493 self assert: parser fail: 'b' |
|
494 ! |
|
495 |
|
496 testTrim |
|
497 | parser | |
|
498 parser := $a asParser token trim. |
|
499 self assert: parser trim = parser. |
|
500 |
|
501 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
502 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
503 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
504 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
505 self assert: parser parse: 'a |
|
506 ' toToken: 1 stop: 1. |
|
507 |
|
508 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
509 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
510 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
511 self assert: parser parse: ' a' toToken: 5 stop: 5. |
|
512 self assert: parser parse: ' |
|
513 a' toToken: 5 stop: 5. |
|
514 |
|
515 self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1. |
|
516 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2. |
|
517 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3. |
|
518 |
|
519 self assert: parser fail: ''. |
|
520 self assert: parser fail: 'b' |
|
521 ! |
|
522 |
|
523 testTrimBlanks |
|
524 | parser | |
|
525 parser := $a asParser token trimBlanks. |
|
526 |
|
527 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
528 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
529 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
530 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
531 |
|
532 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
533 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
534 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
535 self assert: parser parse: ' a' toToken: 5 stop: 5. |
|
536 |
|
537 self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1. |
|
538 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2. |
|
539 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3. |
|
540 |
|
541 self assert: parser fail: ''. |
|
542 self assert: parser fail: ' |
|
543 '. |
|
544 self assert: parser fail: ' |
|
545 a'. |
|
546 self assert: parser fail: 'b'. |
|
547 ! |
|
548 |
|
549 testTrimSpaces |
|
550 | parser | |
|
551 parser := $a asParser token trimSpaces. |
|
552 |
|
553 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
554 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
555 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
556 self assert: parser parse: 'a ' toToken: 1 stop: 1. |
|
557 self assert: parser parse: 'a |
|
558 ' toToken: 1 stop: 1. |
|
559 |
|
560 self assert: parser parse: 'a' toToken: 1 stop: 1. |
|
561 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
562 self assert: parser parse: ' a' toToken: 2 stop: 2. |
|
563 self assert: parser parse: ' a' toToken: 5 stop: 5. |
|
564 self assert: parser parse: ' |
|
565 a' toToken: 5 stop: 5. |
|
566 |
|
567 self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1. |
|
568 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2. |
|
569 self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3. |
|
570 |
|
571 self assert: parser fail: ''. |
|
572 self assert: parser fail: 'b' |
|
573 ! |
|
574 |
|
575 testUnresolved |
|
576 | parser | |
|
577 parser := PPUnresolvedParser new. |
|
578 |
|
579 self assert: parser isUnresolved. |
|
580 self should: [ parser parse: '' ] raise: Error. |
|
581 self should: [ parser parse: 'a' ] raise: Error. |
|
582 self should: [ parser parse: 'ab' ] raise: Error. |
|
583 |
|
584 parser := nil asParser. |
|
585 self deny: parser isUnresolved |
|
586 ! |
|
587 |
|
588 testWrapped |
|
589 | parser | |
|
590 parser := $a asParser wrapped. |
|
591 |
|
592 self assert: parser parse: 'a' to: $a. |
|
593 self assert: parser fail: 'b'. |
|
594 |
|
595 parser := (($a asParser , $b asParser ) wrapped , $c asParser). |
|
596 self assert: parser parse: 'abc' to: #(#($a $b) $c) |
|
597 ! |
|
598 |
|
599 testWrapping |
|
600 | parser result | |
|
601 parser := #digit asParser plus >=> [ :stream :cc | |
|
602 Array |
|
603 with: stream position |
|
604 with: cc value |
|
605 with: stream position ]. |
|
606 |
|
607 self assert: parser parse: '1' to: #(0 ($1) 1). |
|
608 self assert: parser parse: '12' to: #(0 ($1 $2) 2). |
|
609 self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3). |
|
610 |
|
611 result := parser parse: 'a'. |
|
612 self assert: result first = 0. |
|
613 self assert: result second isPetitFailure. |
|
614 self assert: result last = 0 |
|
615 ! |
|
616 |
|
617 testXor |
|
618 | parser | |
|
619 parser := ($a asParser / $b asParser) |
|
620 | ($b asParser / $c asParser). |
|
621 |
|
622 self assert: parser parse: 'a' to: $a. |
|
623 self assert: parser parse: 'c' to: $c. |
|
624 |
|
625 self assert: parser fail: ''. |
|
626 self assert: parser fail: 'b'. |
|
627 self assert: parser fail: 'd'. |
|
628 |
|
629 " truly symmetric " |
|
630 parser := ($b asParser / $c asParser) |
|
631 | ($a asParser / $b asParser). |
|
632 |
|
633 self assert: parser parse: 'a' to: $a. |
|
634 self assert: parser parse: 'c' to: $c. |
|
635 |
|
636 self assert: parser fail: ''. |
|
637 self assert: parser fail: 'b'. |
|
638 self assert: parser fail: 'd' |
|
639 ! ! |
|
640 |
|
641 !PPParserTest methodsFor:'testing-accessing'! |
|
642 |
|
643 testNamed |
|
644 | parser | |
|
645 parser := PPSequenceParser new. |
|
646 self assert: parser name isNil. |
|
647 |
|
648 parser := PPChoiceParser named: 'choice'. |
|
649 self assert: parser name = 'choice'. |
|
650 |
|
651 parser := $* asParser name: 'star'. |
|
652 self assert: parser name = 'star' |
|
653 ! |
|
654 |
|
655 testPrint |
|
656 | parser | |
|
657 parser := PPParser new. |
|
658 self assert: (parser printString includesSubString: 'PPParser'). |
|
659 |
|
660 parser := PPParser named: 'choice'. |
|
661 self assert: (parser printString includesSubString: 'PPParser(choice'). |
|
662 |
|
663 parser := PPLiteralObjectParser on: $a. |
|
664 "/ self assert: (parser printString includesSubString: '$a'). |
|
665 self assert: (parser printString includesSubString: 'a'). |
|
666 |
|
667 parser := PPFailingParser message: 'error'. |
|
668 self assert: (parser printString includesSubString: 'error'). |
|
669 |
|
670 parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'. |
|
671 self assert: (parser printString includesSubString: 'error') |
|
672 |
|
673 "Modified: / 19-12-2010 / 18:30:54 / Jan Kurs <kurs.jan@post.cz>" |
|
674 ! ! |
|
675 |
|
676 !PPParserTest methodsFor:'testing-fixtures'! |
|
677 |
|
678 testSideEffectChoice |
|
679 "Adding another element to a choice should create a copy, otherwise we get unwanted side-effects." |
|
680 |
|
681 | p1 p2 p3 | |
|
682 p1 := $a asParser. |
|
683 p2 := p1 / $b asParser. |
|
684 p3 := p1 / $c asParser. |
|
685 |
|
686 self assert: p1 parse: 'a'. |
|
687 self assert: p1 fail: 'b'. |
|
688 self assert: p1 fail: 'c'. |
|
689 |
|
690 self assert: p2 parse: 'a'. |
|
691 self assert: p2 parse: 'b'. |
|
692 self assert: p2 fail: 'c'. |
|
693 |
|
694 self assert: p3 parse: 'a'. |
|
695 self assert: p3 fail: 'b'. |
|
696 self assert: p3 parse: 'c' |
|
697 ! |
|
698 |
|
699 testSideEffectListCopy |
|
700 | old new | |
|
701 old := $a asParser , $b asParser. |
|
702 new := old copy. |
|
703 |
|
704 self deny: old == new. |
|
705 self deny: old children == new children. |
|
706 self assert: old children first == new children first. |
|
707 self assert: old children last == new children last |
|
708 ! |
|
709 |
|
710 testSideEffectSequence |
|
711 "Adding another element to a sequence should create a copy, otherwise we get unwanted side-effects." |
|
712 |
|
713 | p1 p2 p3 | |
|
714 p1 := $a asParser. |
|
715 p2 := p1 , $b asParser. |
|
716 p3 := p1 , $c asParser. |
|
717 |
|
718 self assert: p1 parse: 'a'. |
|
719 self assert: p1 parse: 'ab' end: 1. |
|
720 self assert: p1 parse: 'ac' end: 1. |
|
721 |
|
722 self assert: p2 fail: 'a'. |
|
723 self assert: p2 parse: 'ab'. |
|
724 self assert: p2 fail: 'ac'. |
|
725 |
|
726 self assert: p3 fail: 'a'. |
|
727 self assert: p3 fail: 'ab'. |
|
728 self assert: p3 parse: 'ac' |
|
729 ! ! |
|
730 |
|
731 !PPParserTest methodsFor:'testing-properties'! |
|
732 |
|
733 testHasProperty |
|
734 | parser | |
|
735 parser := PPParser new. |
|
736 self deny: (parser hasProperty: #foo). |
|
737 parser propertyAt: #foo put: 123. |
|
738 self assert: (parser hasProperty: #foo) |
|
739 ! |
|
740 |
|
741 testPostCopy |
|
742 | parser copy | |
|
743 parser := PPParser new. |
|
744 parser propertyAt: #foo put: true. |
|
745 copy := parser copy. |
|
746 copy propertyAt: #foo put: false. |
|
747 self assert: (parser propertyAt: #foo). |
|
748 self deny: (copy propertyAt: #foo) |
|
749 ! |
|
750 |
|
751 testPropertyAt |
|
752 | parser | |
|
753 parser := PPParser new. |
|
754 self should: [ parser propertyAt: #foo ] raise: Error. |
|
755 parser propertyAt: #foo put: true. |
|
756 self assert: (parser propertyAt: #foo) |
|
757 ! |
|
758 |
|
759 testPropertyAtIfAbsent |
|
760 | parser | |
|
761 parser := PPParser new. |
|
762 self assert: (parser propertyAt: #foo ifAbsent: [ true ]). |
|
763 parser propertyAt: #foo put: true. |
|
764 self assert: (parser propertyAt: #foo ifAbsent: [ false ]) |
|
765 ! |
|
766 |
|
767 testPropertyAtIfAbsentPut |
|
768 | parser | |
|
769 parser := PPParser new. |
|
770 self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]). |
|
771 self assert: (parser propertyAt: #foo ifAbsentPut: [ false ]) |
|
772 ! |
|
773 |
|
774 testRemoveProperty |
|
775 | parser | |
|
776 parser := PPParser new. |
|
777 self should: [ parser removeProperty: #foo ] raise: Error. |
|
778 parser propertyAt: #foo put: true. |
|
779 self assert: (parser removeProperty: #foo) |
|
780 ! |
|
781 |
|
782 testRemovePropertyIfAbsent |
|
783 | parser | |
|
784 parser := PPParser new. |
|
785 self assert: (parser removeProperty: #foo ifAbsent: [ true ]). |
|
786 parser propertyAt: #foo put: true. |
|
787 self assert: (parser removeProperty: #foo ifAbsent: [ false ]) |
|
788 ! ! |
|
789 |
|
790 !PPParserTest methodsFor:'testing-utilities'! |
|
791 |
|
792 testChildren |
|
793 | p1 p2 p3 | |
|
794 p1 := #lowercase asParser. |
|
795 p2 := p1 ==> #asUppercase. |
|
796 p3 := PPUnresolvedParser new. |
|
797 p3 def: p2 / p3. |
|
798 self assert: p1 children isEmpty. |
|
799 self assert: p2 children size = 1. |
|
800 self assert: p3 children size = 2 |
|
801 ! |
|
802 |
|
803 testFailure |
|
804 | failure | |
|
805 failure := PPFailure message: 'Error' at: 3. |
|
806 |
|
807 self assert: failure message = 'Error'. |
|
808 self assert: failure position = 3. |
|
809 self assert: failure isPetitFailure. |
|
810 |
|
811 self deny: 4 isPetitFailure. |
|
812 self deny: 'foo' isPetitFailure |
|
813 ! |
|
814 |
|
815 testListConstructor |
|
816 | p1 p2 p3 | |
|
817 p1 := PPChoiceParser with: $a asParser. |
|
818 p2 := PPChoiceParser with: $a asParser with: $b asParser. |
|
819 p3 := PPChoiceParser withAll: (Array with: $a asParser with: $b asParser with: $c asParser). |
|
820 |
|
821 self assert: p1 children size = 1. |
|
822 self assert: p2 children size = 2. |
|
823 self assert: p3 children size = 3 |
|
824 ! |
|
825 |
|
826 testMatches |
|
827 | parser | |
|
828 parser := $a asParser. |
|
829 |
|
830 self assert: (parser matches: 'a'). |
|
831 self deny: (parser matches: 'b'). |
|
832 |
|
833 self assert: (parser matches: 'a' readStream). |
|
834 self deny: (parser matches: 'b' readStream) |
|
835 ! |
|
836 |
|
837 testMatchesIn |
|
838 | parser result | |
|
839 parser := $a asParser. |
|
840 |
|
841 result := parser matchesIn: 'abba'. |
|
842 self assert: result size = 2. |
|
843 self assert: result first = $a. |
|
844 self assert: result last = $a. |
|
845 |
|
846 result := parser matchesIn: 'baaah'. |
|
847 self assert: result size = 3. |
|
848 self assert: result first = $a. |
|
849 self assert: result last = $a |
|
850 ! |
|
851 |
|
852 testMatchesInEmpty |
|
853 "Empty matches should properly advance and match at each position and at the end." |
|
854 |
|
855 | parser result | |
|
856 parser := [ :stream | stream position ] asParser. |
|
857 |
|
858 result := parser matchesIn: '123'. |
|
859 self assert: result asArray = #(0 1 2 3) |
|
860 ! |
|
861 |
|
862 testMatchesInOverlapping |
|
863 "Matches that overlap should be properly reported." |
|
864 |
|
865 | parser result | |
|
866 parser := #digit asParser , #digit asParser. |
|
867 |
|
868 result := parser matchesIn: 'a123b'. |
|
869 self assert: result size = 2. |
|
870 self assert: result first = #($1 $2). |
|
871 self assert: result last = #($2 $3) |
|
872 ! |
|
873 |
|
874 testMatchingRangesIn |
|
875 | input parser result | |
|
876 input := 'a12b1'. |
|
877 parser := #digit asParser plus. |
|
878 result := parser matchingRangesIn: input. |
|
879 self assert: result size = 3. |
|
880 result do: [ :each | self assert: (parser matches: (input copyFrom: each first to: each last)) ] |
|
881 ! |
|
882 |
|
883 testParse |
|
884 | parser result | |
|
885 parser := $a asParser. |
|
886 |
|
887 self assert: (parser parse: 'a') = $a. |
|
888 self assert: (result := parser parse: 'b') isPetitFailure. |
|
889 "is it Character printString differs: we return only 'a', not '$a'" |
|
890 self breakPoint: #petitparser. |
|
891 "/ self assert: (result message includesSubString: '$a'). |
|
892 self assert: (result message includesSubString: 'a'). |
|
893 self assert: (result message includesSubString: 'expected'). |
|
894 self assert: (result position = 0). |
|
895 |
|
896 self assert: (parser parse: 'a' readStream) = $a. |
|
897 self assert: (result := parser parse: 'b' readStream) isPetitFailure. |
|
898 "/ self assert: (result message includesSubString: '$a'). |
|
899 self assert: (result message includesSubString: 'a'). |
|
900 self assert: (result message includesSubString: 'expected'). |
|
901 self assert: (result position = 0) |
|
902 |
|
903 "Modified: / 18-12-2010 / 17:05:13 / Jan Kurs <kurs.jan@post.cz>" |
|
904 ! |
|
905 |
|
906 testParseOnError0 |
|
907 | parser result seen | |
|
908 parser := $a asParser. |
|
909 |
|
910 result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. |
|
911 self assert: result = $a. |
|
912 |
|
913 result := parser parse: 'b' onError: [ seen := true ]. |
|
914 self assert: result. |
|
915 self assert: seen |
|
916 ! |
|
917 |
|
918 testParseOnError1 |
|
919 | parser result seen | |
|
920 parser := $a asParser. |
|
921 |
|
922 result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. |
|
923 self assert: result = $a. |
|
924 |
|
925 result := parser parse: 'b' onError: [ :failure | |
|
926 self assert: (failure position = 0). |
|
927 "We don't use $ in ST/X for Characters" |
|
928 self assert: (failure message includesSubString: 'a'). |
|
929 "/ self assert: (failure message includesSubString: '$a'). |
|
930 self assert: (failure message includesSubString: 'expected'). |
|
931 seen := true ]. |
|
932 self assert: result. |
|
933 self assert: seen |
|
934 |
|
935 "Modified: / 19-12-2010 / 18:18:01 / Jan Kurs <kurs.jan@post.cz>" |
|
936 ! |
|
937 |
|
938 testParseOnError2 |
|
939 | parser result seen | |
|
940 parser := $a asParser. |
|
941 |
|
942 result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. |
|
943 self assert: result = $a. |
|
944 |
|
945 result := parser parse: 'b' onError: [ :msg :pos | |
|
946 "We don't use $ in ST/X for Characters" |
|
947 self assert: (msg includesSubString: 'a'). |
|
948 "/ self assert: (msg includesSubString: '$a'). |
|
949 self assert: (msg includesSubString: 'expected'). |
|
950 self assert: pos = 0. |
|
951 seen := true ]. |
|
952 self assert: result. |
|
953 self assert: seen |
|
954 |
|
955 "Modified: / 19-12-2010 / 18:18:31 / Jan Kurs <kurs.jan@post.cz>" |
|
956 ! |
|
957 |
|
958 testParser |
|
959 | parser | |
|
960 parser := PPParser new. |
|
961 |
|
962 self assert: parser isPetitParser. |
|
963 |
|
964 self deny: 4 isPetitParser. |
|
965 self deny: 'foo' isPetitParser |
|
966 ! ! |
|
967 |
|
968 !PPParserTest class methodsFor:'documentation'! |
|
969 |
|
970 version_SVN |
|
971 ^ '$Id: PPParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $' |
|
972 ! ! |