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

! !