--- a/compiler/tests/PPCCodeGeneratorTest.st Thu May 21 14:12:22 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
@@ -71,6 +71,77 @@
self assert: parser fail: ''.
!
+testActionNode2
+ node := PPCPlusNode new
+ child:
+ (PPCActionNode new
+ block: [ :res | res asUppercase ];
+ child: #letter asParser asCompilerTree;
+ yourself);
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: { $F . $O . $O}.
+ self assert: parser parse: 'bar' to: { $B . $A . $R}.
+ self assert: parser fail: ''.
+
+ "Created: / 15-06-2015 / 13:57:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testActionNode3
+ node := ((#letter asParser , #letter asParser)
+ ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+
+ "Created: / 16-06-2015 / 06:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testActionNode4
+ node := ((#letter asParser , #letter asParser)
+ ==> [:nodes | String with:(nodes first) with:(nodes second) ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser fail:'a'.
+
+ "Created: / 16-06-2015 / 06:53:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testActionNode5
+ node := ((#letter asParser , #letter asParser optional)
+ ==> [:nodes | String with:(nodes first) with:((nodes second) isNil ifTrue:[$?] ifFalse:[nodes second]) ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser parse:'c' to:'c?'.
+
+ "Created: / 16-06-2015 / 06:53:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testActionNode6
+ node := ((#letter asParser , #letter asParser)
+ ==> [:nodes | String withAll:nodes ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+
+ "Created: / 16-06-2015 / 07:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testAnyNode
node := PPCForwardNode new
child: PPCAnyNode new;
@@ -365,21 +436,21 @@
testInlinePluggableNode
"Sadly, on Smalltalk/X blocks cannot be inlined because
- the VM does not provide enough information to map
- it back to source code. Very bad indeed!!"
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'.
- ].
+ the VM does not provide enough information to map
+ it back to source code. Very bad indeed!!"
+ ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+ self skipIf: true description: 'Blocks cannot be inlined due to a lack of proper VM support'.
+ ].
- node := PPCSequenceNode new
- children: {
- PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself.
- $a asParser asCompilerNode }.
-
- self compileTree: node.
-
- self assert: parser class methodDictionary size = 2.
- self assert: parser parse: 'ba' to: #($b $a).
+ node := PPCSequenceNode new
+ children: {
+ PPCPluggableNode new block: [ :ctx | ctx next ]; markForInline; yourself.
+ $a asParser asCompilerNode }.
+
+ self compileTree: node.
+
+ self assert: parser class methodDictionary size = 2.
+ self assert: parser parse: 'ba' to: #($b $a).
!
testLiteralNode
@@ -421,6 +492,54 @@
self assert: parser fail: 'boo'.
!
+testMappedActionNode1
+ node := ((#letter asParser , #letter asParser)
+ map:[:a :b | String with:a with:b ]) asCompilerTree.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+ self assert:parser fail:'a'.
+
+ "Created: / 02-06-2015 / 17:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2015 / 22:44:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 14:08:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testMappedActionNode2
+ node := ((#letter asParser , #letter asParser)
+ map:[:a :b | String with:a with:b ]) asCompilerTree.
+ node child markForInline.
+
+ self compileTree:node.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
+ self assert:parser fail:''.
+ self assert:parser fail:'a'.
+
+ "Created: / 04-06-2015 / 23:13:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 14:08:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testMappedActionNode3
+ node := PPCPlusNode new
+ child:
+ (PPCMappedActionNode new
+ block: [ :l | l asUppercase ];
+ child: #letter asParser asCompilerTree;
+ yourself);
+ yourself.
+
+ self compileTree:node.
+
+ self assert:parser parse:'abc' to:#($A $B $C).
+
+ "Created: / 15-06-2015 / 18:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testMessagePredicate
| messageNode |
messageNode := PPCMessagePredicateNode new
@@ -755,6 +874,48 @@
self assert: parser fail: 'ab'.
!
+testSequenceOptInlined1
+ | a b bOpt |
+
+ a := $a asParser asCompilerNode.
+ b := $b asParser asCompilerNode.
+ bOpt := PPCOptionalNode new
+ child: b ;
+ markForInline;
+ yourself.
+ node := PPCSequenceNode new
+ children: { a . bOpt };
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'ab' to: #($a $b ) end: 2.
+ self assert: parser parse: 'a' to: #( $a nil ) end: 1.
+
+ "Created: / 22-05-2015 / 11:47:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSequenceOptInlined2
+ | a b bOpt |
+
+ a := $a asParser asCompilerNode.
+ a markForInline.
+ b := $b asParser asCompilerNode.
+ b markForInline.
+ bOpt := PPCOptionalNode new
+ child: b ;
+ markForInline;
+ yourself.
+ node := PPCSequenceNode new
+ children: { a . bOpt };
+ yourself.
+ self compileTree: node.
+
+ self assert: parser parse: 'ab' to: #($a $b ) end: 2.
+ self assert: parser parse: 'a' to: #( $a nil ) end: 1.
+
+ "Created: / 22-05-2015 / 11:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testStarAnyNode
arguments cacheFirstFollow: false.
node := PPCStarAnyNode new