"{ 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 methodDictionary size = 4.
        
        self assert: parser parse: '1' to: $1.
        self assert: parser parse: 'a' to: $a.
        self assert: parser fail: '_'.

    "Modified: / 06-11-2014 / 00:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testCompileLiteral
        tree := PPCLiteralNode new
                literal: 'foo';
                yourself.
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 2.
        self assert: parser parse: 'foo'  to: 'foo'.
        self assert: parser parse: 'foobar'  to: 'foo' end: 3.
        self assert: parser fail: 'boo'.

    "Modified: / 06-11-2014 / 00:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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 methodDictionary 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.

    "Modified: / 06-11-2014 / 00:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testCompileNotLiteral
        tree := PPCNotLiteralNode new
                literal: 'foo';
                yourself.
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary 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.

    "Modified: / 06-11-2014 / 00:48:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testCompileNotMessagePredicate
        tree := PPCNotMessagePredicateNode new
                message: #isDigit;
                yourself.
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary 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.

    "Modified: / 06-11-2014 / 00:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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 methodDictionary 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.

    "Modified: / 06-11-2014 / 00:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testCompileStarMessagePredicate
        tree := PPCStarMessagePredicateNode new
                message: #isLetter;
                yourself.
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary 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.

    "Modified: / 06-11-2014 / 00:48:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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 methodDictionary 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.

    "Modified: / 06-11-2014 / 00:49:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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 methodDictionary size = 3.
        self assert: parser parse: '.a' to: #($. $a).

    "Modified: / 06-11-2014 / 01:12:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlineCharSetPredicate
        tree := PPCPlusNode new
                child: (PPCInlineCharSetPredicateNode new 
                        predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
                        yourself);
                yourself.
        
        parser := self compileTree: tree.

        self assert: parser class methodDictionary size = 2.
        self assert: parser parse: 'a'  to: #($a).
        self assert: parser fail: 'b'.

    "Modified: / 06-11-2014 / 01:12:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlineCharacter
        tree := PPCSequenceNode new
                children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }.
        
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 3.
        self assert: parser parse: 'ba' to: #($b $a).

    "Modified: / 06-11-2014 / 01:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlineLiteral
        tree := PPCSequenceNode new
                children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
        
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 3.
        self assert: parser parse: 'fooa' to: #('foo' $a).

    "Modified: / 06-11-2014 / 01:12:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlineNil
        tree := PPCSequenceNode new
                children: { PPCInlineNilNode new . $a asParser asCompilerNode }.
        
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 3.
        self assert: parser parse: 'a' to: #(nil $a).

    "Modified: / 06-11-2014 / 01:12:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlineNotLiteral
        tree := PPCSequenceNode new
                children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.
        
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 3.
        self assert: parser parse: 'a' to: #(nil $a).

    "Modified: / 06-11-2014 / 01:12:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testInlinePluggable
        tree := PPCSequenceNode new
                children: { PPCInlinePluggableNode new block: [ :ctx | tree. ctx next ]. $a asParser asCompilerNode }.
        
        parser := self compileTree: tree.
        
        self assert: parser class methodDictionary size = 3.
        self assert: parser parse: 'ba' to: #($b $a).

    "Modified: / 06-11-2014 / 01:20:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCNodeCompilingTest class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !