--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCNodeCompilingTest.st Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,482 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+PPAbstractParserTest subclass:#PPCNodeCompilingTest
+ instanceVariableNames:'parser context tree result'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Nodes'
+!
+
+!PPCNodeCompilingTest methodsFor:'context'!
+
+context
+ ^ context := PPCProfilingContext new
+! !
+
+!PPCNodeCompilingTest methodsFor:'test support'!
+
+assert: whatever parse: input
+ result := super assert: whatever parse: input.
+!
+
+compileTree: root
+ ^ self compileTree: root params: #()
+!
+
+compileTree: root params: params
+ | compiler mock |
+ compiler := PPCCompiler new.
+ compiler profile: true.
+ mock := nil asParser.
+ ^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new.
+! !
+
+!PPCNodeCompilingTest methodsFor:'tests - compiling'!
+
+testCompileAction
+ tree := PPCActionNode new
+ block: [ :res | res collect: [:each | each asUppercase ]];
+ child: #letter asParser plus asCompilerTree;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'foo' to: { $F . $O . $O}.
+ self assert: parser parse: 'bar' to: { $B . $A . $R}.
+ self assert: parser fail: ''.
+!
+
+testCompileAnd
+ tree := PPCAndNode new
+ child: #digit asParser asCompilerNode;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: '1' to: $1 end: 0.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: ''.
+!
+
+testCompileAny
+ tree := PPCAnyNode new.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '_' to: $_.
+ self assert: parser parse: '
+' to: Character cr.
+!
+
+testCompileCharSetPredicate
+ tree := PPCCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+!
+
+testCompileCharacter
+ tree := PPCCharacterNode new character: $a; yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+
+ parser := self compileTree: (PPCCharacterNode new character: $#; yourself).
+ self assert: parser parse: '#'.
+
+ parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself).
+ self assert: parser parse: String lf.
+!
+
+testCompileChoice
+ tree := PPCChoiceNode new
+ children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };
+ yourself.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 4.
+
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: '_'.
+!
+
+testCompileLiteral
+ tree := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'foo' to: 'foo'.
+ self assert: parser parse: 'foobar' to: 'foo' end: 3.
+ self assert: parser fail: 'boo'.
+!
+
+testCompileLiteral2
+ | |
+
+ tree := PPCLiteralNode new
+ literal: '''''';
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: '''''' to: ''''''.
+!
+
+testCompileNil
+ tree := PPCNilNode new.
+
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompileNot
+ tree := PPCNotNode new
+ child: #digit asParser asCompilerNode;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompileNotCharSetPredicate
+ tree := PPCNotCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'a'.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompileNotLiteral
+ tree := PPCNotLiteralNode new
+ literal: 'foo';
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'bar' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: 'foo'.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompileNotMessagePredicate
+ tree := PPCNotMessagePredicateNode new
+ message: #isDigit;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: context invocationCount = 2.
+
+ self assert: parser fail: '1'.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompileOptional
+ tree := PPCOptionalNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: '' to: nil end: 0.
+!
+
+testCompilePluggable
+ tree := PPCPluggableNode new
+ block: [:ctx | ctx next ];
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'foo' to: $f end: 1.
+ self assert: parser parse: 'bar' to: $b end: 1.
+ self assert: parser parse: '' to: nil.
+!
+
+testCompilePlus
+ tree := PPCPlusNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
+ self assert: parser parse: 'ab' to: #( $a ) end: 1.
+ self assert: parser fail: 'b'.
+!
+
+testCompileSequence
+ tree := PPCSequenceNode new
+ children: { $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode }
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'abc' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3.
+ self assert: parser fail: 'ab'.
+!
+
+testCompileStar
+ tree := PPCStarNode new
+ child: ($a asParser asCompilerNode);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.
+ self assert: parser parse: 'ab' to: #( $a ) end: 1.
+ self assert: parser parse: 'b' to: #( ) end: 0.
+!
+
+testCompileStarAny
+ tree := PPCStarAnyNode new.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'abc' to: #($a $b $c).
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: '' to: #().
+!
+
+testCompileStarCharSetPredicate
+ tree := PPCStarCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [:e | e = $a ]);
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.
+ self assert: context invocationCount = 2.
+ self assert: parser parse: 'bba' to: #() end: 0.
+ self assert: context invocationCount = 2.
+
+!
+
+testCompileStarMessagePredicate
+ tree := PPCStarMessagePredicateNode new
+ message: #isLetter;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.
+ self assert: context invocationCount = 2.
+
+ self assert: parser parse: '123a' to: #() end: 0.
+ self assert: context invocationCount = 2.
+
+!
+
+testCompileSymbolAction
+ tree := PPCSymbolActionNode new
+ block: #second;
+ child: #letter asParser plus asCompilerTree;
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'foo' to: $o.
+ self assert: parser parse: 'bar' to: $a.
+ self assert: parser fail: ''.
+!
+
+testCompileToken
+ tree := PPCTokenNode new
+ child: #letter asParser plus asCompilerTree;
+ tokenClass: PPToken;
+ yourself.
+
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'abc'.
+ self assert: result class = PPToken.
+ self assert: result inputValue = 'abc'.
+
+ self assert: parser fail: '1a'.
+!
+
+testCompileTokenSequence
+ tree := PPCTokenSequenceNode new.
+ tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser parse: '1a' to: parser.
+ self assert: context rememberCount = 0.
+ self assert: context lwRememberCount = 1.
+ self assert: context restoreCount = 0.
+ self assert: context lwRestoreCount = 0.
+
+ self assert: parser parse: '1ab' to: parser end: 2.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+
+ self assert: parser fail: 'a1'.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+
+ self assert: parser fail: 'aa'.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 0.
+
+ self assert: parser fail: '11'.
+ self assert: context lwRememberCount = 1.
+ self assert: context lwRestoreCount = 1.
+
+!
+
+testCompileTokenStarMessagePredicate
+
+ tree := PPCTokenStarMessagePredicateNode new message: #isLetter.
+ parser := self compileTree: tree params: {#guards -> false}.
+
+ self assert: parser class methods size = 2.
+
+ self assert: parser parse: 'foo' to: parser.
+ self assert: context invocationCount = 2.
+ self assert: context lwRememberCount = 0.
+ self assert: context lwRestoreCount = 0.
+ self assert: context rememberCount = 0.
+
+ self assert: parser parse: 'foo123' to: parser end: 3.
+! !
+
+!PPCNodeCompilingTest methodsFor:'tests - guard'!
+
+testSequenceTokenGuard
+
+ tree := PPCSequenceNode new
+ children: {
+ 'foo' asParser trimmingToken asCompilerTree optimizeTree.
+ 'bar' asParser trimmingToken asCompilerTree optimizeTree.
+ }
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser parse: ' foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser fail: ' foo'.
+!
+
+testTrimmingTokenGuard
+
+ tree := PPCChoiceNode new
+ children: {
+ 'foo' asParser trimmingToken asCompilerTree optimizeTree.
+ 'bar' asParser trimmingToken asCompilerTree optimizeTree
+ }
+ yourself.
+ parser := self compileTree: tree.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: ' bar'.
+ self assert: result inputValue = 'bar'.
+
+ self assert: parser fail: 'zorg'.
+ self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+! !
+
+!PPCNodeCompilingTest methodsFor:'tests - inlining'!
+
+testInlineAny
+ tree := PPCSequenceNode new
+ children: { PPCInlineAnyNode new. $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: '.a' to: #($. $a).
+!
+
+testInlineCharSetPredicate
+ tree := PPCPlusNode new
+ child: (PPCInlineCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself);
+ yourself.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 2.
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser fail: 'b'.
+!
+
+testInlineCharacter
+ tree := PPCSequenceNode new
+ children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: 'ba' to: #($b $a).
+!
+
+testInlineLiteral
+ tree := PPCSequenceNode new
+ children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: 'fooa' to: #('foo' $a).
+!
+
+testInlineNil
+ tree := PPCSequenceNode new
+ children: { PPCInlineNilNode new . $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: 'a' to: #(nil $a).
+!
+
+testInlineNotLiteral
+ tree := PPCSequenceNode new
+ children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: 'a' to: #(nil $a).
+!
+
+testInlinePluggable
+ tree := PPCSequenceNode new
+ children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }.
+
+ parser := self compileTree: tree.
+
+ self assert: parser class methods size = 3.
+ self assert: parser parse: 'ba' to: #($b $a).
+! !
+