1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }"

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#PPCPrototype1OptimizingTest

     6 	instanceVariableNames:'configuration'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Tests-Core'

    10 !

    11 

    12 !PPCPrototype1OptimizingTest methodsFor:'test support'!

    13 

    14 assert: object type: class

    15     self assert: (object isKindOf: class)

    16 !

    17 

    18 optimize: aPPParser

    19     ^ aPPParser compileWithConfiguration: configuration.

    20 !

    21 

    22 setUp

    23     super setUp.

    24     

    25     configuration := PPCUniversalConfiguration new.

    26     configuration arguments generate: false.

    27     

    28 "	^ configuration := PPCPluggableConfiguration on:

    29         [ :_self |

    30             _self toPPCIr.

    31             _self createTokens.

    32             _self specialize.

    33             _self createRecognizingComponents.

    34             _self inline.

    35             _self merge.		

    36         ]"

    37 ! !

    38 

    39 !PPCPrototype1OptimizingTest methodsFor:'tests'!

    40 

    41 testAnyPredicate

    42     | tree |

    43     tree := self optimize: #any asParser.

    44     

    45     self assert: tree type: PPCAnyNode.

    46 !

    47 

    48 testCharSetPredicate

    49     | tree |

    50     tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo).

    51 

    52     self assert: tree type: PPCCharSetPredicateNode

    53 !

    54 

    55 testChoiceInlining

    56     | tree |

    57     tree := self optimize: $a asParser  / $b asParser.

    58 

    59     self assert: tree type: PPCChoiceNode.

    60     self assert: tree children first  type: PPCCharacterNode.

    61     self assert: tree children first isMarkedForInline.

    62     self assert: tree children second type: PPCCharacterNode.

    63     self assert: tree children first isMarkedForInline.

    64     

    65 !

    66 

    67 testForwarding

    68     | tree p1 p2 |

    69     p2 := $a asParser.

    70     p1 := p2 wrapped.

    71     p1 name: 'p1'.

    72     tree := self optimize: p1.

    73 

    74     self assert: tree type: PPCAbstractCharacterNode.

    75     self assert: tree name = 'p1'.

    76     

    77     p2 name: 'p2'.

    78     tree := self optimize: p1.

    79     self assert: tree type: PPCForwardNode.

    80     self assert: tree name = 'p1'.

    81     self assert: tree child name = 'p2'.

    82 !

    83 

    84 testInlineCharacter

    85     | tree |

    86     tree := self optimize: $a asParser plus.

    87 

    88     self assert: tree type: PPCPlusNode.

    89     self assert: tree child type: PPCCharacterNode.

    90     self assert: tree child isMarkedForInline.

    91     self assert: tree child character = $a.

    92 !

    93 

    94 testInlineCharacter2

    95     | tree |

    96     tree := self optimize: $a asParser star.

    97 

    98     self assert: tree type: PPCStarNode.

    99     self assert: tree child type: PPCCharacterNode.

   100     self assert: tree child isMarkedForInline.

   101     self assert: tree child character = $a.

   102 !

   103 

   104 testInlineCharacter3

   105     | tree |

   106     tree := self optimize: $a asParser, $b asParser.

   107 

   108     self assert: tree type: PPCSequenceNode.

   109     self assert: tree children first type: PPCCharacterNode.

   110     self assert: tree children first isMarkedForInline.

   111     self assert: tree children first character = $a.

   112     self assert: tree children second type: PPCCharacterNode.

   113     self assert: tree children second isMarkedForInline.

   114     self assert: tree children second character = $b.	

   115 !

   116 

   117 testInlineNil

   118     | tree |

   119     tree := self optimize: nil asParser star.

   120 

   121     self assert: tree type: PPCStarNode.

   122     self assert: tree child type: PPCNilNode.

   123     self assert: tree child isMarkedForInline.

   124 !

   125 

   126 testInlineNotLiteral

   127     | tree |

   128     tree := self optimize: 'foo' asParser not star.

   129 

   130     self assert: tree type: PPCStarNode.

   131     self assert: tree child type: PPCNotLiteralNode.

   132     self assert: tree child literal = 'foo'.

   133     self assert: tree child isMarkedForInline.

   134 !

   135 

   136 testInlineNotPredicate

   137     | tree |

   138     tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo) not).

   139 

   140     self assert: tree type: PPCSequenceNode.

   141     self assert: tree children first type: PPCNotMessagePredicateNode.

   142     self assert: tree children first isMarkedForInline.

   143     self assert: tree children second type: PPCNotCharSetPredicateNode.

   144     self assert: tree children second isMarkedForInline.

   145     

   146 !

   147 

   148 testInlinePluggable

   149     | tree |

   150     tree := self optimize: [:ctx | nil] asParser star.

   151 

   152     ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) 

   153         ifTrue:[ self skipIf: true description: 'not supported in St/X' ].

   154 

   155     self assert: tree type: PPCStarNode.

   156     self assert: tree child type: PPCPluggableNode.

   157     self assert: tree child isMarkedForInline.

   158 

   159     "Modified: / 10-05-2015 / 07:30:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   160 !

   161 

   162 testInlinePredicate

   163     | tree |

   164     tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo)).

   165 

   166     self assert: tree type: PPCSequenceNode.

   167     self assert: tree children first type: PPCMessagePredicateNode.

   168     self assert: tree children first isMarkedForInline.

   169     self assert: tree children second type: PPCCharSetPredicateNode.

   170     self assert: tree children second isMarkedForInline.

   171     

   172 !

   173 

   174 testLetterPredicate

   175     | tree |

   176     tree := self optimize: #letter asParser.

   177 

   178     self assert: tree type: PPCMessagePredicateNode.

   179     self assert: tree message = #isLetter.

   180 !

   181 

   182 testNotAction

   183     | tree |

   184     tree := self optimize: (($f asParser, $o asParser) ==> #second) not.

   185 

   186     self assert: tree type: PPCNotNode.

   187     self assert: tree child type: PPCRecognizingSequenceNode.

   188 !

   189 

   190 testNotCharSetPredicate

   191     | tree |

   192     tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not.

   193 

   194     self assert: tree type: PPCNotCharSetPredicateNode.

   195 !

   196 

   197 testNotLiteral

   198     | tree |

   199     tree := self optimize: 'foo' asParser not.

   200 

   201     self assert: tree type: PPCNotLiteralNode.

   202     self assert: tree literal = 'foo'.

   203 !

   204 

   205 testNotMessagePredicate

   206     | tree |

   207     tree := self optimize: #letter asParser not.

   208 

   209     self assert: tree type: PPCNotMessagePredicateNode.

   210 !

   211 

   212 testNotSequence

   213     | tree |

   214     tree := self optimize: ($f asParser, $o asParser) not.

   215 

   216     self assert: tree type: PPCNotNode.

   217     self assert: tree child type: PPCRecognizingSequenceNode.

   218 !

   219 

   220 testRecognizingSequence2

   221     | tree |

   222     tree := self optimize: ($a asParser, $b asParser) token.

   223 

   224     self assert: tree type: PPCTokenNode.

   225     self assert: tree child type: PPCRecognizingSequenceNode.

   226     

   227     tree := self optimize: ($a asParser, $b asParser) trimmingToken.

   228 

   229     self assert: tree type: PPCTrimmingTokenNode.

   230     self assert: tree child type: PPCRecognizingSequenceNode.

   231 !

   232 

   233 testStarAny

   234     | tree |

   235     tree := self optimize: #any asParser star.

   236 

   237     self assert: tree type: PPCStarAnyNode.

   238 !

   239 

   240 testStarCharSetPredicate

   241     | tree |

   242     tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) star.

   243 

   244     self assert: tree type: PPCStarCharSetPredicateNode

   245 !

   246 

   247 testStarMessagePredicate

   248     | tree |

   249     tree := self optimize: #letter asParser star.

   250 

   251     self assert: tree type: PPCStarMessagePredicateNode.

   252 !

   253 

   254 testStarSeparator

   255     | tree |

   256     tree := self optimize: #space asParser star trimmingToken.

   257 

   258     self assert: tree type: PPCTrimmingTokenNode.

   259     self assert: tree child type: PPCTokenStarSeparatorNode.

   260 !

   261 

   262 testStarSeparator2

   263     | tree |

   264     tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.

   265 

   266     self assert: tree type: PPCTrimmingTokenNode.

   267     self assert: tree child type: PPCRecognizingSequenceNode.

   268     self assert: tree child children first type: PPCTokenStarSeparatorNode.

   269     self assert: tree child children first isMarkedForInline.

   270 !

   271 

   272 testSymbolAction

   273     | tree |

   274     tree := self optimize: (#letter asParser) ==> #second.

   275 

   276     self assert: tree type: PPCSymbolActionNode.

   277 

   278     tree := self optimize: (#letter asParser) ==> [:e | e second ].

   279     self assert: tree type: PPCActionNode.

   280 !

   281 

   282 testToken

   283     | tree |

   284     tree := self optimize: ((#letter asParser, #word asParser star) token).

   285 

   286     self assert: tree type: PPCTokenNode.

   287     self assert: tree child type: PPCRecognizingSequenceNode.

   288     self assert: tree child children size = 2.

   289     self assert: tree child children first type: PPCMessagePredicateNode.

   290     self assert: tree child children first isMarkedForInline.

   291     self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	

   292     self assert: tree child children second isMarkedForInline.

   293     

   294 !

   295 

   296 testTrimmingToken

   297     | tree |

   298     tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).

   299 

   300     self assert: tree type: PPCTrimmingTokenNode.

   301     self assert: tree whitespace type: PPCTokenStarSeparatorNode.

   302     self assert: tree whitespace isMarkedForInline.

   303     

   304     self assert: tree child type: PPCRecognizingSequenceNode.

   305     self assert: tree child children size = 2.

   306     self assert: tree child children first type: PPCMessagePredicateNode.

   307     self assert: tree child children first isMarkedForInline.

   308     self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	

   309     self assert: tree child children first isMarkedForInline.

   310 !

   311 

   312 testTrimmingToken2

   313     | parser tree |

   314     parser := 'foo' asParser trimmingToken.

   315     tree := self optimize: parser.

   316     

   317     self assert: tree type: PPCTrimmingTokenNode.

   318     self assert: tree child type: PPCLiteralNode.

   319     self assert: tree child isMarkedForInline.

   320     self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).

   321 

   322     parser := ('foo' asParser, $b asParser) trimmingToken.

   323     tree := self optimize: parser.

   324     

   325     self assert: tree type: PPCTrimmingTokenNode.

   326     self assert: tree child type: PPCRecognizingSequenceNode.

   327     self assert: tree whitespace type: PPCTokenStarSeparatorNode.

   328     self assert: tree whitespace isMarkedForInline.

   329     

   330     parser := $d asParser trimmingToken star.

   331     tree := self optimize: parser.

   332     

   333     self assert: tree type: PPCStarNode.

   334     self assert: tree child type: PPCTrimmingTokenNode.

   335     self assert: tree child child type: PPCCharacterNode.

   336     self assert: tree child child isMarkedForInline.

   337 !

   338 

   339 testTrimmingToken3

   340     | parser tree |

   341     parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').

   342     tree := self optimize: parser.

   343     

   344     self assert: tree type: PPCSequenceNode.

   345     self assert: tree children first type: PPCTrimmingTokenNode.

   346     self assert: tree children second type: PPCTrimmingTokenNode.

   347 !

   348 

   349 testTrimmingTokenNested

   350     | parser tree foo|

   351     foo := 'foo' asParser trimmingToken name: 'foo'.

   352     parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.

   353     tree := self optimize: parser.

   354     

   355     self assert: tree type: PPCTrimmingTokenNode.

   356     self assert: tree children second type: PPCRecognizingSequenceNode.

   357     self assert: tree children second children first type: PPCNotLiteralNode.

   358     self assert: tree children second children first isMarkedForInline.

   359 ! !

   360