--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOptimizingTest.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,257 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+TestCase subclass:#PPCOptimizingTest
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Nodes'
+!
+
+PPCOptimizingTest comment:''
+!
+
+!PPCOptimizingTest methodsFor:'test support'!
+
+assert: object type: class
+	self assert: object class == class
+!
+
+optimize: p
+	^ p asCompilerTree optimizeTree 
+! !
+
+!PPCOptimizingTest methodsFor:'tests'!
+
+testAnyPredicate
+	| tree |
+	tree := self optimize: #any asParser.
+	
+	self assert: tree type: PPCAnyNode.
+!
+
+testCharSetPredicate
+	| tree |
+	tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo).
+
+	self assert: tree type: PPCCharSetPredicateNode
+!
+
+testChoiceInlining
+	| tree |
+	tree := self optimize: $a asParser  / $b asParser.
+
+	self assert: tree type: PPCChoiceNode.
+	self assert: tree children first  type: PPCInlineCharacterNode.
+	self assert: tree children second type: PPCInlineCharacterNode.
+!
+
+testForwarding
+	| tree p1 p2 |
+	p2 := $a asParser.
+	p1 := p2 wrapped.
+	p1 name: 'p1'.
+	tree := self optimize: p1.
+
+	self assert: tree type: PPCCharacterNode.
+	self assert: tree name = 'p1'.
+	
+	p2 name: 'p2'.
+	tree := self optimize: p1.
+	self assert: tree type: PPCForwardNode.
+	self assert: tree name = 'p1'.
+	self assert: tree child name = 'p2'.
+!
+
+testInlineCharacter
+	| tree |
+	tree := self optimize: $a asParser plus.
+
+	self assert: tree type: PPCPlusNode.
+	self assert: tree child  type: PPCInlineCharacterNode.
+	self assert: tree child character = $a.
+!
+
+testInlineCharacter2
+	| tree |
+	tree := self optimize: $a asParser star.
+
+	self assert: tree type: PPCStarNode.
+	self assert: tree child  type: PPCInlineCharacterNode.
+	self assert: tree child character = $a.
+!
+
+testInlineCharacter3
+	| tree |
+	tree := self optimize: $a asParser, $b asParser.
+
+	self assert: tree type: PPCSequenceNode.
+	self assert: tree children first type: PPCInlineCharacterNode.
+	self assert: tree children first character = $a.
+	self assert: tree children second type: PPCInlineCharacterNode.
+	self assert: tree children second character = $b.	
+!
+
+testInlineNil
+	| tree |
+	tree := self optimize: nil asParser star.
+
+	self assert: tree type: PPCStarNode.
+	self assert: tree child type: PPCInlineNilNode.
+!
+
+testInlineNotLiteral
+	| tree |
+	tree := self optimize: 'foo' asParser not star.
+
+	self assert: tree type: PPCStarNode.
+	self assert: tree child type: PPCInlineNotLiteralNode.
+	self assert: tree child literal = 'foo'.
+!
+
+testInlineNotPredicate
+	| tree |
+	tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo) not).
+
+	self assert: tree type: PPCSequenceNode.
+	self assert: tree children first type: PPCInlineNotMessagePredicateNode.
+	self assert: tree children second type: PPCInlineNotCharSetPredicateNode.
+!
+
+testInlinePluggable
+	| tree |
+	tree := self optimize: [:ctx | nil] asParser star.
+
+	self assert: tree type: PPCStarNode.
+	self assert: tree child type: PPCInlinePluggableNode.
+!
+
+testInlinePredicate
+	| tree |
+	tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo)).
+
+	self assert: tree type: PPCSequenceNode.
+	self assert: tree children first type: PPCInlineMessagePredicateNode.
+	self assert: tree children second type: PPCInlineCharSetPredicateNode.
+!
+
+testLetterPredicate
+	| tree |
+	tree := self optimize: #letter asParser.
+
+	self assert: tree type: PPCMessagePredicateNode.
+	self assert: tree message = #isLetter.
+!
+
+testNotCharSetPredicate
+	| tree |
+	tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not.
+
+	self assert: tree type: PPCNotCharSetPredicateNode.
+!
+
+testNotLiteral
+	| tree |
+	tree := self optimize: 'foo' asParser not.
+
+	self assert: tree type: PPCNotLiteralNode.
+	self assert: tree literal = 'foo'.
+!
+
+testNotMessagePredicate
+	| tree |
+	tree := self optimize: #letter asParser not.
+
+	self assert: tree type: PPCNotMessagePredicateNode.
+!
+
+testStarAny
+	| tree |
+	tree := self optimize: #any asParser star.
+
+	self assert: tree type: PPCStarAnyNode.
+!
+
+testStarCharSetPredicate
+	| tree |
+	tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) star.
+
+	self assert: tree type: PPCStarCharSetPredicateNode
+!
+
+testStarMessagePredicate
+	| tree |
+	tree := self optimize: #letter asParser star.
+
+	self assert: tree type: PPCStarMessagePredicateNode.
+!
+
+testSymbolAction
+	| tree |
+	tree := self optimize: (#letter asParser) ==> #second.
+
+	self assert: tree type: PPCSymbolActionNode.
+
+	tree := self optimize: (#letter asParser) ==> [:e | e second ].
+	self assert: tree type: PPCActionNode.
+!
+
+testToken
+	| tree |
+	tree := self optimize: ((#letter asParser, #word asParser star) token).
+
+	self assert: tree type: PPCTokenNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+	self assert: tree child children size = 2.
+	self assert: tree child children first type: PPCInlineMessagePredicateNode.
+	self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	
+!
+
+testTokenSequence
+	| tree |
+	tree := self optimize: ($a asParser, $b asParser) token.
+
+	self assert: tree type: PPCTokenNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+	
+	tree := self optimize: ($a asParser, $b asParser) trimmingToken.
+
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+!
+
+testTrimmingToken
+	| tree |
+	tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
+
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+	self assert: tree child children size = 2.
+	self assert: tree child children first type: PPCInlineMessagePredicateNode.
+	self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	
+!
+
+testTrimmingToken2
+	| parser tree |
+	parser := 'foo' asParser trimmingToken.
+	tree := parser asCompilerTree optimizeTree.
+	
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree child type: PPCInlineLiteralNode.
+	self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
+
+	parser := ('foo' asParser, $b asParser) trimmingToken.
+	tree := parser asCompilerTree optimizeTree.
+	
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.
+	
+	parser := $d asParser trimmingToken star.
+	tree := parser asCompilerTree optimizeTree.
+	
+	self assert: tree type: PPCStarNode.
+	self assert: tree child type: PPCTrimmingTokenNode.
+	self assert: tree child child type: PPCInlineCharacterNode.
+! !
+