1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPAbstractParserTest subclass:#PPCProtype1Test |
|
6 instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3 |
|
7 arguments configuration' |
|
8 classVariableNames:'' |
|
9 poolDictionaries:'' |
|
10 category:'PetitCompiler-Tests-Core' |
|
11 ! |
|
12 |
|
13 |
|
14 !PPCProtype1Test methodsFor:'context'! |
|
15 |
|
16 context |
|
17 ^ context := PPCProfilingContext new |
|
18 ! ! |
|
19 |
|
20 !PPCProtype1Test methodsFor:'test support'! |
|
21 |
|
22 assert: p parse: whatever |
|
23 ^ result := super assert: p parse: whatever. |
|
24 ! |
|
25 |
|
26 parse: whatever |
|
27 ^ result := super parse: whatever. |
|
28 ! |
|
29 |
|
30 tearDown |
|
31 | parserClass | |
|
32 |
|
33 parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]). |
|
34 parserClass notNil ifTrue:[ |
|
35 parserClass removeFromSystem |
|
36 ]. |
|
37 ! ! |
|
38 |
|
39 !PPCProtype1Test methodsFor:'tests - compiling'! |
|
40 |
|
41 testCompileAnd |
|
42 parser := #digit asParser and compileWithConfiguration: configuration. |
|
43 |
|
44 self assert: parser parse: '1' to: $1 end: 0. |
|
45 self assert: parser fail: 'a'. |
|
46 self assert: parser fail: ''. |
|
47 |
|
48 parser := ('foo' asParser, ($: asParser and)) compile. |
|
49 self assert: parser parse: 'foo:' to: { 'foo'. $: } end: 3. |
|
50 ! |
|
51 |
|
52 testCompileAny |
|
53 parser := #any asParser compile. |
|
54 |
|
55 self assert: parser parse: 'a' to: $a. |
|
56 self assert: parser parse: '_' to: $_. |
|
57 self assert: parser parse: ' |
|
58 ' to: Character cr. |
|
59 ! |
|
60 |
|
61 testCompileAnyStar |
|
62 parser := #any asParser star compileWithConfiguration: configuration. |
|
63 |
|
64 |
|
65 self assert: parser parse: 'aaa' to: { $a. $a . $a }. |
|
66 self assert: context invocationCount = 1. |
|
67 self assert: parser parse: '' to: { }. |
|
68 ! |
|
69 |
|
70 testCompileBlock |
|
71 parser := (#letter asParser) plus ==> [ :res | res collect: [:each | each asUppercase ]]. |
|
72 parser := parser compileWithConfiguration: configuration. |
|
73 |
|
74 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
|
75 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
|
76 self assert: parser fail: ''. |
|
77 ! |
|
78 |
|
79 testCompileCharacter |
|
80 parser := $a asParser compileWithConfiguration: configuration. |
|
81 |
|
82 self assert: parser parse: 'a' to: $a. |
|
83 self assert: parser fail: 'b'. |
|
84 |
|
85 parser := $# asParser compileWithConfiguration: configuration. |
|
86 self assert: parser parse: '#'. |
|
87 ! |
|
88 |
|
89 testCompileChoice |
|
90 parser := (#digit asParser / #letter asParser) compileWithConfiguration: configuration. |
|
91 |
|
92 self assert: parser parse: '1' to: $1. |
|
93 self assert: parser parse: 'a' to: $a. |
|
94 self assert: parser fail: '_'. |
|
95 |
|
96 ! |
|
97 |
|
98 testCompileChoice2 |
|
99 parser := ('true' asParser / 'false' asParser) compileWithConfiguration: configuration. |
|
100 |
|
101 self assert: parser parse: 'true' to: 'true'. |
|
102 self assert: parser parse: 'false' to: 'false'. |
|
103 self assert: parser fail: 'trulse'. |
|
104 |
|
105 ! |
|
106 |
|
107 testCompileLiteral |
|
108 parser := 'foo' asParser compileWithConfiguration: configuration. |
|
109 |
|
110 self assert: parser parse: 'foo' to: 'foo'. |
|
111 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
|
112 self assert: parser fail: 'boo'. |
|
113 |
|
114 parser := '#[' asParser compile. |
|
115 self assert: parser parse: '#[1]' to: '#[' end: 2. |
|
116 ! |
|
117 |
|
118 testCompileLiteral2 |
|
119 | quote | |
|
120 quote := '''' asParser. |
|
121 parser := (quote, $a asParser ) compileWithConfiguration: configuration. |
|
122 self assert: parser parse: '''a' to: {'''' . $a}. |
|
123 ! |
|
124 |
|
125 testCompileNegate |
|
126 parser := #letter asParser negate star, #letter asParser. |
|
127 parser := parser compileWithConfiguration: configuration. |
|
128 |
|
129 self assert: parser parse: '...a' to: { { $. . $. . $. } . $a }. |
|
130 self assert: parser parse: 'aaa' to: { {} . $a } end: 1. |
|
131 self assert: parser fail: '...'. |
|
132 ! |
|
133 |
|
134 testCompileNil |
|
135 parser := nil asParser compileWithConfiguration: configuration. |
|
136 |
|
137 self assert: parser parse: 'a' to: nil end: 0. |
|
138 self assert: parser parse: '' to: nil end: 0. |
|
139 |
|
140 parser := nil asParser, 'foo' asParser. |
|
141 self assert: parser parse: 'foo' to: { nil . 'foo' } |
|
142 ! |
|
143 |
|
144 testCompileNot |
|
145 parser := #digit asParser not compileWithConfiguration: configuration. |
|
146 |
|
147 self assert: parser parse: 'a' to: nil end: 0. |
|
148 self assert: parser fail: '1'. |
|
149 self assert: parser parse: '' to: nil end: 0. |
|
150 |
|
151 parser := 'foo' asParser, $: asParser not. |
|
152 parser := parser compileWithConfiguration: configuration. |
|
153 self assert: parser parse: 'foo' to: { 'foo'. nil } end: 3. |
|
154 |
|
155 parser := 'foo' asParser, $: asParser not, 'bar' asParser. |
|
156 parser := parser compileWithConfiguration: configuration. |
|
157 self assert: parser parse: 'foobar' to: { 'foo'. nil . 'bar' } end: 6. |
|
158 ! |
|
159 |
|
160 testCompileNot2 |
|
161 parser := ($a asParser, $b asParser) not compileWithConfiguration: configuration. |
|
162 |
|
163 self assert: parser parse: '' to: nil end: 0. |
|
164 self assert: parser parse: 'a' to: nil end: 0. |
|
165 self assert: parser parse: 'aa' to: nil end: 0. |
|
166 self assert: parser fail: 'ab'. |
|
167 ! |
|
168 |
|
169 testCompileNot3 |
|
170 parser := ('foo' asParser not, 'fee' asParser) compileWithConfiguration: configuration. |
|
171 |
|
172 self assert: parser parse: 'fee' to: #(nil 'fee'). |
|
173 self assert: parser fail: 'foo'. |
|
174 ! |
|
175 |
|
176 testCompileNotLiteral |
|
177 parser := 'foo' asParser not compileWithConfiguration: configuration. |
|
178 self assert: parser class methodDictionary size = 1. |
|
179 |
|
180 self assert: parser parse: 'bar' to: nil end: 0. |
|
181 |
|
182 self assert: parser fail: 'foo'. |
|
183 self assert: parser parse: '' to: nil end: 0. |
|
184 |
|
185 parser := '''' asParser not compile. |
|
186 self assert: parser class methodDictionary size = 1. |
|
187 |
|
188 self assert: parser parse: 'a' to: nil end: 0. |
|
189 self assert: parser fail: ''''. |
|
190 self assert: parser parse: '' to: nil end: 0. |
|
191 |
|
192 |
|
193 parser := ('foo' asParser, 'bar' asParser not) compile. |
|
194 self assert: parser parse: 'foofoo' to: { 'foo'. nil } end: 3. |
|
195 |
|
196 parser := ('foo' asParser, 'foo' asParser not, #any asParser star) compile. |
|
197 self assert: parser parse: 'foobar' to: { 'foo'. nil . #($b $a $r) } end: 6. |
|
198 self assert: parser fail: 'foofoo'. |
|
199 ! |
|
200 |
|
201 testCompileOptional |
|
202 parser := #digit asParser optional compileWithConfiguration: configuration. |
|
203 |
|
204 self assert: parser parse: '1' to: $1. |
|
205 self assert: parser parse: 'a' to: nil end: 0. |
|
206 |
|
207 parser := (#digit asParser optional, #letter asParser) compile. |
|
208 self assert: parser parse: '1a' to: { $1 . $a }. |
|
209 self assert: parser parse: 'a' to: { nil . $a }. |
|
210 ! |
|
211 |
|
212 testCompilePlus |
|
213 parser := #letter asParser plus compileWithConfiguration: configuration. |
|
214 |
|
215 self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} . |
|
216 self assert: parser parse: 'a123' to: {$a} end: 1. |
|
217 self assert: parser parse: 'ab123' to: {$a . $b} end: 2. |
|
218 |
|
219 self assert: parser fail: ''. |
|
220 self assert: parser fail: '123'. |
|
221 ! |
|
222 |
|
223 testCompilePredicate |
|
224 parser := #digit asParser compileWithConfiguration: configuration. |
|
225 |
|
226 self assert: parser parse: '1' to: $1. |
|
227 self assert: parser parse: '0' to: $0. |
|
228 self assert: parser fail: 'a'. |
|
229 ! |
|
230 |
|
231 testCompilePredicate2 |
|
232 parser := #space asParser compileWithConfiguration: configuration. |
|
233 |
|
234 self assert: parser parse: ' ' to: Character space. |
|
235 self assert: parser fail: 'a'. |
|
236 ! |
|
237 |
|
238 testCompileSequence |
|
239 parser := (#digit asParser, #letter asParser) compileWithConfiguration: configuration. |
|
240 |
|
241 self assert: parser parse: '1a' to: {$1 .$a}. |
|
242 |
|
243 |
|
244 ! |
|
245 |
|
246 testCompileSequence2 |
|
247 parser := (#digit asParser, #space asParser, #letter asParser) compileWithConfiguration: configuration. |
|
248 |
|
249 self assert: parser parse: '9 c' to: {$9 . Character space. $c }. |
|
250 self assert: parser fail: '9c'. |
|
251 |
|
252 ! |
|
253 |
|
254 testCompileSequence3 |
|
255 parser := (#any asParser, #any asParser, #any asParser) compileWithConfiguration: configuration. |
|
256 |
|
257 self assert: parser parse: 'foo' to: #($f $o $o). |
|
258 self assert: parser fail: 'fo'. |
|
259 |
|
260 ! |
|
261 |
|
262 testCompileStar |
|
263 parser := #letter asParser star compileWithConfiguration: configuration. |
|
264 |
|
265 self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} . |
|
266 self assert: parser parse: '' to: {}. |
|
267 self assert: parser parse: '123' to: {} end: 0. |
|
268 self assert: parser parse: 'ab123' to: {$a . $b} end: 2. |
|
269 ! |
|
270 |
|
271 testCompileStarLiteral |
|
272 parser := 'foo' asParser star compileWithConfiguration: configuration. |
|
273 |
|
274 self assert: parser parse: 'foo' to: #('foo' ) . |
|
275 self assert: parser parse: 'foofoo' to: #('foo' 'foo') . |
|
276 self assert: parser parse: 'foofoofoo' to: #('foo' 'foo' 'foo') . |
|
277 self assert: parser parse: '' to: #(). |
|
278 self assert: parser parse: 'bar' to: #() end: 0. |
|
279 ! |
|
280 |
|
281 testCompileStarPredicate |
|
282 parser := #letter asParser star compileWithConfiguration: configuration. |
|
283 |
|
284 self assert: parser parse: 'foo' to: #($f $o $o ) . |
|
285 self assert: parser parse: '' to: #(). |
|
286 self assert: parser parse: '123' to: #() end: 0. |
|
287 ! |
|
288 |
|
289 testCompileSymbolBlock |
|
290 parser := (#letter asParser) plus ==> #second. |
|
291 parser := parser compileWithConfiguration: configuration. |
|
292 |
|
293 self assert: parser parse: 'foo' to: $o. |
|
294 self assert: parser parse: 'bar' to: $a. |
|
295 self assert: parser fail: ''. |
|
296 self should: [ parser parse: 'f' ] raise: Error. |
|
297 ! |
|
298 |
|
299 testCompileTrim |
|
300 parser := $a asParser trim compileWithConfiguration: configuration. |
|
301 |
|
302 self assert: parser fail: ''. |
|
303 self assert: parser parse: 'a' to: $a. |
|
304 self assert: parser parse: ' a' to: $a. |
|
305 self assert: parser parse: 'a ' to: $a. |
|
306 self assert: parser parse: ' a ' to: $a. |
|
307 ! |
|
308 |
|
309 testCompileTrimmingToken |
|
310 | token1 token2 | |
|
311 token1 := (#letter asParser) plus trimmingToken. |
|
312 token2 := (#letter asParser) plus trimmingToken. |
|
313 |
|
314 parser := (token1, token2) compileWithConfiguration: configuration. |
|
315 |
|
316 self assert: parser parse: 'foo bar'. |
|
317 self assert: parser parse: ' foo bar '. |
|
318 ! |
|
319 |
|
320 testCompileTrimmingToken2 |
|
321 | token1 token2 | |
|
322 token1 := (#letter asParser) plus trimmingToken. |
|
323 token2 := (#letter asParser) plus trimmingToken / 'foo' asParser trimmingToken. |
|
324 |
|
325 parser := (token1, token2) compileWithConfiguration: configuration. |
|
326 |
|
327 self assert: parser parse: 'foo bar'. |
|
328 self assert: parser parse: ' foo bar '. |
|
329 ! |
|
330 |
|
331 testCompileTrimmingToken3 |
|
332 | token1 token2 | |
|
333 token1 := ($a asParser, $b asParser) trimmingToken name: 'token1'. |
|
334 token2 := (token1 not, $c asParser) trimmingToken name: 'token2'. |
|
335 |
|
336 parser := (token1 / token2) compileWithConfiguration: configuration. |
|
337 |
|
338 self assert: (parser class methodDictionary includesKey: #'token1'). |
|
339 self assert: (parser class methodDictionary includesKey: #'token1_fast'). |
|
340 |
|
341 self assert: parser parse: 'ab'. |
|
342 self assert: (result isKindOf: PPToken). |
|
343 self assert: result inputValue = 'ab'. |
|
344 |
|
345 self assert: parser parse: 'c'. |
|
346 self assert: (result isKindOf: PPToken). |
|
347 self assert: result inputValue = 'c'. |
|
348 |
|
349 ! ! |
|
350 |
|
351 !PPCProtype1Test methodsFor:'tests - extra'! |
|
352 |
|
353 testCompileSmalltalkToken |
|
354 parser := (#letter asParser, ((#letter asParser / #digit asParser) star)) smalltalkToken compileWithConfiguration: configuration. |
|
355 |
|
356 self assert: parser parse: 'foo'. |
|
357 self assert: result inputValue = 'foo'. |
|
358 self assert: parser parse: 'a'. |
|
359 self assert: result inputValue = 'a'. |
|
360 self assert: parser parse: 'f123a'. |
|
361 self assert: result inputValue = 'f123a'. |
|
362 |
|
363 self assert: parser fail: ''. |
|
364 self assert: parser fail: '12'. |
|
365 |
|
366 self assert: parser parse: ' "comment" foo'. |
|
367 self assert: result inputValue = 'foo'. |
|
368 |
|
369 self assert: parser parse: ' "comment" bar "another comment" '. |
|
370 self assert: result inputValue = 'bar'. |
|
371 self assert: parser parse: ' |
|
372 "b" |
|
373 "b" |
|
374 foo |
|
375 "and yet, another comment" |
|
376 |
|
377 "one more to make sure :)" |
|
378 '. |
|
379 self assert: result inputValue = 'foo'. |
|
380 ! |
|
381 |
|
382 testCycle |
|
383 | p1 block | |
|
384 |
|
385 p1 := PPDelegateParser new. |
|
386 block := ${ asParser, p1, $} asParser / nil asParser. |
|
387 p1 setParser: block. |
|
388 |
|
389 parser := block compileWithConfiguration: configuration. |
|
390 self assert: parser parse: '{}' to: { ${. nil . $} }. |
|
391 self assert: parser parse: '{{}}' to: { ${. { ${ . nil . $} } . $} }. |
|
392 |
|
393 ! |
|
394 |
|
395 testSmalltalkToken |
|
396 parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithConfiguration: configuration. |
|
397 |
|
398 self assert: parser class methodDictionary size = 5. |
|
399 self assert: parser parse: 'foo'. |
|
400 self assert: result inputValue = 'foo'. |
|
401 self assert: context invocationCount = 8. |
|
402 self assert: context rememberCount = 0. |
|
403 self assert: context lwRememberCount = 1. |
|
404 self assert: context lwRestoreCount = 0. |
|
405 ! |
|
406 |
|
407 testSmalltalkToken2 |
|
408 id := (#letter asParser, (#digit asParser / #letter asParser) star) |
|
409 name: 'identifier'; |
|
410 yourself. |
|
411 |
|
412 parser := (id wrapped, $: asParser) smalltalkToken |
|
413 name: 'kw'; |
|
414 yourself. |
|
415 |
|
416 parser := parser compileWithConfiguration: configuration. |
|
417 |
|
418 self assert: parser parse: 'foo:'. |
|
419 self assert: result inputValue = 'foo:'. |
|
420 ! |
|
421 |
|
422 testToken |
|
423 parser := (#letter asParser, (#digit asParser / #letter asParser) star) flatten compileWithConfiguration: configuration. |
|
424 |
|
425 self assert: parser parse: 'foo' to: 'foo'. |
|
426 self assert: parser parse: 'a' to: 'a'. |
|
427 self assert: parser parse: 'f123a' to: 'f123a'. |
|
428 self assert: parser fail: ''. |
|
429 ! |
|
430 |
|
431 testToken2 |
|
432 parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithConfiguration: configuration. |
|
433 |
|
434 self assert: parser class methodDictionary size = 4. |
|
435 self assert: parser parse: 'foo'. |
|
436 self assert: result inputValue = 'foo'. |
|
437 self assert: context invocationCount = 6. |
|
438 self assert: context rememberCount = 0. |
|
439 self assert: context lwRememberCount = 1. |
|
440 self assert: context lwRestoreCount = 0. |
|
441 ! |
|
442 |
|
443 testTrimmingToken |
|
444 parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithConfiguration: configuration. |
|
445 |
|
446 self assert: parser class methodDictionary size = 4. |
|
447 |
|
448 self assert: parser parse: 'foo'. |
|
449 self assert: result inputValue = 'foo'. |
|
450 |
|
451 self assert: context invocationCount = 6. |
|
452 self assert: context rememberCount = 0. |
|
453 self assert: context lwRememberCount = 1. |
|
454 self assert: context lwRestoreCount = 0. |
|
455 |
|
456 self assert: parser parse: ' foo '. |
|
457 self assert: result inputValue = 'foo'. |
|
458 |
|
459 |
|
460 |
|
461 self assert: parser fail: '123'. |
|
462 |
|
463 self assert: context invocationCount = 1. |
|
464 self assert: context rememberCount = 0. |
|
465 self assert: context lwRememberCount = 0. |
|
466 self assert: context lwRestoreCount = 0. |
|
467 |
|
468 |
|
469 self assert: parser fail: ''. |
|
470 ! |
|
471 |
|
472 testTrimmingTokenNested |
|
473 | identifier kw | |
|
474 kw := 'false' asParser trimmingToken name: #kw. |
|
475 identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier. |
|
476 |
|
477 parser := identifier / kw. |
|
478 parser := parser compileWithConfiguration: configuration. |
|
479 self assert: parser class methodDictionary size = 5. |
|
480 |
|
481 self assert: parser parse: 'foo'. |
|
482 self assert: result inputValue = 'foo'. |
|
483 |
|
484 self assert: parser parse: 'false'. |
|
485 self assert: result inputValue = 'false'. |
|
486 ! |
|
487 |
|
488 testTrimmingTokenNested2 |
|
489 | identifier kw | |
|
490 kw := 'false' asParser trimmingToken name: #kw. |
|
491 identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier. |
|
492 |
|
493 parser := identifier / kw. |
|
494 parser := parser compileWithConfiguration: configuration. |
|
495 self assert: parser class methodDictionary size = 5. |
|
496 |
|
497 self assert: parser parse: 'foo'. |
|
498 self assert: result inputValue = 'foo'. |
|
499 |
|
500 self assert: parser parse: 'false'. |
|
501 self assert: result inputValue = 'false'. |
|
502 ! |
|
503 |
|
504 testTrimmingTokenNested3 |
|
505 | identifier kw | |
|
506 kw := ('false' asParser, #word asParser not) trimmingToken name: #kw. |
|
507 identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier. |
|
508 |
|
509 parser := identifier / kw. |
|
510 parser := parser compileWithConfiguration: configuration. |
|
511 self assert: parser class methodDictionary size = 8. |
|
512 self assert: (parser class methodDictionary values anySatisfy: [ :m | m selector = #kw ]). |
|
513 self assert: (parser class methodDictionary values anySatisfy: [ :m | m selector = #kw_fast ]). |
|
514 |
|
515 self assert: parser parse: 'foo'. |
|
516 self assert: result inputValue = 'foo'. |
|
517 |
|
518 self assert: parser parse: 'false'. |
|
519 self assert: result inputValue = 'false'. |
|
520 |
|
521 "Modified: / 02-05-2015 / 06:13:14 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
522 ! ! |
|
523 |
|
524 !PPCProtype1Test methodsFor:'tests - ids'! |
|
525 |
|
526 setUp |
|
527 arguments := PPCArguments default |
|
528 profile: true; |
|
529 yourself. |
|
530 |
|
531 configuration := PPCFirstPrototype new |
|
532 arguments: arguments; |
|
533 yourself. |
|
534 ! ! |
|
535 |
|
536 !PPCProtype1Test class methodsFor:'documentation'! |
|
537 |
|
538 version_HG |
|
539 |
|
540 ^ '$Changeset: <not expanded> $' |
|
541 ! ! |
|
542 |
|