--- 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'!