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

"{ NameSpace: Smalltalk }"

TestCase subclass:#PPCTokenDetectorTest
	instanceVariableNames:'node result visitor'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Visitors'
!

!PPCTokenDetectorTest methodsFor:'as yet unclassified'!

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

setUp
	visitor := PPCTokenDetector new.
!

testActionNode
	| seq characterNode1 characterNode2 tokenNode |
	characterNode1 := PPCCharacterNode new.
	characterNode2 := PPCCharacterNode new.
	
	seq := PPCSequenceNode new
		children: { characterNode1 . characterNode1 };
		yourself.
	tokenNode := PPCTokenNode new
		child: seq;
		yourself.
		
	node := PPCActionNode new
		child: tokenNode;
		yourself.
	
		
	result := visitor visit: node.
	
	self assert: result type: PPCActionNode.
	self assert: result child type: PPCTokenNode.	
	self assert: result child child type: PPCTokenSequenceNode.	

	self assert: result == node.
	self assert: (result child child firstChild == characterNode1) not.
	self assert: (result child child firstChild = characterNode1).
	self assert: (result child child secondChild == characterNode1) not.
	self assert: (result child child secondChild = characterNode1).
	
!

testNestedTrimmingToken
	| characterNode token ws seq trimmingToken |
	characterNode := PPCCharacterNode new.
	token := PPCTokenNode new 
		child: characterNode;
		tokenClass: #foo;
		yourself.
	ws := PPCSentinelNode new.
	seq := PPCSequenceNode new
		children: { ws . token . ws };
		yourself.
	trimmingToken := PPCActionNode new
		child: seq;
		propertyAt: #trimmingToken put: true;
		yourself.

	node := PPCSequenceNode new
		children: { characterNode . trimmingToken  };
		yourself.
	
	result := visitor visit: node.
	
	self assert: result type: PPCSequenceNode.
	self assert: result firstChild == characterNode.
	
	self assert: result secondChild type: PPCTrimmingTokenNode.	
	self assert: result secondChild child = characterNode.	
	self assert: (result secondChild child == characterNode) not.		
!

testNestedTrimmingToken2
	| characterNode token1 ws seq1 seq2 seqWithToken trimmingToken1 token2 |
	characterNode := PPCCharacterNode new.
	ws := PPCSentinelNode new.

	token1 := PPCTokenNode new 
		child: characterNode;
		tokenClass: #foo;
		yourself.
	seq1 := PPCSequenceNode new
		children: { ws . token1 . ws };
		yourself.
	trimmingToken1 := PPCActionNode new
		child: seq1;
		propertyAt: #trimmingToken put: true;
		yourself.
	
	seqWithToken := PPCSequenceNode new
		children: { characterNode . trimmingToken1  };
		yourself.
	
	token2 := PPCTokenNode new 
		child: seqWithToken;
		tokenClass: #bar;
		yourself.
	seq2 := PPCSequenceNode new
		children: { ws . token2 . ws };
		yourself.		
	node := PPCActionNode new
		child: seq2;
		propertyAt: #trimmingToken put: true;
		yourself.
	result := visitor visit: node.
	
	self assert: result type: PPCTrimmingTokenNode .
	self assert: result child type: PPCTokenSequenceNode.
!

testNestedTrimmingToken3
	|         trueToken falseToken booleanLiteral literal abc notBoolean id idSeq javaToken resultId resultBooleanLiteral resultIdBooleanLiteral |
	"
	 This USE case is based on JavaToken
	
	 javaToken := id / literal
	 id := (not booleanLiteral, 'abc') token
	 literal := booleanLiteral
	 booleanLiteral := 'true' token / 'false' token
	"
	trueToken := 'true' asParser token asCompilerTree.
	falseToken := 'false' asParser token asCompilerTree.
	abc := 'abc' asParser asCompilerTree.
	
	booleanLiteral := PPCChoiceNode new
		children: { trueToken . falseToken }; yourself.

	literal := PPCForwardNode new
		name: #literal;
		child: booleanLiteral; yourself.
	notBoolean := PPCNotNode new
		child: booleanLiteral; yourself.
	idSeq := PPCSequenceNode new
		children: { notBoolean . abc }; yourself.
	id := PPCTokenNode new
		child: idSeq; yourself.
	javaToken := PPCChoiceNode new
		children: { id . literal }; yourself.
		
	result := visitor visit: javaToken.	
	resultId := result firstChild.
	resultBooleanLiteral := result secondChild child.	
	resultIdBooleanLiteral := resultId child firstChild  child.	
		
		
		
	self assert: result type: PPCChoiceNode.
	self assert: resultId type: PPCTokenNode.
	self assert: resultBooleanLiteral type: PPCChoiceNode.
	
	self assert: resultIdBooleanLiteral firstChild type: PPCLiteralNode.
	self assert: resultIdBooleanLiteral secondChild type: PPCLiteralNode.
	
	self assert: resultBooleanLiteral firstChild type: PPCTokenNode.
	self assert: resultBooleanLiteral secondChild type: PPCTokenNode.
	
	
!

testNodeCopy
	| nilNode forwardNode |
	nilNode := PPCNilNode new.
	forwardNode := PPCForwardNode new
		child: nilNode;
		yourself.
	node := PPCTokenNode new
		child: forwardNode;
		yourself.
	
	result := visitor visit: node.
	
	self assert: (result == node).
	self assert: result child = forwardNode.
	self assert: (result child == forwardNode) not.
	self assert: (result child child = nilNode).
	self assert: (result child child == nilNode) not.
!

testTokenSequence1
	| seq characterNode1 characterNode2 |
	characterNode1 := PPCCharacterNode new.
	characterNode2 := PPCCharacterNode new.
	
	seq := PPCSequenceNode new
		children: { characterNode1 . characterNode1 };
		yourself.
	node := PPCTokenNode new
		child: seq;
		yourself.
	
		
	result := visitor visit: node.
	
	self assert: result type: PPCTokenNode.
	self assert: result child type: PPCTokenSequenceNode.	

	self assert: result == node.
	self assert: (result child firstChild == characterNode1) not.
	self assert: (result child firstChild = characterNode1).
	self assert: (result child secondChild == characterNode1) not.
	self assert: (result child secondChild = characterNode1).
	
!

testTrimmingToken
	| seq characterNode ws token |
	characterNode := PPCCharacterNode new.
	token := PPCTokenNode new 
		child: characterNode;
		tokenClass: #foo;
		yourself.
	ws := PPCSentinelNode new.
	
	seq := PPCSequenceNode new
		children: { ws . token . ws };
		yourself.
	node := PPCActionNode new
		child: seq;
		propertyAt: #trimmingToken put: true;
		yourself.
		
	result := visitor visit: node.
	
	self assert: result type: PPCTrimmingTokenNode.
	self assert: result child type: PPCCharacterNode.
	self assert: result child = characterNode.
	self assert: (result child == characterNode) not.	
! !