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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#PPCOptimizingTest

     6 	instanceVariableNames:''

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Tests-Nodes'

    10 !

    11 

    12 

    13 !PPCOptimizingTest methodsFor:'test support'!

    14 

    15 assert: object type: class

    16 	self assert: (object isKindOf: class)

    17 !

    18 

    19 optimize: p

    20 	^ p asCompilerTree optimizeTree 

    21 !

    22 

    23 optimize: p parameters: parameters

    24 	^ p asCompilerTree optimizeTree: parameters 

    25 ! !

    26 

    27 !PPCOptimizingTest methodsFor:'tests'!

    28 

    29 testAnyPredicate

    30 	| tree |

    31 	tree := self optimize: #any asParser.

    32 	

    33 	self assert: tree type: PPCAnyNode.

    34 !

    35 

    36 testCharSetPredicate

    37 	| tree |

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

    39 

    40 	self assert: tree type: PPCCharSetPredicateNode

    41 !

    42 

    43 testChoiceInlining

    44 	| tree |

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

    46 

    47 	self assert: tree type: PPCChoiceNode.

    48 	self assert: tree children first  type: PPCCharacterNode.

    49 	self assert: tree children first isMarkedForInline.

    50 	self assert: tree children second type: PPCCharacterNode.

    51 	self assert: tree children first isMarkedForInline.

    52 	

    53 !

    54 

    55 testForwarding

    56 	| tree p1 p2 |

    57 	p2 := $a asParser.

    58 	p1 := p2 wrapped.

    59 	p1 name: 'p1'.

    60 	tree := self optimize: p1.

    61 

    62 	self assert: tree type: PPCAbstractCharacterNode.

    63 	self assert: tree name = 'p1'.

    64 	

    65 	p2 name: 'p2'.

    66 	tree := self optimize: p1.

    67 	self assert: tree type: PPCForwardNode.

    68 	self assert: tree name = 'p1'.

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

    70 !

    71 

    72 testInlineCharacter

    73 	| tree |

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

    75 

    76 	self assert: tree type: PPCPlusNode.

    77 	self assert: tree child type: PPCCharacterNode.

    78 	self assert: tree child isMarkedForInline.

    79 	self assert: tree child character = $a.

    80 !

    81 

    82 testInlineCharacter2

    83 	| tree |

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

    85 

    86 	self assert: tree type: PPCStarNode.

    87 	self assert: tree child type: PPCCharacterNode.

    88 	self assert: tree child isMarkedForInline.

    89 	self assert: tree child character = $a.

    90 !

    91 

    92 testInlineCharacter3

    93 	| tree |

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

    95 

    96 	self assert: tree type: PPCSequenceNode.

    97 	self assert: tree children first type: PPCCharacterNode.

    98 	self assert: tree children first isMarkedForInline.

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

   100 	self assert: tree children second type: PPCCharacterNode.

   101 	self assert: tree children second isMarkedForInline.

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

   103 !

   104 

   105 testInlineNil

   106 	| tree |

   107 	tree := self optimize: nil asParser star.

   108 

   109 	self assert: tree type: PPCStarNode.

   110 	self assert: tree child type: PPCNilNode.

   111 	self assert: tree child isMarkedForInline.

   112 !

   113 

   114 testInlineNotLiteral

   115 	| tree |

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

   117 

   118 	self assert: tree type: PPCStarNode.

   119 	self assert: tree child type: PPCNotLiteralNode.

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

   121 	self assert: tree child isMarkedForInline.

   122 !

   123 

   124 testInlineNotPredicate

   125 	| tree |

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

   127 

   128 	self assert: tree type: PPCSequenceNode.

   129 	self assert: tree children first type: PPCNotMessagePredicateNode.

   130 	self assert: tree children first isMarkedForInline.

   131 	self assert: tree children second type: PPCNotCharSetPredicateNode.

   132 	self assert: tree children second isMarkedForInline.

   133 	

   134 !

   135 

   136 testInlinePluggable

   137 	| tree |

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

   139 

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

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

   142 

   143 	self assert: tree type: PPCStarNode.

   144 	self assert: tree child type: PPCPluggableNode.

   145 	self assert: tree child isMarkedForInline.

   146 

   147     "Modified: / 23-04-2015 / 12:19:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   148 !

   149 

   150 testInlinePredicate

   151 	| tree |

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

   153 

   154 	self assert: tree type: PPCSequenceNode.

   155 	self assert: tree children first type: PPCMessagePredicateNode.

   156 	self assert: tree children first isMarkedForInline.

   157 	self assert: tree children second type: PPCCharSetPredicateNode.

   158 	self assert: tree children second isMarkedForInline.

   159 	

   160 !

   161 

   162 testLetterPredicate

   163 	| tree |

   164 	tree := self optimize: #letter asParser.

   165 

   166 	self assert: tree type: PPCMessagePredicateNode.

   167 	self assert: tree message = #isLetter.

   168 !

   169 

   170 testNotAction

   171 	| tree |

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

   173 

   174 	self assert: tree type: PPCNotNode.

   175 	self assert: tree child type: PPCTokenSequenceNode.

   176 !

   177 

   178 testNotCharSetPredicate

   179 	| tree |

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

   181 

   182 	self assert: tree type: PPCNotCharSetPredicateNode.

   183 !

   184 

   185 testNotLiteral

   186 	| tree |

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

   188 

   189 	self assert: tree type: PPCNotLiteralNode.

   190 	self assert: tree literal = 'foo'.

   191 !

   192 

   193 testNotMessagePredicate

   194 	| tree |

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

   196 

   197 	self assert: tree type: PPCNotMessagePredicateNode.

   198 !

   199 

   200 testNotSequence

   201 	| tree |

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

   203 

   204 	self assert: tree type: PPCNotNode.

   205 	self assert: tree child type: PPCTokenSequenceNode.

   206 !

   207 

   208 testStarAny

   209 	| tree |

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

   211 

   212 	self assert: tree type: PPCStarAnyNode.

   213 !

   214 

   215 testStarCharSetPredicate

   216 	| tree |

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

   218 

   219 	self assert: tree type: PPCStarCharSetPredicateNode

   220 !

   221 

   222 testStarMessagePredicate

   223 	| tree |

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

   225 

   226 	self assert: tree type: PPCStarMessagePredicateNode.

   227 !

   228 

   229 testStarSeparator

   230 	| tree |

   231 	tree := self optimize: #space asParser star trimmingToken parameters: { #rewrite . #token }.

   232 

   233 	self assert: tree type: PPCTrimmingTokenNode.

   234 	self assert: tree child type: PPCTokenStarSeparatorNode.

   235 !

   236 

   237 testStarSeparator2

   238 	| tree |

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

   240 

   241 	self assert: tree type: PPCTrimmingTokenNode.

   242 	self assert: tree child type: PPCTokenSequenceNode.

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

   244 	self assert: tree child children first isMarkedForInline.

   245 !

   246 

   247 testSymbolAction

   248 	| tree |

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

   250 

   251 	self assert: tree type: PPCSymbolActionNode.

   252 

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

   254 	self assert: tree type: PPCActionNode.

   255 !

   256 

   257 testToken

   258 	| tree |

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

   260 

   261 	self assert: tree type: PPCTokenNode.

   262 	self assert: tree child type: PPCTokenSequenceNode.

   263 	self assert: tree child children size = 2.

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

   265 	self assert: tree child children first isMarkedForInline.

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

   267 	self assert: tree child children second isMarkedForInline.

   268 	

   269 !

   270 

   271 testTokenSequence2

   272 	| tree |

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

   274 

   275 	self assert: tree type: PPCTokenNode.

   276 	self assert: tree child type: PPCTokenSequenceNode.

   277 	

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

   279 

   280 	self assert: tree type: PPCTrimmingTokenNode.

   281 	self assert: tree child type: PPCTokenSequenceNode.

   282 !

   283 

   284 testTrimmingToken

   285 	| tree |

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

   287 

   288 	self assert: tree type: PPCTrimmingTokenNode.

   289 	self assert: tree whitespace type: PPCTokenStarSeparatorNode.

   290 	self assert: tree whitespace isMarkedForInline.

   291 	

   292 	self assert: tree child type: PPCTokenSequenceNode.

   293 	self assert: tree child children size = 2.

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

   295 	self assert: tree child children first isMarkedForInline.

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

   297 	self assert: tree child children first isMarkedForInline.

   298 !

   299 

   300 testTrimmingToken2

   301 	| parser tree |

   302 	parser := 'foo' asParser trimmingToken.

   303 	tree := parser asCompilerTree optimizeTree.

   304 	

   305 	self assert: tree type: PPCTrimmingTokenNode.

   306 	self assert: tree child type: PPCLiteralNode.

   307 	self assert: tree child isMarkedForInline.

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

   309 

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

   311 	tree := parser asCompilerTree optimizeTree.

   312 	

   313 	self assert: tree type: PPCTrimmingTokenNode.

   314 	self assert: tree child type: PPCTokenSequenceNode.

   315 	self assert: tree whitespace type: PPCTokenStarSeparatorNode.

   316 	self assert: tree whitespace isMarkedForInline.

   317 	

   318 	parser := $d asParser trimmingToken star.

   319 	tree := parser asCompilerTree optimizeTree.

   320 	

   321 	self assert: tree type: PPCStarNode.

   322 	self assert: tree child type: PPCTrimmingTokenNode.

   323 	self assert: tree child child type: PPCCharacterNode.

   324 	self assert: tree child child isMarkedForInline.

   325 !

   326 

   327 testTrimmingToken3

   328 	| parser tree |

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

   330 	tree := parser asCompilerTree optimizeTree.

   331 	

   332 	self assert: tree type: PPCSequenceNode.

   333 	self assert: tree children first type: PPCTrimmingTokenNode.

   334 	self assert: tree children second type: PPCTrimmingTokenNode.

   335 !

   336 

   337 testTrimmingTokenNested

   338 	| parser tree foo|

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

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

   341 	tree := self optimize: parser.

   342 	

   343 	self assert: tree type: PPCTrimmingTokenNode.

   344 	self assert: tree children second type: PPCTokenSequenceNode.

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

   346 	self assert: tree children second children first isMarkedForInline.

   347 ! !

   348 

   349 !PPCOptimizingTest class methodsFor:'documentation'!

   350 

   351 version_HG

   352 

   353     ^ '$Changeset: <not expanded> $'

   354 ! !

   355