"{ 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

!

testCompileLiteral

!

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

!

testCompileNotLiteral

!

testCompileNotMessagePredicate

!

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

	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

!

testCompileStarMessagePredicate

!

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

! !

!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

!

testInlineCharSetPredicate

!

testInlineCharacter

!

testInlineLiteral

!

testInlineNil

!

testInlineNotLiteral

!

testInlinePluggable

! !

!PPCNodeCompilingTest class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !