|
1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
|
2 |
|
3 PPAbstractParserTest subclass:#PPCNodeCompilingTest |
|
4 instanceVariableNames:'parser context tree result' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitCompiler-Tests-Nodes' |
|
8 ! |
|
9 |
|
10 !PPCNodeCompilingTest methodsFor:'context'! |
|
11 |
|
12 context |
|
13 ^ context := PPCProfilingContext new |
|
14 ! ! |
|
15 |
|
16 !PPCNodeCompilingTest methodsFor:'test support'! |
|
17 |
|
18 assert: whatever parse: input |
|
19 result := super assert: whatever parse: input. |
|
20 ! |
|
21 |
|
22 compileTree: root |
|
23 ^ self compileTree: root params: #() |
|
24 ! |
|
25 |
|
26 compileTree: root params: params |
|
27 | compiler mock | |
|
28 compiler := PPCCompiler new. |
|
29 compiler profile: true. |
|
30 mock := nil asParser. |
|
31 ^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new. |
|
32 ! ! |
|
33 |
|
34 !PPCNodeCompilingTest methodsFor:'tests - compiling'! |
|
35 |
|
36 testCompileAction |
|
37 tree := PPCActionNode new |
|
38 block: [ :res | res collect: [:each | each asUppercase ]]; |
|
39 child: #letter asParser plus asCompilerTree; |
|
40 yourself. |
|
41 parser := self compileTree: tree. |
|
42 |
|
43 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
|
44 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
|
45 self assert: parser fail: ''. |
|
46 ! |
|
47 |
|
48 testCompileAnd |
|
49 tree := PPCAndNode new |
|
50 child: #digit asParser asCompilerNode; |
|
51 yourself. |
|
52 parser := self compileTree: tree. |
|
53 |
|
54 self assert: parser parse: '1' to: $1 end: 0. |
|
55 self assert: parser fail: 'a'. |
|
56 self assert: parser fail: ''. |
|
57 ! |
|
58 |
|
59 testCompileAny |
|
60 tree := PPCAnyNode new. |
|
61 parser := self compileTree: tree. |
|
62 |
|
63 self assert: parser parse: 'a' to: $a. |
|
64 self assert: parser parse: '_' to: $_. |
|
65 self assert: parser parse: ' |
|
66 ' to: Character cr. |
|
67 ! |
|
68 |
|
69 testCompileCharSetPredicate |
|
70 tree := PPCCharSetPredicateNode new |
|
71 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
72 yourself. |
|
73 parser := self compileTree: tree. |
|
74 |
|
75 self assert: parser parse: 'a' to: $a. |
|
76 self assert: parser fail: 'b'. |
|
77 ! |
|
78 |
|
79 testCompileCharacter |
|
80 tree := PPCCharacterNode new character: $a; yourself. |
|
81 parser := self compileTree: tree. |
|
82 |
|
83 self assert: parser parse: 'a' to: $a. |
|
84 self assert: parser fail: 'b'. |
|
85 |
|
86 parser := self compileTree: (PPCCharacterNode new character: $#; yourself). |
|
87 self assert: parser parse: '#'. |
|
88 |
|
89 parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself). |
|
90 self assert: parser parse: String lf. |
|
91 ! |
|
92 |
|
93 testCompileChoice |
|
94 tree := PPCChoiceNode new |
|
95 children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; |
|
96 yourself. |
|
97 |
|
98 parser := self compileTree: tree. |
|
99 |
|
100 self assert: parser class methods size = 4. |
|
101 |
|
102 self assert: parser parse: '1' to: $1. |
|
103 self assert: parser parse: 'a' to: $a. |
|
104 self assert: parser fail: '_'. |
|
105 ! |
|
106 |
|
107 testCompileLiteral |
|
108 tree := PPCLiteralNode new |
|
109 literal: 'foo'; |
|
110 yourself. |
|
111 parser := self compileTree: tree. |
|
112 |
|
113 self assert: parser class methods size = 2. |
|
114 self assert: parser parse: 'foo' to: 'foo'. |
|
115 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
|
116 self assert: parser fail: 'boo'. |
|
117 ! |
|
118 |
|
119 testCompileLiteral2 |
|
120 | | |
|
121 |
|
122 tree := PPCLiteralNode new |
|
123 literal: ''''''; |
|
124 yourself. |
|
125 parser := self compileTree: tree. |
|
126 |
|
127 self assert: parser parse: '''''' to: ''''''. |
|
128 ! |
|
129 |
|
130 testCompileNil |
|
131 tree := PPCNilNode new. |
|
132 |
|
133 parser := self compileTree: tree. |
|
134 |
|
135 self assert: parser parse: 'a' to: nil end: 0. |
|
136 self assert: parser parse: '' to: nil end: 0. |
|
137 ! |
|
138 |
|
139 testCompileNot |
|
140 tree := PPCNotNode new |
|
141 child: #digit asParser asCompilerNode; |
|
142 yourself. |
|
143 parser := self compileTree: tree. |
|
144 |
|
145 self assert: parser parse: 'a' to: nil end: 0. |
|
146 self assert: parser fail: '1'. |
|
147 self assert: parser parse: '' to: nil end: 0. |
|
148 ! |
|
149 |
|
150 testCompileNotCharSetPredicate |
|
151 tree := PPCNotCharSetPredicateNode new |
|
152 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
153 yourself. |
|
154 parser := self compileTree: tree. |
|
155 |
|
156 self assert: parser class methods size = 2. |
|
157 self assert: parser parse: 'b' to: nil end: 0. |
|
158 self assert: context invocationCount = 2. |
|
159 |
|
160 self assert: parser fail: 'a'. |
|
161 self assert: parser parse: '' to: nil end: 0. |
|
162 ! |
|
163 |
|
164 testCompileNotLiteral |
|
165 tree := PPCNotLiteralNode new |
|
166 literal: 'foo'; |
|
167 yourself. |
|
168 parser := self compileTree: tree. |
|
169 |
|
170 self assert: parser class methods size = 2. |
|
171 self assert: parser parse: 'bar' to: nil end: 0. |
|
172 self assert: context invocationCount = 2. |
|
173 |
|
174 self assert: parser fail: 'foo'. |
|
175 self assert: parser parse: '' to: nil end: 0. |
|
176 ! |
|
177 |
|
178 testCompileNotMessagePredicate |
|
179 tree := PPCNotMessagePredicateNode new |
|
180 message: #isDigit; |
|
181 yourself. |
|
182 parser := self compileTree: tree. |
|
183 |
|
184 self assert: parser class methods size = 2. |
|
185 self assert: parser parse: 'a' to: nil end: 0. |
|
186 self assert: context invocationCount = 2. |
|
187 |
|
188 self assert: parser fail: '1'. |
|
189 self assert: parser parse: '' to: nil end: 0. |
|
190 ! |
|
191 |
|
192 testCompileOptional |
|
193 tree := PPCOptionalNode new |
|
194 child: ($a asParser asCompilerNode); |
|
195 yourself. |
|
196 parser := self compileTree: tree. |
|
197 |
|
198 self assert: parser parse: 'b' to: nil end: 0. |
|
199 self assert: parser parse: 'a' to: $a. |
|
200 self assert: parser parse: '' to: nil end: 0. |
|
201 ! |
|
202 |
|
203 testCompilePluggable |
|
204 tree := PPCPluggableNode new |
|
205 block: [:ctx | ctx next ]; |
|
206 yourself. |
|
207 parser := self compileTree: tree. |
|
208 |
|
209 self assert: parser parse: 'foo' to: $f end: 1. |
|
210 self assert: parser parse: 'bar' to: $b end: 1. |
|
211 self assert: parser parse: '' to: nil. |
|
212 ! |
|
213 |
|
214 testCompilePlus |
|
215 tree := PPCPlusNode new |
|
216 child: ($a asParser asCompilerNode); |
|
217 yourself. |
|
218 parser := self compileTree: tree. |
|
219 |
|
220 self assert: parser parse: 'aaa' to: #($a $a $a) end: 3. |
|
221 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
|
222 self assert: parser fail: 'b'. |
|
223 ! |
|
224 |
|
225 testCompileSequence |
|
226 tree := PPCSequenceNode new |
|
227 children: { $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode } |
|
228 yourself. |
|
229 parser := self compileTree: tree. |
|
230 |
|
231 self assert: parser parse: 'abc' to: #($a $b $c) end: 3. |
|
232 self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3. |
|
233 self assert: parser fail: 'ab'. |
|
234 ! |
|
235 |
|
236 testCompileStar |
|
237 tree := PPCStarNode new |
|
238 child: ($a asParser asCompilerNode); |
|
239 yourself. |
|
240 parser := self compileTree: tree. |
|
241 |
|
242 self assert: parser parse: 'aaa' to: #($a $a $a) end: 3. |
|
243 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
|
244 self assert: parser parse: 'b' to: #( ) end: 0. |
|
245 ! |
|
246 |
|
247 testCompileStarAny |
|
248 tree := PPCStarAnyNode new. |
|
249 parser := self compileTree: tree. |
|
250 |
|
251 self assert: parser parse: 'abc' to: #($a $b $c). |
|
252 self assert: parser parse: 'a' to: #($a). |
|
253 self assert: parser parse: '' to: #(). |
|
254 ! |
|
255 |
|
256 testCompileStarCharSetPredicate |
|
257 tree := PPCStarCharSetPredicateNode new |
|
258 predicate: (PPCharSetPredicate on: [:e | e = $a ]); |
|
259 yourself. |
|
260 parser := self compileTree: tree. |
|
261 |
|
262 self assert: parser class methods size = 2. |
|
263 self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. |
|
264 self assert: context invocationCount = 2. |
|
265 self assert: parser parse: 'bba' to: #() end: 0. |
|
266 self assert: context invocationCount = 2. |
|
267 |
|
268 ! |
|
269 |
|
270 testCompileStarMessagePredicate |
|
271 tree := PPCStarMessagePredicateNode new |
|
272 message: #isLetter; |
|
273 yourself. |
|
274 parser := self compileTree: tree. |
|
275 |
|
276 self assert: parser class methods size = 2. |
|
277 self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. |
|
278 self assert: context invocationCount = 2. |
|
279 |
|
280 self assert: parser parse: '123a' to: #() end: 0. |
|
281 self assert: context invocationCount = 2. |
|
282 |
|
283 ! |
|
284 |
|
285 testCompileSymbolAction |
|
286 tree := PPCSymbolActionNode new |
|
287 block: #second; |
|
288 child: #letter asParser plus asCompilerTree; |
|
289 yourself. |
|
290 parser := self compileTree: tree. |
|
291 |
|
292 self assert: parser parse: 'foo' to: $o. |
|
293 self assert: parser parse: 'bar' to: $a. |
|
294 self assert: parser fail: ''. |
|
295 ! |
|
296 |
|
297 testCompileToken |
|
298 tree := PPCTokenNode new |
|
299 child: #letter asParser plus asCompilerTree; |
|
300 tokenClass: PPToken; |
|
301 yourself. |
|
302 |
|
303 parser := self compileTree: tree. |
|
304 |
|
305 self assert: parser parse: 'abc'. |
|
306 self assert: result class = PPToken. |
|
307 self assert: result inputValue = 'abc'. |
|
308 |
|
309 self assert: parser fail: '1a'. |
|
310 ! |
|
311 |
|
312 testCompileTokenSequence |
|
313 tree := PPCTokenSequenceNode new. |
|
314 tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }. |
|
315 |
|
316 parser := self compileTree: tree. |
|
317 |
|
318 self assert: parser parse: '1a' to: parser. |
|
319 self assert: context rememberCount = 0. |
|
320 self assert: context lwRememberCount = 1. |
|
321 self assert: context restoreCount = 0. |
|
322 self assert: context lwRestoreCount = 0. |
|
323 |
|
324 self assert: parser parse: '1ab' to: parser end: 2. |
|
325 self assert: context lwRememberCount = 1. |
|
326 self assert: context lwRestoreCount = 0. |
|
327 |
|
328 self assert: parser fail: 'a1'. |
|
329 self assert: context lwRememberCount = 1. |
|
330 self assert: context lwRestoreCount = 0. |
|
331 |
|
332 self assert: parser fail: 'aa'. |
|
333 self assert: context lwRememberCount = 1. |
|
334 self assert: context lwRestoreCount = 0. |
|
335 |
|
336 self assert: parser fail: '11'. |
|
337 self assert: context lwRememberCount = 1. |
|
338 self assert: context lwRestoreCount = 1. |
|
339 |
|
340 ! |
|
341 |
|
342 testCompileTokenStarMessagePredicate |
|
343 |
|
344 tree := PPCTokenStarMessagePredicateNode new message: #isLetter. |
|
345 parser := self compileTree: tree params: {#guards -> false}. |
|
346 |
|
347 self assert: parser class methods size = 2. |
|
348 |
|
349 self assert: parser parse: 'foo' to: parser. |
|
350 self assert: context invocationCount = 2. |
|
351 self assert: context lwRememberCount = 0. |
|
352 self assert: context lwRestoreCount = 0. |
|
353 self assert: context rememberCount = 0. |
|
354 |
|
355 self assert: parser parse: 'foo123' to: parser end: 3. |
|
356 ! ! |
|
357 |
|
358 !PPCNodeCompilingTest methodsFor:'tests - guard'! |
|
359 |
|
360 testSequenceTokenGuard |
|
361 |
|
362 tree := PPCSequenceNode new |
|
363 children: { |
|
364 'foo' asParser trimmingToken asCompilerTree optimizeTree. |
|
365 'bar' asParser trimmingToken asCompilerTree optimizeTree. |
|
366 } |
|
367 yourself. |
|
368 parser := self compileTree: tree. |
|
369 |
|
370 self assert: parser parse: 'foobar'. |
|
371 self assert: result first inputValue = 'foo'. |
|
372 self assert: result second inputValue = 'bar'. |
|
373 |
|
374 self assert: parser parse: ' foobar'. |
|
375 self assert: result first inputValue = 'foo'. |
|
376 self assert: result second inputValue = 'bar'. |
|
377 |
|
378 self assert: parser fail: ' foo'. |
|
379 ! |
|
380 |
|
381 testTrimmingTokenGuard |
|
382 |
|
383 tree := PPCChoiceNode new |
|
384 children: { |
|
385 'foo' asParser trimmingToken asCompilerTree optimizeTree. |
|
386 'bar' asParser trimmingToken asCompilerTree optimizeTree |
|
387 } |
|
388 yourself. |
|
389 parser := self compileTree: tree. |
|
390 |
|
391 self assert: parser parse: 'foo'. |
|
392 self assert: result inputValue = 'foo'. |
|
393 |
|
394 self assert: parser parse: 'bar'. |
|
395 self assert: result inputValue = 'bar'. |
|
396 |
|
397 self assert: parser parse: ' foo'. |
|
398 self assert: result inputValue = 'foo'. |
|
399 |
|
400 self assert: parser parse: ' bar'. |
|
401 self assert: result inputValue = 'bar'. |
|
402 |
|
403 self assert: parser fail: 'zorg'. |
|
404 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]). |
|
405 ! ! |
|
406 |
|
407 !PPCNodeCompilingTest methodsFor:'tests - inlining'! |
|
408 |
|
409 testInlineAny |
|
410 tree := PPCSequenceNode new |
|
411 children: { PPCInlineAnyNode new. $a asParser asCompilerNode }. |
|
412 |
|
413 parser := self compileTree: tree. |
|
414 |
|
415 self assert: parser class methods size = 3. |
|
416 self assert: parser parse: '.a' to: #($. $a). |
|
417 ! |
|
418 |
|
419 testInlineCharSetPredicate |
|
420 tree := PPCPlusNode new |
|
421 child: (PPCInlineCharSetPredicateNode new |
|
422 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
423 yourself); |
|
424 yourself. |
|
425 |
|
426 parser := self compileTree: tree. |
|
427 |
|
428 self assert: parser class methods size = 2. |
|
429 self assert: parser parse: 'a' to: #($a). |
|
430 self assert: parser fail: 'b'. |
|
431 ! |
|
432 |
|
433 testInlineCharacter |
|
434 tree := PPCSequenceNode new |
|
435 children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }. |
|
436 |
|
437 parser := self compileTree: tree. |
|
438 |
|
439 self assert: parser class methods size = 3. |
|
440 self assert: parser parse: 'ba' to: #($b $a). |
|
441 ! |
|
442 |
|
443 testInlineLiteral |
|
444 tree := PPCSequenceNode new |
|
445 children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
|
446 |
|
447 parser := self compileTree: tree. |
|
448 |
|
449 self assert: parser class methods size = 3. |
|
450 self assert: parser parse: 'fooa' to: #('foo' $a). |
|
451 ! |
|
452 |
|
453 testInlineNil |
|
454 tree := PPCSequenceNode new |
|
455 children: { PPCInlineNilNode new . $a asParser asCompilerNode }. |
|
456 |
|
457 parser := self compileTree: tree. |
|
458 |
|
459 self assert: parser class methods size = 3. |
|
460 self assert: parser parse: 'a' to: #(nil $a). |
|
461 ! |
|
462 |
|
463 testInlineNotLiteral |
|
464 tree := PPCSequenceNode new |
|
465 children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
|
466 |
|
467 parser := self compileTree: tree. |
|
468 |
|
469 self assert: parser class methods size = 3. |
|
470 self assert: parser parse: 'a' to: #(nil $a). |
|
471 ! |
|
472 |
|
473 testInlinePluggable |
|
474 tree := PPCSequenceNode new |
|
475 children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }. |
|
476 |
|
477 parser := self compileTree: tree. |
|
478 |
|
479 self assert: parser class methods size = 3. |
|
480 self assert: parser parse: 'ba' to: #($b $a). |
|
481 ! ! |
|
482 |