21 assert: whatever parse: input |
21 assert: whatever parse: input |
22 result := super assert: whatever parse: input. |
22 result := super assert: whatever parse: input. |
23 ! |
23 ! |
24 |
24 |
25 compileTree: root |
25 compileTree: root |
26 ^ self compileTree: root params: #() |
26 ^ self compileTree: root arguments: PPCArguments default |
27 ! |
27 ! |
28 |
28 |
29 compileTree: root params: params |
29 compileTree: root arguments: arguments |
30 | compiler mock | |
30 | configuration | |
31 compiler := PPCCompiler new. |
31 arguments profile: true. |
32 compiler profile: true. |
32 |
33 mock := nil asParser. |
33 configuration := PPCPluggableConfiguration on: [ :_self | |
34 ^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new. |
34 _self specialize. |
35 ! ! |
35 _self specialize. |
|
36 _self tokenize. |
|
37 _self inline. |
|
38 _self merge. |
|
39 _self generate. |
|
40 ]. |
36 |
41 |
37 !PPCNodeCompilingTest methodsFor:'tests - compiling'! |
42 ^ configuration compile: root arguments: arguments. |
38 |
|
39 testCompileAction |
|
40 tree := PPCActionNode new |
|
41 block: [ :res | res collect: [:each | each asUppercase ]]; |
|
42 child: #letter asParser plus asCompilerTree; |
|
43 yourself. |
|
44 parser := self compileTree: tree. |
|
45 |
|
46 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
|
47 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
|
48 self assert: parser fail: ''. |
|
49 ! |
43 ! |
50 |
44 |
51 testCompileAnd |
45 tearDown |
52 tree := PPCAndNode new |
46 | class | |
53 child: #digit asParser asCompilerNode; |
|
54 yourself. |
|
55 parser := self compileTree: tree. |
|
56 |
|
57 self assert: parser parse: '1' to: $1 end: 0. |
|
58 self assert: parser fail: 'a'. |
|
59 self assert: parser fail: ''. |
|
60 ! |
|
61 |
47 |
62 testCompileAny |
48 class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]). |
63 tree := PPCAnyNode new. |
49 class notNil ifTrue:[ |
64 parser := self compileTree: tree. |
50 class removeFromSystem |
65 |
51 ]. |
66 self assert: parser parse: 'a' to: $a. |
|
67 self assert: parser parse: '_' to: $_. |
|
68 self assert: parser parse: ' |
|
69 ' to: Character cr. |
|
70 ! |
|
71 |
|
72 testCompileCharSetPredicate |
|
73 tree := PPCCharSetPredicateNode new |
|
74 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
75 yourself. |
|
76 parser := self compileTree: tree. |
|
77 |
|
78 self assert: parser parse: 'a' to: $a. |
|
79 self assert: parser fail: 'b'. |
|
80 ! |
|
81 |
|
82 testCompileCharacter |
|
83 tree := PPCCharacterNode new character: $a; yourself. |
|
84 parser := self compileTree: tree. |
|
85 |
|
86 self assert: parser parse: 'a' to: $a. |
|
87 self assert: parser fail: 'b'. |
|
88 |
|
89 parser := self compileTree: (PPCCharacterNode new character: $#; yourself). |
|
90 self assert: parser parse: '#'. |
|
91 |
|
92 parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself). |
|
93 self assert: parser parse: String lf. |
|
94 ! |
|
95 |
|
96 testCompileChoice |
|
97 tree := PPCChoiceNode new |
|
98 children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; |
|
99 yourself. |
|
100 |
|
101 parser := self compileTree: tree. |
|
102 |
|
103 self assert: parser class methodDictionary size = 4. |
|
104 |
|
105 self assert: parser parse: '1' to: $1. |
|
106 self assert: parser parse: 'a' to: $a. |
|
107 self assert: parser fail: '_'. |
|
108 ! |
|
109 |
|
110 testCompileLiteral |
|
111 tree := PPCLiteralNode new |
|
112 literal: 'foo'; |
|
113 yourself. |
|
114 parser := self compileTree: tree. |
|
115 |
|
116 self assert: parser class methodDictionary size = 2. |
|
117 self assert: parser parse: 'foo' to: 'foo'. |
|
118 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
|
119 self assert: parser fail: 'boo'. |
|
120 ! |
|
121 |
|
122 testCompileLiteral2 |
|
123 | | |
|
124 |
|
125 tree := PPCLiteralNode new |
|
126 literal: ''''''; |
|
127 yourself. |
|
128 parser := self compileTree: tree. |
|
129 |
|
130 self assert: parser parse: '''''' to: ''''''. |
|
131 ! |
|
132 |
|
133 testCompileNil |
|
134 tree := PPCNilNode new. |
|
135 |
|
136 parser := self compileTree: tree. |
|
137 |
|
138 self assert: parser parse: 'a' to: nil end: 0. |
|
139 self assert: parser parse: '' to: nil end: 0. |
|
140 ! |
|
141 |
|
142 testCompileNot |
|
143 tree := PPCNotNode new |
|
144 child: #digit asParser asCompilerNode; |
|
145 yourself. |
|
146 parser := self compileTree: tree. |
|
147 |
|
148 self assert: parser parse: 'a' to: nil end: 0. |
|
149 self assert: parser fail: '1'. |
|
150 self assert: parser parse: '' to: nil end: 0. |
|
151 ! |
|
152 |
|
153 testCompileNotCharSetPredicate |
|
154 tree := PPCNotCharSetPredicateNode new |
|
155 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
156 yourself. |
|
157 parser := self compileTree: tree. |
|
158 |
|
159 self assert: parser class methodDictionary size = 2. |
|
160 self assert: parser parse: 'b' to: nil end: 0. |
|
161 self assert: context invocationCount = 2. |
|
162 |
|
163 self assert: parser fail: 'a'. |
|
164 self assert: parser parse: '' to: nil end: 0. |
|
165 ! |
|
166 |
|
167 testCompileNotLiteral |
|
168 tree := PPCNotLiteralNode new |
|
169 literal: 'foo'; |
|
170 yourself. |
|
171 parser := self compileTree: tree. |
|
172 |
|
173 self assert: parser class methodDictionary size = 2. |
|
174 self assert: parser parse: 'bar' to: nil end: 0. |
|
175 self assert: context invocationCount = 2. |
|
176 |
|
177 self assert: parser fail: 'foo'. |
|
178 self assert: parser parse: '' to: nil end: 0. |
|
179 ! |
|
180 |
|
181 testCompileNotMessagePredicate |
|
182 tree := PPCNotMessagePredicateNode new |
|
183 message: #isDigit; |
|
184 yourself. |
|
185 parser := self compileTree: tree. |
|
186 |
|
187 self assert: parser class methodDictionary size = 2. |
|
188 self assert: parser parse: 'a' to: nil end: 0. |
|
189 self assert: context invocationCount = 2. |
|
190 |
|
191 self assert: parser fail: '1'. |
|
192 self assert: parser parse: '' to: nil end: 0. |
|
193 ! |
|
194 |
|
195 testCompileOptional |
|
196 tree := PPCOptionalNode new |
|
197 child: ($a asParser asCompilerNode); |
|
198 yourself. |
|
199 parser := self compileTree: tree. |
|
200 |
|
201 self assert: parser parse: 'b' to: nil end: 0. |
|
202 self assert: parser parse: 'a' to: $a. |
|
203 self assert: parser parse: '' to: nil end: 0. |
|
204 ! |
|
205 |
|
206 testCompilePluggable |
|
207 tree := PPCPluggableNode new |
|
208 block: [:ctx | ctx next ]; |
|
209 yourself. |
|
210 parser := self compileTree: tree. |
|
211 |
|
212 self assert: parser parse: 'foo' to: $f end: 1. |
|
213 self assert: parser parse: 'bar' to: $b end: 1. |
|
214 self assert: parser parse: '' to: nil. |
|
215 ! |
|
216 |
|
217 testCompilePlus |
|
218 tree := PPCPlusNode new |
|
219 child: ($a asParser asCompilerNode); |
|
220 yourself. |
|
221 parser := self compileTree: tree. |
|
222 |
|
223 self assert: parser parse: 'aaa' to: #($a $a $a) end: 3. |
|
224 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
|
225 self assert: parser fail: 'b'. |
|
226 ! |
|
227 |
|
228 testCompileSequence |
|
229 tree := PPCSequenceNode new |
|
230 children: { $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode } |
|
231 yourself. |
|
232 parser := self compileTree: tree. |
|
233 |
|
234 self assert: parser parse: 'abc' to: #($a $b $c) end: 3. |
|
235 self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3. |
|
236 self assert: parser fail: 'ab'. |
|
237 ! |
|
238 |
|
239 testCompileStar |
|
240 tree := PPCStarNode new |
|
241 child: ($a asParser asCompilerNode); |
|
242 yourself. |
|
243 parser := self compileTree: tree. |
|
244 |
|
245 self assert: parser parse: 'aaa' to: #($a $a $a) end: 3. |
|
246 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
|
247 self assert: parser parse: 'b' to: #( ) end: 0. |
|
248 ! |
|
249 |
|
250 testCompileStarAny |
|
251 tree := PPCStarAnyNode new child: PPCNilNode new; yourself. |
|
252 parser := self compileTree: tree. |
|
253 |
|
254 self assert: parser parse: 'abc' to: #($a $b $c). |
|
255 self assert: parser parse: 'a' to: #($a). |
|
256 self assert: parser parse: '' to: #(). |
|
257 ! |
|
258 |
|
259 testCompileStarCharSetPredicate |
|
260 tree := PPCStarCharSetPredicateNode new |
|
261 predicate: (PPCharSetPredicate on: [:e | e = $a ]); |
|
262 "I have to put something here" |
|
263 child: PPCNilNode new; |
|
264 yourself. |
|
265 parser := self compileTree: tree. |
|
266 |
|
267 self assert: parser class methodDictionary size = 2. |
|
268 self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. |
|
269 self assert: context invocationCount = 2. |
|
270 self assert: parser parse: 'bba' to: #() end: 0. |
|
271 self assert: context invocationCount = 2. |
|
272 |
|
273 ! |
|
274 |
|
275 testCompileStarMessagePredicate |
|
276 tree := PPCStarMessagePredicateNode new |
|
277 message: #isLetter; |
|
278 "I have to add something here" |
|
279 child: PPCNilNode new; |
|
280 yourself. |
|
281 parser := self compileTree: tree. |
|
282 |
|
283 self assert: parser class methodDictionary size = 2. |
|
284 self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. |
|
285 self assert: context invocationCount = 2. |
|
286 |
|
287 self assert: parser parse: '123a' to: #() end: 0. |
|
288 self assert: context invocationCount = 2. |
|
289 |
|
290 ! |
|
291 |
|
292 testCompileSymbolAction |
|
293 tree := PPCSymbolActionNode new |
|
294 block: #second; |
|
295 child: #letter asParser plus asCompilerTree; |
|
296 yourself. |
|
297 parser := self compileTree: tree. |
|
298 |
|
299 self assert: parser parse: 'foo' to: $o. |
|
300 self assert: parser parse: 'bar' to: $a. |
|
301 self assert: parser fail: ''. |
|
302 ! |
|
303 |
|
304 testCompileToken |
|
305 tree := PPCTokenNode new |
|
306 child: #letter asParser plus asCompilerTree; |
|
307 tokenClass: PPToken; |
|
308 yourself. |
|
309 |
|
310 parser := self compileTree: tree. |
|
311 |
|
312 self assert: parser parse: 'abc'. |
|
313 self assert: result class = PPToken. |
|
314 self assert: result inputValue = 'abc'. |
|
315 |
|
316 self assert: parser fail: '1a'. |
|
317 ! |
|
318 |
|
319 testCompileTokenSequence |
|
320 tree := PPCTokenSequenceNode new. |
|
321 tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }. |
|
322 |
|
323 parser := self compileTree: tree. |
|
324 |
|
325 self assert: parser parse: '1a' to: parser. |
|
326 self assert: context rememberCount = 0. |
|
327 self assert: context lwRememberCount = 1. |
|
328 self assert: context restoreCount = 0. |
|
329 self assert: context lwRestoreCount = 0. |
|
330 |
|
331 self assert: parser parse: '1ab' to: parser end: 2. |
|
332 self assert: context lwRememberCount = 1. |
|
333 self assert: context lwRestoreCount = 0. |
|
334 |
|
335 self assert: parser fail: 'a1'. |
|
336 self assert: context lwRememberCount = 1. |
|
337 self assert: context lwRestoreCount = 0. |
|
338 |
|
339 self assert: parser fail: 'aa'. |
|
340 self assert: context lwRememberCount = 1. |
|
341 self assert: context lwRestoreCount = 0. |
|
342 |
|
343 self assert: parser fail: '11'. |
|
344 self assert: context lwRememberCount = 1. |
|
345 self assert: context lwRestoreCount = 1. |
|
346 |
|
347 ! |
|
348 |
|
349 testCompileTokenStarMessagePredicate |
|
350 |
|
351 tree := PPCTokenStarMessagePredicateNode new message: #isLetter; child: PPCNilNode new; yourself. |
|
352 parser := self compileTree: tree params: {#guards -> false}. |
|
353 |
|
354 self assert: parser class methodDictionary size = 2. |
|
355 |
|
356 self assert: parser parse: 'foo' to: parser. |
|
357 self assert: context invocationCount = 2. |
|
358 self assert: context lwRememberCount = 0. |
|
359 self assert: context lwRestoreCount = 0. |
|
360 self assert: context rememberCount = 0. |
|
361 |
|
362 self assert: parser parse: 'foo123' to: parser end: 3. |
|
363 ! ! |
52 ! ! |
364 |
53 |
365 !PPCNodeCompilingTest methodsFor:'tests - guard'! |
54 !PPCNodeCompilingTest methodsFor:'tests - guard'! |
366 |
55 |
367 testSequenceTokenGuard |
56 testSequenceTokenGuard |
409 |
98 |
410 self assert: parser fail: 'zorg'. |
99 self assert: parser fail: 'zorg'. |
411 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]). |
100 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]). |
412 ! ! |
101 ! ! |
413 |
102 |
414 !PPCNodeCompilingTest methodsFor:'tests - inlining'! |
|
415 |
|
416 testInlineAny |
|
417 tree := PPCSequenceNode new |
|
418 children: { PPCInlineAnyNode new. $a asParser asCompilerNode }. |
|
419 |
|
420 parser := self compileTree: tree. |
|
421 |
|
422 self assert: parser class methodDictionary size = 3. |
|
423 self assert: parser parse: '.a' to: #($. $a). |
|
424 ! |
|
425 |
|
426 testInlineCharSetPredicate |
|
427 tree := PPCPlusNode new |
|
428 child: (PPCInlineCharSetPredicateNode new |
|
429 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
|
430 yourself); |
|
431 yourself. |
|
432 |
|
433 parser := self compileTree: tree. |
|
434 |
|
435 self assert: parser class methodDictionary size = 2. |
|
436 self assert: parser parse: 'a' to: #($a). |
|
437 self assert: parser fail: 'b'. |
|
438 ! |
|
439 |
|
440 testInlineCharacter |
|
441 tree := PPCSequenceNode new |
|
442 children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }. |
|
443 |
|
444 parser := self compileTree: tree. |
|
445 |
|
446 self assert: parser class methodDictionary size = 3. |
|
447 self assert: parser parse: 'ba' to: #($b $a). |
|
448 ! |
|
449 |
|
450 testInlineLiteral |
|
451 tree := PPCSequenceNode new |
|
452 children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
|
453 |
|
454 parser := self compileTree: tree. |
|
455 |
|
456 self assert: parser class methodDictionary size = 3. |
|
457 self assert: parser parse: 'fooa' to: #('foo' $a). |
|
458 ! |
|
459 |
|
460 testInlineNil |
|
461 tree := PPCSequenceNode new |
|
462 children: { PPCInlineNilNode new . $a asParser asCompilerNode }. |
|
463 |
|
464 parser := self compileTree: tree. |
|
465 |
|
466 self assert: parser class methodDictionary size = 3. |
|
467 self assert: parser parse: 'a' to: #(nil $a). |
|
468 ! |
|
469 |
|
470 testInlineNotLiteral |
|
471 tree := PPCSequenceNode new |
|
472 children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
|
473 |
|
474 parser := self compileTree: tree. |
|
475 |
|
476 self assert: parser class methodDictionary size = 3. |
|
477 self assert: parser parse: 'a' to: #(nil $a). |
|
478 ! |
|
479 |
|
480 testInlinePluggable |
|
481 "Sadly, on Smalltalk/X blocks cannot be inlined because |
|
482 the VM does not provide enough information to map |
|
483 it back to source code. Very bad indeed!!" |
|
484 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
|
485 self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. |
|
486 ]. |
|
487 |
|
488 tree := PPCSequenceNode new |
|
489 children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }. |
|
490 |
|
491 parser := self compileTree: tree. |
|
492 |
|
493 self assert: parser class methodDictionary size = 3. |
|
494 self assert: parser parse: 'ba' to: #($b $a). |
|
495 ! ! |
|
496 |
|
497 !PPCNodeCompilingTest class methodsFor:'documentation'! |
103 !PPCNodeCompilingTest class methodsFor:'documentation'! |
498 |
104 |
499 version_HG |
105 version_HG |
500 |
106 |
501 ^ '$Changeset: <not expanded> $' |
107 ^ '$Changeset: <not expanded> $' |