"{ Package: 'stx:goodies/petitparser/compiler/tests' }"

"{ NameSpace: Smalltalk }"

PPAbstractParserTest subclass:#PPCCompilerTest

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Tests-Core'

!

assert: p parse: whatever

	^ result := super assert: p parse: whatever.

!

!

!

tearDown

	| parserClass |

	parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).

	parserClass notNil ifTrue:[ 

		parserClass removeFromSystem

	].

! !

!PPCCompilerTest methodsFor:'tests - first set'!

testFirstSetSuchThat

	| a b fs at |

	a := $a asParser.

	at := a trim.

	b := $b asParser.

	parser := b optional, at.

	fs :=	parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal  ] ].

	self assert: (fs anySatisfy: [ :e | e = at ]).

	self assert: (fs anySatisfy: [ :e | e = b ]).

	self assert: (fs noneSatisfy: [ :e | e = a ]).	

!

testFirstSetSuchThat2

	| a b fs at bt |

	a := $a asParser optional.

	at := a trim.

	b := $b asParser.

	bt := b trim.

	parser := at, bt.

	fs :=	parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal  ] ].

	self assert: (fs anySatisfy: [ :e | e = at ]).

	self assert: (fs anySatisfy: [ :e | e = bt ]).

	self assert: fs size = 2.

!

testFirstSetSuchThat3

	| a b c fs at bt ct |

	a := $a asParser optional.

	at := a trim.

	b := $b asParser.

	bt := b trim.

	c := $c asParser.

	ct := c trim.

	parser := (at, bt optional) wrapped, at, ct.

	fs :=	parser firstSetSuchThat: [ :e | (e isKindOf: PPTrimmingParser) or: [ e isTerminal  ] ].

	self assert: (fs anySatisfy: [ :e | e = at ]).

	self assert: (fs anySatisfy: [ :e | e = bt ]).

	self assert: (fs anySatisfy: [ :e | e = ct ]).

	self assert: fs size = 3.

! !

!PPCCompilerTest methodsFor:'tests - guard'!

testChoiceGuard

	parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus) 

	self assert: parser parse: 'foo'.

	self assert: result inputValue = 'foo'.	

	self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).

	self assert: parser parse: 'bar'.

	self assert: result inputValue = 'bar'.	

	self assert: parser parse: ' foo'.

	self assert: result inputValue = 'foo'.	

	self assert: parser parse: '  d'.

	self assert: result first inputValue = 'd'.	

	self assert: parser fail: ''.

	self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'predicate' ]).

	self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).

	self assert: parser fail: 'zorg'.		

	self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).

!

testEmptyChoiceGuard

	parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star) 

	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: '  d'.

	self assert: result first inputValue = 'd'.	

	self assert: parser parse: ''.

	self assert: parser parse: 'zorg' end: 0.	

!

testGuardSmalltlakToken

	self assert: parser parse: 'bar'.

	self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]).

	self assert: parser fail: '123'.

	self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'seq' ]).

!

testSequenceGuard

	self assert: parser parse: 'fooo' to: #(#($f $o) #($o $o)).	

	self assert: parser parse: 'fo oo' to: #(#($f $o) #($  $o)) end: 4.	

	self assert: parser fail: 'fo'.

!

testTrimmerGuard

	self assert: parser parse: 'ab'.

	self assert: parser parse: ' ab'.

! !

!PPCCompilerTest class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !