--- a/compiler/tests/PPCOptimizingTest.st Tue May 05 16:25:23 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,355 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
-
-"{ NameSpace: Smalltalk }"
-
-TestCase subclass:#PPCOptimizingTest
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Tests-Nodes'
-!
-
-
-!PPCOptimizingTest methodsFor:'test support'!
-
-assert: object type: class
- self assert: (object isKindOf: class)
-!
-
-optimize: p
- ^ p asCompilerTree optimizeTree
-!
-
-optimize: p parameters: parameters
- ^ p asCompilerTree optimizeTree: parameters
-! !
-
-!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: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
-
-!
-
-testForwarding
- | tree p1 p2 |
- p2 := $a asParser.
- p1 := p2 wrapped.
- p1 name: 'p1'.
- tree := self optimize: p1.
-
- self assert: tree type: PPCAbstractCharacterNode.
- 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: PPCCharacterNode.
- self assert: tree child isMarkedForInline.
- self assert: tree child character = $a.
-!
-
-testInlineCharacter2
- | tree |
- tree := self optimize: $a asParser star.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCCharacterNode.
- self assert: tree child isMarkedForInline.
- 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: PPCCharacterNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children first character = $a.
- self assert: tree children second type: PPCCharacterNode.
- self assert: tree children second isMarkedForInline.
- 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: PPCNilNode.
- self assert: tree child isMarkedForInline.
-!
-
-testInlineNotLiteral
- | tree |
- tree := self optimize: 'foo' asParser not star.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCNotLiteralNode.
- self assert: tree child literal = 'foo'.
- self assert: tree child isMarkedForInline.
-!
-
-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: PPCNotMessagePredicateNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCNotCharSetPredicateNode.
- self assert: tree children second isMarkedForInline.
-
-!
-
-testInlinePluggable
- | tree |
- tree := self optimize: [:ctx | nil] asParser star.
-
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ])
- ifTrue:[ self skipIf: true description: 'not supported in St/X' ].
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCPluggableNode.
- self assert: tree child isMarkedForInline.
-
- "Modified: / 23-04-2015 / 12:19:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-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: PPCMessagePredicateNode.
- self assert: tree children first isMarkedForInline.
- self assert: tree children second type: PPCCharSetPredicateNode.
- self assert: tree children second isMarkedForInline.
-
-!
-
-testLetterPredicate
- | tree |
- tree := self optimize: #letter asParser.
-
- self assert: tree type: PPCMessagePredicateNode.
- 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.
-
- 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.
-!
-
-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.
-
- 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.
-!
-
-testStarSeparator
- | tree |
- tree := self optimize: #space asParser star trimmingToken parameters: { #rewrite . #token }.
-
- 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: PPCTokenStarSeparatorNode.
- self assert: tree child children first isMarkedForInline.
-!
-
-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: PPCMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
- self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
- self assert: tree child children second isMarkedForInline.
-
-!
-
-testTokenSequence2
- | 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: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
-
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree child children size = 2.
- self assert: tree child children first type: PPCMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
- self assert: tree child children second type: PPCTokenStarMessagePredicateNode.
- self assert: tree child children first isMarkedForInline.
-!
-
-testTrimmingToken2
- | parser tree |
- parser := 'foo' asParser trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCLiteralNode.
- self assert: tree child isMarkedForInline.
- 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: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
-
- 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: PPCCharacterNode.
- self assert: tree child child isMarkedForInline.
-!
-
-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: PPCNotLiteralNode.
- self assert: tree children second children first isMarkedForInline.
-! !
-
-!PPCOptimizingTest class methodsFor:'documentation'!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-! !
-