90 parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself). |
90 parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself). |
91 self assert: parser parse: String lf. |
91 self assert: parser parse: String lf. |
92 ! |
92 ! |
93 |
93 |
94 testCompileChoice |
94 testCompileChoice |
95 tree := PPCChoiceNode new |
95 tree := PPCChoiceNode new |
96 children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; |
96 children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; |
97 yourself. |
97 yourself. |
98 |
98 |
99 parser := self compileTree: tree. |
99 parser := self compileTree: tree. |
100 |
100 |
101 self assert: parser class methodDictionary size = 4. |
101 self assert: parser class methodDictionary size = 4. |
102 |
102 |
103 self assert: parser parse: '1' to: $1. |
103 self assert: parser parse: '1' to: $1. |
104 self assert: parser parse: 'a' to: $a. |
104 self assert: parser parse: 'a' to: $a. |
105 self assert: parser fail: '_'. |
105 self assert: parser fail: '_'. |
106 |
|
107 "Modified: / 06-11-2014 / 00:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
108 ! |
106 ! |
109 |
107 |
110 testCompileLiteral |
108 testCompileLiteral |
111 tree := PPCLiteralNode new |
109 tree := PPCLiteralNode new |
112 literal: 'foo'; |
110 literal: 'foo'; |
113 yourself. |
111 yourself. |
114 parser := self compileTree: tree. |
112 parser := self compileTree: tree. |
115 |
113 |
116 self assert: parser class methodDictionary size = 2. |
114 self assert: parser class methodDictionary size = 2. |
117 self assert: parser parse: 'foo' to: 'foo'. |
115 self assert: parser parse: 'foo' to: 'foo'. |
118 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
116 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
119 self assert: parser fail: 'boo'. |
117 self assert: parser fail: 'boo'. |
120 |
|
121 "Modified: / 06-11-2014 / 00:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
122 ! |
118 ! |
123 |
119 |
124 testCompileLiteral2 |
120 testCompileLiteral2 |
125 | | |
121 | | |
126 |
122 |
151 self assert: parser fail: '1'. |
147 self assert: parser fail: '1'. |
152 self assert: parser parse: '' to: nil end: 0. |
148 self assert: parser parse: '' to: nil end: 0. |
153 ! |
149 ! |
154 |
150 |
155 testCompileNotCharSetPredicate |
151 testCompileNotCharSetPredicate |
156 tree := PPCNotCharSetPredicateNode new |
152 tree := PPCNotCharSetPredicateNode new |
157 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
153 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
158 yourself. |
154 yourself. |
159 parser := self compileTree: tree. |
155 parser := self compileTree: tree. |
160 |
156 |
161 self assert: parser class methodDictionary size = 2. |
157 self assert: parser class methodDictionary size = 2. |
162 self assert: parser parse: 'b' to: nil end: 0. |
158 self assert: parser parse: 'b' to: nil end: 0. |
163 self assert: context invocationCount = 2. |
159 self assert: context invocationCount = 2. |
164 |
160 |
165 self assert: parser fail: 'a'. |
161 self assert: parser fail: 'a'. |
166 self assert: parser parse: '' to: nil end: 0. |
162 self assert: parser parse: '' to: nil end: 0. |
167 |
|
168 "Modified: / 06-11-2014 / 00:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
169 ! |
163 ! |
170 |
164 |
171 testCompileNotLiteral |
165 testCompileNotLiteral |
172 tree := PPCNotLiteralNode new |
166 tree := PPCNotLiteralNode new |
173 literal: 'foo'; |
167 literal: 'foo'; |
174 yourself. |
168 yourself. |
175 parser := self compileTree: tree. |
169 parser := self compileTree: tree. |
176 |
170 |
177 self assert: parser class methodDictionary size = 2. |
171 self assert: parser class methodDictionary size = 2. |
178 self assert: parser parse: 'bar' to: nil end: 0. |
172 self assert: parser parse: 'bar' to: nil end: 0. |
179 self assert: context invocationCount = 2. |
173 self assert: context invocationCount = 2. |
180 |
174 |
181 self assert: parser fail: 'foo'. |
175 self assert: parser fail: 'foo'. |
182 self assert: parser parse: '' to: nil end: 0. |
176 self assert: parser parse: '' to: nil end: 0. |
183 |
|
184 "Modified: / 06-11-2014 / 00:48:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
185 ! |
177 ! |
186 |
178 |
187 testCompileNotMessagePredicate |
179 testCompileNotMessagePredicate |
188 tree := PPCNotMessagePredicateNode new |
180 tree := PPCNotMessagePredicateNode new |
189 message: #isDigit; |
181 message: #isDigit; |
190 yourself. |
182 yourself. |
191 parser := self compileTree: tree. |
183 parser := self compileTree: tree. |
192 |
184 |
193 self assert: parser class methodDictionary size = 2. |
185 self assert: parser class methodDictionary size = 2. |
194 self assert: parser parse: 'a' to: nil end: 0. |
186 self assert: parser parse: 'a' to: nil end: 0. |
195 self assert: context invocationCount = 2. |
187 self assert: context invocationCount = 2. |
196 |
188 |
197 self assert: parser fail: '1'. |
189 self assert: parser fail: '1'. |
198 self assert: parser parse: '' to: nil end: 0. |
190 self assert: parser parse: '' to: nil end: 0. |
199 |
|
200 "Modified: / 06-11-2014 / 00:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
201 ! |
191 ! |
202 |
192 |
203 testCompileOptional |
193 testCompileOptional |
204 tree := PPCOptionalNode new |
194 tree := PPCOptionalNode new |
205 child: ($a asParser asCompilerNode); |
195 child: ($a asParser asCompilerNode); |
254 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
244 self assert: parser parse: 'ab' to: #( $a ) end: 1. |
255 self assert: parser parse: 'b' to: #( ) end: 0. |
245 self assert: parser parse: 'b' to: #( ) end: 0. |
256 ! |
246 ! |
257 |
247 |
258 testCompileStarAny |
248 testCompileStarAny |
259 tree := PPCStarAnyNode new. |
249 tree := PPCStarAnyNode new child: PPCNilNode new; yourself. |
260 parser := self compileTree: tree. |
250 parser := self compileTree: tree. |
261 |
251 |
262 self assert: parser parse: 'abc' to: #($a $b $c). |
252 self assert: parser parse: 'abc' to: #($a $b $c). |
263 self assert: parser parse: 'a' to: #($a). |
253 self assert: parser parse: 'a' to: #($a). |
264 self assert: parser parse: '' to: #(). |
254 self assert: parser parse: '' to: #(). |
265 ! |
255 ! |
266 |
256 |
267 testCompileStarCharSetPredicate |
257 testCompileStarCharSetPredicate |
268 tree := PPCStarCharSetPredicateNode new |
258 tree := PPCStarCharSetPredicateNode new |
269 predicate: (PPCharSetPredicate on: [:e | e = $a ]); |
259 predicate: (PPCharSetPredicate on: [:e | e = $a ]); |
270 yourself. |
260 "I have to put something here" |
271 parser := self compileTree: tree. |
261 child: PPCNilNode new; |
272 |
262 yourself. |
273 self assert: parser class methodDictionary size = 2. |
263 parser := self compileTree: tree. |
274 self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. |
264 |
275 self assert: context invocationCount = 2. |
265 self assert: parser class methodDictionary size = 2. |
276 self assert: parser parse: 'bba' to: #() end: 0. |
266 self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. |
277 self assert: context invocationCount = 2. |
267 self assert: context invocationCount = 2. |
278 |
268 self assert: parser parse: 'bba' to: #() end: 0. |
279 "Modified: / 06-11-2014 / 00:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
269 self assert: context invocationCount = 2. |
|
270 |
280 ! |
271 ! |
281 |
272 |
282 testCompileStarMessagePredicate |
273 testCompileStarMessagePredicate |
283 tree := PPCStarMessagePredicateNode new |
274 tree := PPCStarMessagePredicateNode new |
284 message: #isLetter; |
275 message: #isLetter; |
285 yourself. |
276 "I have to add something here" |
286 parser := self compileTree: tree. |
277 child: PPCNilNode new; |
287 |
278 yourself. |
288 self assert: parser class methodDictionary size = 2. |
279 parser := self compileTree: tree. |
289 self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. |
280 |
290 self assert: context invocationCount = 2. |
281 self assert: parser class methodDictionary size = 2. |
291 |
282 self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. |
292 self assert: parser parse: '123a' to: #() end: 0. |
283 self assert: context invocationCount = 2. |
293 self assert: context invocationCount = 2. |
284 |
294 |
285 self assert: parser parse: '123a' to: #() end: 0. |
295 "Modified: / 06-11-2014 / 00:48:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
286 self assert: context invocationCount = 2. |
|
287 |
296 ! |
288 ! |
297 |
289 |
298 testCompileSymbolAction |
290 testCompileSymbolAction |
299 tree := PPCSymbolActionNode new |
291 tree := PPCSymbolActionNode new |
300 block: #second; |
292 block: #second; |
351 self assert: context lwRestoreCount = 1. |
343 self assert: context lwRestoreCount = 1. |
352 |
344 |
353 ! |
345 ! |
354 |
346 |
355 testCompileTokenStarMessagePredicate |
347 testCompileTokenStarMessagePredicate |
356 |
348 |
357 tree := PPCTokenStarMessagePredicateNode new message: #isLetter. |
349 tree := PPCTokenStarMessagePredicateNode new message: #isLetter; child: PPCNilNode new; yourself. |
358 parser := self compileTree: tree params: {#guards -> false}. |
350 parser := self compileTree: tree params: {#guards -> false}. |
359 |
351 |
360 self assert: parser class methodDictionary size = 2. |
352 self assert: parser class methodDictionary size = 2. |
361 |
353 |
362 self assert: parser parse: 'foo' to: parser. |
354 self assert: parser parse: 'foo' to: parser. |
363 self assert: context invocationCount = 2. |
355 self assert: context invocationCount = 2. |
364 self assert: context lwRememberCount = 0. |
356 self assert: context lwRememberCount = 0. |
365 self assert: context lwRestoreCount = 0. |
357 self assert: context lwRestoreCount = 0. |
366 self assert: context rememberCount = 0. |
358 self assert: context rememberCount = 0. |
367 |
359 |
368 self assert: parser parse: 'foo123' to: parser end: 3. |
360 self assert: parser parse: 'foo123' to: parser end: 3. |
369 |
|
370 "Modified: / 06-11-2014 / 00:49:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
371 ! ! |
361 ! ! |
372 |
362 |
373 !PPCNodeCompilingTest methodsFor:'tests - guard'! |
363 !PPCNodeCompilingTest methodsFor:'tests - guard'! |
374 |
364 |
375 testSequenceTokenGuard |
365 testSequenceTokenGuard |
420 ! ! |
410 ! ! |
421 |
411 |
422 !PPCNodeCompilingTest methodsFor:'tests - inlining'! |
412 !PPCNodeCompilingTest methodsFor:'tests - inlining'! |
423 |
413 |
424 testInlineAny |
414 testInlineAny |
425 tree := PPCSequenceNode new |
415 tree := PPCSequenceNode new |
426 children: { PPCInlineAnyNode new. $a asParser asCompilerNode }. |
416 children: { PPCInlineAnyNode new. $a asParser asCompilerNode }. |
427 |
417 |
428 parser := self compileTree: tree. |
418 parser := self compileTree: tree. |
429 |
419 |
430 self assert: parser class methodDictionary size = 3. |
420 self assert: parser class methodDictionary size = 3. |
431 self assert: parser parse: '.a' to: #($. $a). |
421 self assert: parser parse: '.a' to: #($. $a). |
432 |
|
433 "Modified: / 06-11-2014 / 01:12:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
434 ! |
422 ! |
435 |
423 |
436 testInlineCharSetPredicate |
424 testInlineCharSetPredicate |
437 tree := PPCPlusNode new |
425 tree := PPCPlusNode new |
438 child: (PPCInlineCharSetPredicateNode new |
426 child: (PPCInlineCharSetPredicateNode new |
439 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
427 predicate: (PPCharSetPredicate on: [ :e | e = $a ]); |
440 yourself); |
428 yourself); |
441 yourself. |
429 yourself. |
442 |
430 |
443 parser := self compileTree: tree. |
431 parser := self compileTree: tree. |
444 |
432 |
445 self assert: parser class methodDictionary size = 2. |
433 self assert: parser class methodDictionary size = 2. |
446 self assert: parser parse: 'a' to: #($a). |
434 self assert: parser parse: 'a' to: #($a). |
447 self assert: parser fail: 'b'. |
435 self assert: parser fail: 'b'. |
448 |
|
449 "Modified: / 06-11-2014 / 01:12:29 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
450 ! |
436 ! |
451 |
437 |
452 testInlineCharacter |
438 testInlineCharacter |
453 tree := PPCSequenceNode new |
439 tree := PPCSequenceNode new |
454 children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }. |
440 children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }. |
455 |
441 |
456 parser := self compileTree: tree. |
442 parser := self compileTree: tree. |
457 |
443 |
458 self assert: parser class methodDictionary size = 3. |
444 self assert: parser class methodDictionary size = 3. |
459 self assert: parser parse: 'ba' to: #($b $a). |
445 self assert: parser parse: 'ba' to: #($b $a). |
460 |
|
461 "Modified: / 06-11-2014 / 01:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
462 ! |
446 ! |
463 |
447 |
464 testInlineLiteral |
448 testInlineLiteral |
465 tree := PPCSequenceNode new |
449 tree := PPCSequenceNode new |
466 children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
450 children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
467 |
451 |
468 parser := self compileTree: tree. |
452 parser := self compileTree: tree. |
469 |
453 |
470 self assert: parser class methodDictionary size = 3. |
454 self assert: parser class methodDictionary size = 3. |
471 self assert: parser parse: 'fooa' to: #('foo' $a). |
455 self assert: parser parse: 'fooa' to: #('foo' $a). |
472 |
|
473 "Modified: / 06-11-2014 / 01:12:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
474 ! |
456 ! |
475 |
457 |
476 testInlineNil |
458 testInlineNil |
477 tree := PPCSequenceNode new |
459 tree := PPCSequenceNode new |
478 children: { PPCInlineNilNode new . $a asParser asCompilerNode }. |
460 children: { PPCInlineNilNode new . $a asParser asCompilerNode }. |
479 |
461 |
480 parser := self compileTree: tree. |
462 parser := self compileTree: tree. |
481 |
463 |
482 self assert: parser class methodDictionary size = 3. |
464 self assert: parser class methodDictionary size = 3. |
483 self assert: parser parse: 'a' to: #(nil $a). |
465 self assert: parser parse: 'a' to: #(nil $a). |
484 |
|
485 "Modified: / 06-11-2014 / 01:12:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
486 ! |
466 ! |
487 |
467 |
488 testInlineNotLiteral |
468 testInlineNotLiteral |
489 tree := PPCSequenceNode new |
469 tree := PPCSequenceNode new |
490 children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
470 children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }. |
491 |
471 |
492 parser := self compileTree: tree. |
472 parser := self compileTree: tree. |
493 |
473 |
494 self assert: parser class methodDictionary size = 3. |
474 self assert: parser class methodDictionary size = 3. |
495 self assert: parser parse: 'a' to: #(nil $a). |
475 self assert: parser parse: 'a' to: #(nil $a). |
496 |
|
497 "Modified: / 06-11-2014 / 01:12:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
498 ! |
476 ! |
499 |
477 |
500 testInlinePluggable |
478 testInlinePluggable |
501 "Sadly, on Smalltalk/X blocks cannot be inlined because |
479 "Sadly, on Smalltalk/X blocks cannot be inlined because |
502 the VM does not provide enough information to map |
480 the VM does not provide enough information to map |
503 it back to source code. Very bad indeed!!" |
481 it back to source code. Very bad indeed!!" |
504 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
482 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
505 self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. |
483 self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. |
506 ]. |
484 ]. |
507 |
485 |
508 tree := PPCSequenceNode new |
486 tree := PPCSequenceNode new |
509 children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }. |
487 children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }. |
510 |
488 |
511 parser := self compileTree: tree. |
489 parser := self compileTree: tree. |
512 |
490 |
513 self assert: parser class methodDictionary size = 3. |
491 self assert: parser class methodDictionary size = 3. |
514 self assert: parser parse: 'ba' to: #($b $a). |
492 self assert: parser parse: 'ba' to: #($b $a). |
515 |
|
516 "Modified: / 06-11-2014 / 01:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
517 ! ! |
493 ! ! |
518 |
494 |
519 !PPCNodeCompilingTest class methodsFor:'documentation'! |
495 !PPCNodeCompilingTest class methodsFor:'documentation'! |
520 |
496 |
521 version_HG |
497 version_HG |