--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOptimizingVisitorTest.st Thu Apr 30 23:43:14 2015 +0200
@@ -0,0 +1,155 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCOptimizingVisitorTest
+ instanceVariableNames:'node result visitor'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCOptimizingVisitorTest methodsFor:'as yet unclassified'!
+
+asNode: aPPParser
+ ^ aPPParser asCompilerTree
+!
+
+assert: object type: class
+ self assert: object class == class
+!
+
+setUp
+ visitor := PPCOptimizingVisitor new.
+!
+
+testAnyPredicate
+ node := self asNode: #any asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCAnyNode.
+!
+
+testIdentity
+ | token star1 star2 |
+ token := $a asParser token.
+ star1 := token star.
+ star2 := token star.
+ node := self asNode: star1, star2.
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode.
+ self assert: result children first type: PPCStarNode.
+ self assert: result children second type: PPCStarNode.
+!
+
+testNoOptimization
+ node := self asNode: 'foo' asParser.
+ self assert: node type: PPCLiteralNode.
+
+ result := visitor visit: node.
+ self assert: result type: PPCLiteralNode.
+!
+
+testNotCharSet
+ node := self asNode: #hex asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotCharSetPredicateNode.
+!
+
+testNotLiteral
+ node := self asNode: 'foo' asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotLiteralNode.
+ self assert: result literal = 'foo'.
+!
+
+testNotMessagePredicate
+ node := self asNode: #letter asParser not.
+ result := visitor visit: node.
+
+ self assert: result type: PPCNotMessagePredicateNode.
+!
+
+testPredicateNode01
+ node := self asNode: #letter asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isLetter.
+!
+
+testPredicateNode02
+ node := self asNode: #digit asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isDigit.
+!
+
+testPredicateNode03
+ node := self asNode: #space asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isSeparator.
+!
+
+testPredicateNode04
+ node := self asNode: #word asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCMessagePredicateNode.
+ self assert: result message = #isAlphaNumeric.
+!
+
+testPredicateNode05
+ node := self asNode: #hex asParser.
+ result := visitor visit: node.
+
+ self assert: result type: PPCCharSetPredicateNode.
+!
+
+testStarNode1
+ node := self asNode: #letter asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarMessagePredicateNode.
+ self assert: result message = #isLetter.
+!
+
+testStarNode2
+ node := self asNode: #any asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarAnyNode.
+!
+
+testStarNode3
+ node := self asNode: #hex asParser star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarCharSetPredicateNode.
+!
+
+testStarNode4
+ node := self asNode: #letter asParser not star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCStarNode.
+ self assert: result child type: PPCNotMessagePredicateNode.
+!
+
+testStarNode5
+ | star |
+ star := $a asParser not star.
+ node := self asNode: star, star.
+ result := visitor visit: node.
+
+ self assert: result type: PPCSequenceNode.
+ self assert: result children first type: PPCStarNode.
+ self assert: result children second type: PPCStarNode.
+! !
+