"{ 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).
! !