diff -r 17ba167b8ee1 -r 553a5456963b compiler/tests/PPCNodeCompilingTest.st
--- /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).
+! !
+