Mercurial Mercurial > hg > stx-goodies-petitparser / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
compiler/tests/PPCUniversalOptimizationTest.st
changeset 464 f6d77fee9811
child 529 439c4057517f 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCUniversalOptimizationTest.st	Thu May 21 14:12:22 2015 +0100
@@ -0,0 +1,360 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCUniversalOptimizationTest
+	instanceVariableNames:'configuration'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Core-Universal'
+!
+
+!PPCUniversalOptimizationTest methodsFor:'test support'!
+
+assert: object type: class
+    self assert: (object isKindOf: class)
+!
+
+optimize: aPPParser
+    ^ aPPParser compileWithConfiguration: configuration.
+!
+
+setUp
+    super setUp.
+    
+    configuration := PPCUniversalConfiguration new.
+    configuration arguments generate: false.
+    
+"	^ configuration := PPCPluggableConfiguration on:
+        [ :_self |
+            _self toPPCIr.
+            _self createTokens.
+            _self specialize.
+            _self createRecognizingComponents.
+            _self inline.
+            _self merge.		
+        ]"
+! !
+
+!PPCUniversalOptimizationTest 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: 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: 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: / 10-05-2015 / 07:30:58 / 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: PPCRecognizingSequenceNode.
+!
+
+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: PPCRecognizingSequenceNode.
+!
+
+testRecognizingSequence2
+    | tree |
+    tree := self optimize: ($a asParser, $b asParser) token.
+
+    self assert: tree type: PPCTokenNode.
+    self assert: tree child type: PPCRecognizingSequenceNode.
+    
+    tree := self optimize: ($a asParser, $b asParser) trimmingToken.
+
+    self assert: tree type: PPCTrimmingTokenNode.
+    self assert: tree child type: PPCRecognizingSequenceNode.
+!
+
+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.
+
+    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: PPCRecognizingSequenceNode.
+    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: PPCRecognizingSequenceNode.
+    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.
+    
+!
+
+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: PPCRecognizingSequenceNode.
+    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 := self optimize: parser.
+    
+    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 := self optimize: parser.
+    
+    self assert: tree type: PPCTrimmingTokenNode.
+    self assert: tree child type: PPCRecognizingSequenceNode.
+    self assert: tree whitespace type: PPCTokenStarSeparatorNode.
+    self assert: tree whitespace isMarkedForInline.
+    
+    parser := $d asParser trimmingToken star.
+    tree := self optimize: parser.
+    
+    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 := self optimize: parser.
+    
+    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: PPCRecognizingSequenceNode.
+    self assert: tree children second children first type: PPCNotLiteralNode.
+    self assert: tree children second children first isMarkedForInline.
+! !
+
hg/stx-goodies-petitparser