compiler/tests/PPCOptimizingTest.st
changeset 421 7e08b31e0dae
parent 418 b3080b20b14c
child 422 116d2b2af905
--- a/compiler/tests/PPCOptimizingTest.st	Wed Nov 19 10:52:37 2014 +0000
+++ b/compiler/tests/PPCOptimizingTest.st	Mon Nov 24 00:09:23 2014 +0000
@@ -15,7 +15,11 @@
 !
 
 optimize: p
-	^ p asCompilerTree optimizeTree 
+	^ self optimize: p parameters: #()
+!
+
+optimize: p parameters: parameters
+	^ p asCompilerTree optimizeTree: parameters 
 ! !
 
 !PPCOptimizingTest methodsFor:'tests'!
@@ -116,20 +120,11 @@
 !
 
 testInlinePluggable
-        | tree |
-        tree := self optimize: [:ctx | nil] asParser star.
+	| tree |
+	tree := self optimize: [:ctx | nil] asParser star.
 
-        self assert: tree type: PPCStarNode.
-        "Sadly, on Smalltalk/X blocks cannot be inlined because
-         the VM does not provide enough information to map
-         it back to source code. Very bad indeed!!"
-        ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
-                self assert: tree child type: PPCPluggableNode.
-        ] ifFalse:[ 
-                self assert: tree child type: PPCInlinePluggableNode.
-        ]
-
-    "Modified: / 08-11-2014 / 00:57:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	self assert: tree type: PPCStarNode.
+	self assert: tree child type: PPCInlinePluggableNode.
 !
 
 testInlinePredicate
@@ -149,6 +144,14 @@
 	self assert: tree message = #isLetter.
 !
 
+testNotAction
+	| tree |
+	tree := self optimize: (($f asParser, $o asParser) ==> #second) not.
+
+	self assert: tree type: PPCNotNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+!
+
 testNotCharSetPredicate
 	| tree |
 	tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not.
@@ -171,6 +174,14 @@
 	self assert: tree type: PPCNotMessagePredicateNode.
 !
 
+testNotSequence
+	| tree |
+	tree := self optimize: ($f asParser, $o asParser) not.
+
+	self assert: tree type: PPCNotNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+!
+
 testStarAny
 	| tree |
 	tree := self optimize: #any asParser star.
@@ -192,6 +203,23 @@
 	self assert: tree type: PPCStarMessagePredicateNode.
 !
 
+testStarSeparator
+	| tree |
+	tree := self optimize: #space asParser star trimmingToken parameters: { #inline -> false }.
+
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree child type: PPCTokenStarSeparatorNode.
+!
+
+testStarSeparator2
+	| tree |
+	tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.
+
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree child type: PPCTokenSequenceNode.
+	self assert: tree child children first type: PPCInlineTokenStarSeparatorNode.
+!
+
 testSymbolAction
 	| tree |
 	tree := self optimize: (#letter asParser) ==> #second.
@@ -210,7 +238,7 @@
 	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.	
+	self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.	
 !
 
 testTokenSequence
@@ -231,11 +259,11 @@
 	tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
 
 	self assert: tree type: PPCTrimmingTokenNode.
-	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.
+	self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
 	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.	
+	self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.	
 !
 
 testTrimmingToken2
@@ -252,7 +280,7 @@
 	
 	self assert: tree type: PPCTrimmingTokenNode.
 	self assert: tree child type: PPCTokenSequenceNode.
-	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.
+	self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
 	
 	parser := $d asParser trimmingToken star.
 	tree := parser asCompilerTree optimizeTree.
@@ -260,6 +288,27 @@
 	self assert: tree type: PPCStarNode.
 	self assert: tree child type: PPCTrimmingTokenNode.
 	self assert: tree child child type: PPCInlineCharacterNode.
+!
+
+testTrimmingToken3
+	| parser tree |
+	parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').
+	tree := parser asCompilerTree optimizeTree.
+	
+	self assert: tree type: PPCSequenceNode.
+	self assert: tree children first type: PPCTrimmingTokenNode.
+	self assert: tree children second type: PPCTrimmingTokenNode.
+!
+
+testTrimmingTokenNested
+	| parser tree foo|
+	foo := 'foo' asParser trimmingToken name: 'foo'.
+	parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.
+	tree := self optimize: parser.
+	
+	self assert: tree type: PPCTrimmingTokenNode.
+	self assert: tree children second type: PPCTokenSequenceNode.
+	self assert: tree children second children first type: PPCInlineNotLiteralNode.
 ! !
 
 !PPCOptimizingTest class methodsFor:'documentation'!