69 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
69 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
70 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
70 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
71 self assert: parser fail: ''. |
71 self assert: parser fail: ''. |
72 ! |
72 ! |
73 |
73 |
|
74 testActionNode2 |
|
75 node := PPCPlusNode new |
|
76 child: |
|
77 (PPCActionNode new |
|
78 block: [ :res | res asUppercase ]; |
|
79 child: #letter asParser asCompilerTree; |
|
80 yourself); |
|
81 yourself. |
|
82 |
|
83 self compileTree: node. |
|
84 |
|
85 self assert: parser parse: 'foo' to: { $F . $O . $O}. |
|
86 self assert: parser parse: 'bar' to: { $B . $A . $R}. |
|
87 self assert: parser fail: ''. |
|
88 |
|
89 "Created: / 15-06-2015 / 13:57:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
90 ! |
|
91 |
|
92 testActionNode3 |
|
93 node := ((#letter asParser , #letter asParser) |
|
94 ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree. |
|
95 node child markForInline. |
|
96 |
|
97 self compileTree:node. |
|
98 |
|
99 self assert:parser parse:'ab' to:'ab'. |
|
100 self assert:parser parse:'cz' to:'cz'. |
|
101 self assert:parser fail:''. |
|
102 |
|
103 "Created: / 16-06-2015 / 06:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
104 ! |
|
105 |
|
106 testActionNode4 |
|
107 node := ((#letter asParser , #letter asParser) |
|
108 ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree. |
|
109 node child markForInline. |
|
110 |
|
111 self compileTree:node. |
|
112 |
|
113 self assert:parser fail:'a'. |
|
114 |
|
115 "Created: / 16-06-2015 / 06:53:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
116 ! |
|
117 |
|
118 testActionNode5 |
|
119 node := ((#letter asParser , #letter asParser optional) |
|
120 ==> [:nodes | String with:(nodes first) with:((nodes second) isNil ifTrue:[$?] ifFalse:[nodes second]) ]) asCompilerTree. |
|
121 node child markForInline. |
|
122 |
|
123 self compileTree:node. |
|
124 |
|
125 self assert:parser parse:'cz' to:'cz'. |
|
126 self assert:parser parse:'c' to:'c?'. |
|
127 |
|
128 "Created: / 16-06-2015 / 06:53:03 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
129 ! |
|
130 |
|
131 testActionNode6 |
|
132 node := ((#letter asParser , #letter asParser) |
|
133 ==> [:nodes | String withAll:nodes ]) asCompilerTree. |
|
134 node child markForInline. |
|
135 |
|
136 self compileTree:node. |
|
137 |
|
138 self assert:parser parse:'ab' to:'ab'. |
|
139 self assert:parser parse:'cz' to:'cz'. |
|
140 self assert:parser fail:''. |
|
141 |
|
142 "Created: / 16-06-2015 / 07:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
143 ! |
|
144 |
74 testAnyNode |
145 testAnyNode |
75 node := PPCForwardNode new |
146 node := PPCForwardNode new |
76 child: PPCAnyNode new; |
147 child: PPCAnyNode new; |
77 yourself. |
148 yourself. |
78 self compileTree: node. |
149 self compileTree: node. |
363 self assert: parser fail: ''. |
434 self assert: parser fail: ''. |
364 ! |
435 ! |
365 |
436 |
366 testInlinePluggableNode |
437 testInlinePluggableNode |
367 "Sadly, on Smalltalk/X blocks cannot be inlined because |
438 "Sadly, on Smalltalk/X blocks cannot be inlined because |
368 the VM does not provide enough information to map |
439 the VM does not provide enough information to map |
369 it back to source code. Very bad indeed!!" |
440 it back to source code. Very bad indeed!!" |
370 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
441 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
371 self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. |
442 self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'. |
372 ]. |
443 ]. |
373 |
444 |
374 node := PPCSequenceNode new |
445 node := PPCSequenceNode new |
375 children: { |
446 children: { |
376 PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself. |
447 PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself. |
377 $a asParser asCompilerNode }. |
448 $a asParser asCompilerNode }. |
378 |
449 |
379 self compileTree: node. |
450 self compileTree: node. |
380 |
451 |
381 self assert: parser class methodDictionary size = 2. |
452 self assert: parser class methodDictionary size = 2. |
382 self assert: parser parse: 'ba' to: #($b $a). |
453 self assert: parser parse: 'ba' to: #($b $a). |
383 ! |
454 ! |
384 |
455 |
385 testLiteralNode |
456 testLiteralNode |
386 node := PPCLiteralNode new |
457 node := PPCLiteralNode new |
387 literal: 'foo'; |
458 literal: 'foo'; |
417 |
488 |
418 self assert: parser class methodDictionary size = 1. |
489 self assert: parser class methodDictionary size = 1. |
419 self assert: parser parse: 'foo' to: 'foo'. |
490 self assert: parser parse: 'foo' to: 'foo'. |
420 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
491 self assert: parser parse: 'foobar' to: 'foo' end: 3. |
421 self assert: parser fail: 'boo'. |
492 self assert: parser fail: 'boo'. |
|
493 ! |
|
494 |
|
495 testMappedActionNode1 |
|
496 node := ((#letter asParser , #letter asParser) |
|
497 map:[:a :b | String with:a with:b ]) asCompilerTree. |
|
498 |
|
499 self compileTree:node. |
|
500 |
|
501 self assert:parser parse:'ab' to:'ab'. |
|
502 self assert:parser parse:'cz' to:'cz'. |
|
503 self assert:parser fail:''. |
|
504 self assert:parser fail:'a'. |
|
505 |
|
506 "Created: / 02-06-2015 / 17:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
507 "Modified: / 04-06-2015 / 22:44:04 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
508 "Modified (format): / 15-06-2015 / 14:08:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
509 ! |
|
510 |
|
511 testMappedActionNode2 |
|
512 node := ((#letter asParser , #letter asParser) |
|
513 map:[:a :b | String with:a with:b ]) asCompilerTree. |
|
514 node child markForInline. |
|
515 |
|
516 self compileTree:node. |
|
517 |
|
518 self assert:parser parse:'ab' to:'ab'. |
|
519 self assert:parser parse:'cz' to:'cz'. |
|
520 self assert:parser fail:''. |
|
521 self assert:parser fail:'a'. |
|
522 |
|
523 "Created: / 04-06-2015 / 23:13:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
524 "Modified (format): / 15-06-2015 / 14:08:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
525 ! |
|
526 |
|
527 testMappedActionNode3 |
|
528 node := PPCPlusNode new |
|
529 child: |
|
530 (PPCMappedActionNode new |
|
531 block: [ :l | l asUppercase ]; |
|
532 child: #letter asParser asCompilerTree; |
|
533 yourself); |
|
534 yourself. |
|
535 |
|
536 self compileTree:node. |
|
537 |
|
538 self assert:parser parse:'abc' to:#($A $B $C). |
|
539 |
|
540 "Created: / 15-06-2015 / 18:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
422 ! |
541 ! |
423 |
542 |
424 testMessagePredicate |
543 testMessagePredicate |
425 | messageNode | |
544 | messageNode | |
426 messageNode := PPCMessagePredicateNode new |
545 messageNode := PPCMessagePredicateNode new |
753 self assert: parser parse: 'abc' to: #($a $b $c) end: 3. |
872 self assert: parser parse: 'abc' to: #($a $b $c) end: 3. |
754 self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3. |
873 self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3. |
755 self assert: parser fail: 'ab'. |
874 self assert: parser fail: 'ab'. |
756 ! |
875 ! |
757 |
876 |
|
877 testSequenceOptInlined1 |
|
878 | a b bOpt | |
|
879 |
|
880 a := $a asParser asCompilerNode. |
|
881 b := $b asParser asCompilerNode. |
|
882 bOpt := PPCOptionalNode new |
|
883 child: b ; |
|
884 markForInline; |
|
885 yourself. |
|
886 node := PPCSequenceNode new |
|
887 children: { a . bOpt }; |
|
888 yourself. |
|
889 self compileTree: node. |
|
890 |
|
891 self assert: parser parse: 'ab' to: #($a $b ) end: 2. |
|
892 self assert: parser parse: 'a' to: #( $a nil ) end: 1. |
|
893 |
|
894 "Created: / 22-05-2015 / 11:47:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
895 ! |
|
896 |
|
897 testSequenceOptInlined2 |
|
898 | a b bOpt | |
|
899 |
|
900 a := $a asParser asCompilerNode. |
|
901 a markForInline. |
|
902 b := $b asParser asCompilerNode. |
|
903 b markForInline. |
|
904 bOpt := PPCOptionalNode new |
|
905 child: b ; |
|
906 markForInline; |
|
907 yourself. |
|
908 node := PPCSequenceNode new |
|
909 children: { a . bOpt }; |
|
910 yourself. |
|
911 self compileTree: node. |
|
912 |
|
913 self assert: parser parse: 'ab' to: #($a $b ) end: 2. |
|
914 self assert: parser parse: 'a' to: #( $a nil ) end: 1. |
|
915 |
|
916 "Created: / 22-05-2015 / 11:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
917 ! |
|
918 |
758 testStarAnyNode |
919 testStarAnyNode |
759 arguments cacheFirstFollow: false. |
920 arguments cacheFirstFollow: false. |
760 node := PPCStarAnyNode new |
921 node := PPCStarAnyNode new |
761 child: PPCNilNode new; |
922 child: PPCNilNode new; |
762 yourself. |
923 yourself. |