compiler/tests/PPCOptimizingVisitorTest.st
changeset 438 20598d7ce9fa
--- /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.	
+! !
+