--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCTokenVisitorTest.st	Thu Apr 30 23:43:14 2015 +0200
@@ -0,0 +1,194 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCTokenVisitorTest
+	instanceVariableNames:'node result visitor'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCTokenVisitorTest methodsFor:'as yet unclassified'!
+
+asNode: aPPParser
+	self error: 'deprecated'.
+	^ aPPParser asCompilerTree
+!
+
+assert: object type: class
+	self assert: object class == class
+!
+
+setUp
+	visitor := PPCTokenVisitor new.
+!
+
+testAction
+	| letterNode |
+	letterNode := PPCMessagePredicateNode new
+		message: #isLetter;
+		yourself.
+	
+	node := PPCActionNode new
+		block: [ :nodes | #foo ];
+		child: letterNode;
+		yourself.
+		
+	result := visitor visit: node.
+	self assert: result type: PPCMessagePredicateNode.
+	self assert: result = letterNode.
+!
+
+testAction2
+	| letterNode actionNode |
+	
+	letterNode := PPCMessagePredicateNode new
+		predicate: #isLetter;
+		yourself.
+		
+	actionNode := PPCActionNode new
+		block:  #boo;
+		child: letterNode;
+		yourself.
+	
+	node := PPCTokenNode new
+		child: actionNode;
+		yourself.
+	
+	result := visitor visit: node.
+	
+	self assert: result type: PPCMessagePredicateNode.
+	self assert: result = letterNode.
+!
+
+testAction3
+	| letterNode actionNode |
+	
+	letterNode := PPCMessagePredicateNode new
+		predicate: #isLetter;
+		yourself.
+		
+	actionNode := PPCActionNode new
+		block: #foo;
+		child: letterNode;
+		yourself.
+	
+	node := PPCActionNode new
+		block: #foo;
+		child: actionNode;
+		yourself.
+	
+	result := visitor visit: node.
+	
+	self assert: result type: PPCMessagePredicateNode.
+	self assert: result = letterNode.
+!
+
+testNotAction
+	| literalNode actionNode |
+	literalNode := PPCLiteralNode new
+		literal: 'foo';
+		yourself.
+	
+	actionNode := PPCActionNode new
+		block: #foo;
+		child: literalNode;
+		yourself.
+	
+	node := PPCNotNode new
+		child: actionNode;
+		yourself.
+		
+	result := visitor visit: node.
+	
+	self assert: result type: PPCNotNode.
+	self assert: result child type: PPCLiteralNode.
+!
+
+testNotAction2
+	| literalNode actionNode seqNode |
+	literalNode := PPCLiteralNode new
+		literal: 'foo';
+		yourself.
+	
+	seqNode := PPCSequenceNode new
+		children: { literalNode . literalNode  };
+		yourself.
+	
+	actionNode := PPCActionNode new
+		block: #foo;
+		child: seqNode;
+		yourself.
+	
+	node := PPCNotNode new
+		child: actionNode;
+		yourself.
+		
+	result := visitor visit: node.
+	
+	self assert: result type: PPCNotNode.
+	
+	self assert: result child type: PPCTokenSequenceNode.
+	self assert: result child firstChild type: PPCLiteralNode.
+	self assert: result child secondChild type: PPCLiteralNode.	
+!
+
+testNotAction3
+	| literalNode actionNode seqNode |
+	literalNode := PPCLiteralNode new
+		literal: 'foo';
+		yourself.
+	
+	seqNode := PPCSequenceNode new
+		children: { literalNode . literalNode  };
+		yourself.
+	
+	actionNode := PPCSymbolActionNode new
+		symbol: #second;
+		child: seqNode;
+		yourself.
+	
+	node := PPCNotNode new
+		child: actionNode;
+		yourself.
+		
+	result := visitor visit: node.
+	
+	self assert: result type: PPCNotNode.
+	
+	self assert: result child type: PPCTokenSequenceNode.
+	self assert: result child firstChild type: PPCLiteralNode.
+	self assert: result child secondChild type: PPCLiteralNode.		
+!
+
+testStarMessagePredicate
+	| starNode |
+	starNode := PPCStarMessagePredicateNode new
+		message: #isLetter;
+		yourself.
+	
+	node := PPCTokenNode new
+		child: starNode;
+		yourself.
+	
+	result := visitor visit: node.
+	
+	self assert: result type: PPCTokenStarMessagePredicateNode.
+!
+
+testTokenSequence1
+	| letterNode1 letterNode2 |
+	letterNode1 := PPCCharacterNode new character: $a.
+	letterNode2 := PPCCharacterNode new character: $b.
+	
+	node := PPCSequenceNode new
+		children: { letterNode1 . letterNode2 };
+		yourself.
+	result := visitor visit: node.
+	
+	self assert: result type: PPCTokenSequenceNode.
+	self assert: result firstChild = letterNode1.
+	self assert: result secondChild = letterNode2.
+! !
+