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

TestCase subclass:#PPCNodeTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Nodes'
!

PPCNodeTest comment:''
!

!PPCNodeTest methodsFor:'as yet unclassified'!

testCopy
	| n1 n2 |
	n1 := PPCDelegateNode new
		child: #foo;
		yourself.
	n2 := n1 copy.
	self assert: (n1 = n2).
	
	n2 child: #bar.
	self assert: (n1 = n2) not.
!

testCopy2
	| n1 n2 |
	n1 := PPCSequenceNode new
		children: (Array with: #foo with: #bar);
		yourself.
	n2 := n1 copy.
	self assert: (n1 = n2).
	
	n2 children at: 1 put: #zorg.
	self assert: (n1 = n2) not.
!

testEquals
	self assert: (PPCNode new = PPCNode new).
!

testEquals2
	| n1 n2 n3 |
	n1 := PPCDelegateNode new
		child: #foo;
		yourself.
	n2 := PPCDelegateNode new
		child: #bar;
		yourself.
	n3 := PPCDelegateNode new
		child: #foo;
		yourself.
		
	self assert: (n1 = n3).
	self assert: (n1 = n2) not.
! !

!PPCNodeTest methodsFor:'test support'!

assert: object type: class
	self assert: object class == class
! !

!PPCNodeTest methodsFor:'tests - converting'!

testConvertBlock
	| parser tree |
	parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCPluggableNode.
	self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
!

testConvertChoice
	| parser tree |
	parser := 'foo' asParser / $b asParser.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCChoiceNode.
	self assert: tree children size = 2.
	self assert: tree children first type: PPCLiteralNode.
	self assert: tree children second type: PPCCharacterNode.
!

testConvertNil
	| parser tree |
	parser := nil asParser.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCNilNode.
!

testConvertSequence
	| parser tree |
	parser := 'foo' asParser, $b asParser.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCSequenceNode.
	self assert: tree children size = 2.
	self assert: tree children first type: PPCLiteralNode.
	self assert: tree children second type: PPCCharacterNode.
!

testConvertToken
	| parser tree |
	parser := 'foo' asParser token.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCTokenNode.
	self assert: tree child type: PPCLiteralNode.

	parser := ('foo' asParser, $b asParser) token.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCTokenNode.
	self assert: tree child type: PPCSequenceNode.
	
	parser := $d asParser token star.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCStarNode.
	self assert: tree child type: PPCTokenNode.
	self assert: tree child child type: PPCCharacterNode.
!

testConvertTrimmingToken
	| parser tree |
	parser := 'foo' asParser trimmingToken.
	tree := parser asCompilerTree optimizeTree.
	
	self assert: tree type: PPCTrimmingTokenNode.
	self assert: tree child type: PPCInlineLiteralNode.
	self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).

	parser := ('foo' asParser, $b asParser) trimmingToken.
	tree := parser asCompilerTree optimizeTree.
	
	self assert: tree type: PPCTrimmingTokenNode.
	self assert: tree child type: PPCTokenSequenceNode.
	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.
	
	parser := $d asParser trimmingToken star.
	tree := parser asCompilerTree optimizeTree.
	
	self assert: tree type: PPCStarNode.
	self assert: tree child type: PPCTrimmingTokenNode.
	self assert: tree child child type: PPCInlineCharacterNode.
! !

!PPCNodeTest methodsFor:'tests - epsilon'!

testActionAcceptsEpsilon
	| tree |
	tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
	self assert: tree acceptsEpsilon.
!

testChoiceAcceptsEpsilon
	| tree |
	tree := ($a asParser / $b asParser star) asCompilerTree.
	self assert: tree acceptsEpsilon.
!

testLiteralAcceptsEpsilon
	| tree |
	tree := 'foo' asParser asCompilerTree.
	self assert: tree acceptsEpsilon not.
	
	tree := '' asParser asCompilerTree.
	self assert: tree acceptsEpsilon.
!

testPlusAcceptsEpsilon
	| tree |
	tree := ($b asParser plus) asCompilerTree.
	self assert: tree acceptsEpsilon not.
	
	tree := #letter asParser plus asCompilerTree.
	self assert: tree acceptsEpsilon not.
!

testSequenceAcceptsEpsilon
	| tree parser |
	parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
	tree := parser asCompilerTree.
	self assert: tree acceptsEpsilon.
!

testStarAcceptsEpsilon
	| tree |
	tree := $b asParser star asCompilerTree.
	self assert: tree acceptsEpsilon.
!

testTokenAcceptsEpsilon
	| tree |
	tree := ($a asParser / $b asParser plus) token asCompilerTree.
	self assert: tree acceptsEpsilon not.
	
	tree := ($a asParser / $b asParser star) token asCompilerTree.
	self assert: tree acceptsEpsilon.
! !