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

     2 

     3 TestCase subclass:#PPCOptimizingTest

     4 	instanceVariableNames:''

     5 	classVariableNames:''

     6 	poolDictionaries:''

     7 	category:'PetitCompiler-Tests-Nodes'

     8 !

     9 

    10 PPCOptimizingTest comment:''

    11 !

    12 

    13 !PPCOptimizingTest methodsFor:'test support'!

    14 

    15 assert: object type: class

    16 	self assert: object class == class

    17 !

    18 

    19 optimize: p

    20 	^ p asCompilerTree optimizeTree 

    21 ! !

    22 

    23 !PPCOptimizingTest methodsFor:'tests'!

    24 

    25 testAnyPredicate

    26 	| tree |

    27 	tree := self optimize: #any asParser.

    28 	

    29 	self assert: tree type: PPCAnyNode.

    30 !

    31 

    32 testCharSetPredicate

    33 	| tree |

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

    35 

    36 	self assert: tree type: PPCCharSetPredicateNode

    37 !

    38 

    39 testChoiceInlining

    40 	| tree |

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

    42 

    43 	self assert: tree type: PPCChoiceNode.

    44 	self assert: tree children first  type: PPCInlineCharacterNode.

    45 	self assert: tree children second type: PPCInlineCharacterNode.

    46 !

    47 

    48 testForwarding

    49 	| tree p1 p2 |

    50 	p2 := $a asParser.

    51 	p1 := p2 wrapped.

    52 	p1 name: 'p1'.

    53 	tree := self optimize: p1.

    54 

    55 	self assert: tree type: PPCCharacterNode.

    56 	self assert: tree name = 'p1'.

    57 	

    58 	p2 name: 'p2'.

    59 	tree := self optimize: p1.

    60 	self assert: tree type: PPCForwardNode.

    61 	self assert: tree name = 'p1'.

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

    63 !

    64 

    65 testInlineCharacter

    66 	| tree |

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

    68 

    69 	self assert: tree type: PPCPlusNode.

    70 	self assert: tree child  type: PPCInlineCharacterNode.

    71 	self assert: tree child character = $a.

    72 !

    73 

    74 testInlineCharacter2

    75 	| tree |

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

    77 

    78 	self assert: tree type: PPCStarNode.

    79 	self assert: tree child  type: PPCInlineCharacterNode.

    80 	self assert: tree child character = $a.

    81 !

    82 

    83 testInlineCharacter3

    84 	| tree |

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

    86 

    87 	self assert: tree type: PPCSequenceNode.

    88 	self assert: tree children first type: PPCInlineCharacterNode.

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

    90 	self assert: tree children second type: PPCInlineCharacterNode.

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

    92 !

    93 

    94 testInlineNil

    95 	| tree |

    96 	tree := self optimize: nil asParser star.

    97 

    98 	self assert: tree type: PPCStarNode.

    99 	self assert: tree child type: PPCInlineNilNode.

   100 !

   101 

   102 testInlineNotLiteral

   103 	| tree |

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

   105 

   106 	self assert: tree type: PPCStarNode.

   107 	self assert: tree child type: PPCInlineNotLiteralNode.

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

   109 !

   110 

   111 testInlineNotPredicate

   112 	| tree |

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

   114 

   115 	self assert: tree type: PPCSequenceNode.

   116 	self assert: tree children first type: PPCInlineNotMessagePredicateNode.

   117 	self assert: tree children second type: PPCInlineNotCharSetPredicateNode.

   118 !

   119 

   120 testInlinePluggable

   121 	| tree |

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

   123 

   124 	self assert: tree type: PPCStarNode.

   125 	self assert: tree child type: PPCInlinePluggableNode.

   126 !

   127 

   128 testInlinePredicate

   129 	| tree |

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

   131 

   132 	self assert: tree type: PPCSequenceNode.

   133 	self assert: tree children first type: PPCInlineMessagePredicateNode.

   134 	self assert: tree children second type: PPCInlineCharSetPredicateNode.

   135 !

   136 

   137 testLetterPredicate

   138 	| tree |

   139 	tree := self optimize: #letter asParser.

   140 

   141 	self assert: tree type: PPCMessagePredicateNode.

   142 	self assert: tree message = #isLetter.

   143 !

   144 

   145 testNotCharSetPredicate

   146 	| tree |

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

   148 

   149 	self assert: tree type: PPCNotCharSetPredicateNode.

   150 !

   151 

   152 testNotLiteral

   153 	| tree |

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

   155 

   156 	self assert: tree type: PPCNotLiteralNode.

   157 	self assert: tree literal = 'foo'.

   158 !

   159 

   160 testNotMessagePredicate

   161 	| tree |

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

   163 

   164 	self assert: tree type: PPCNotMessagePredicateNode.

   165 !

   166 

   167 testStarAny

   168 	| tree |

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

   170 

   171 	self assert: tree type: PPCStarAnyNode.

   172 !

   173 

   174 testStarCharSetPredicate

   175 	| tree |

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

   177 

   178 	self assert: tree type: PPCStarCharSetPredicateNode

   179 !

   180 

   181 testStarMessagePredicate

   182 	| tree |

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

   184 

   185 	self assert: tree type: PPCStarMessagePredicateNode.

   186 !

   187 

   188 testSymbolAction

   189 	| tree |

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

   191 

   192 	self assert: tree type: PPCSymbolActionNode.

   193 

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

   195 	self assert: tree type: PPCActionNode.

   196 !

   197 

   198 testToken

   199 	| tree |

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

   201 

   202 	self assert: tree type: PPCTokenNode.

   203 	self assert: tree child type: PPCTokenSequenceNode.

   204 	self assert: tree child children size = 2.

   205 	self assert: tree child children first type: PPCInlineMessagePredicateNode.

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

   207 !

   208 

   209 testTokenSequence

   210 	| tree |

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

   212 

   213 	self assert: tree type: PPCTokenNode.

   214 	self assert: tree child type: PPCTokenSequenceNode.

   215 	

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

   217 

   218 	self assert: tree type: PPCTrimmingTokenNode.

   219 	self assert: tree child type: PPCTokenSequenceNode.

   220 !

   221 

   222 testTrimmingToken

   223 	| tree |

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

   225 

   226 	self assert: tree type: PPCTrimmingTokenNode.

   227 	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.

   228 	self assert: tree child type: PPCTokenSequenceNode.

   229 	self assert: tree child children size = 2.

   230 	self assert: tree child children first type: PPCInlineMessagePredicateNode.

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

   232 !

   233 

   234 testTrimmingToken2

   235 	| parser tree |

   236 	parser := 'foo' asParser trimmingToken.

   237 	tree := parser asCompilerTree optimizeTree.

   238 	

   239 	self assert: tree type: PPCTrimmingTokenNode.

   240 	self assert: tree child type: PPCInlineLiteralNode.

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

   242 

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

   244 	tree := parser asCompilerTree optimizeTree.

   245 	

   246 	self assert: tree type: PPCTrimmingTokenNode.

   247 	self assert: tree child type: PPCTokenSequenceNode.

   248 	self assert: tree whitespace type: PPCTokenStarMessagePredicateNode.

   249 	

   250 	parser := $d asParser trimmingToken star.

   251 	tree := parser asCompilerTree optimizeTree.

   252 	

   253 	self assert: tree type: PPCStarNode.

   254 	self assert: tree child type: PPCTrimmingTokenNode.

   255 	self assert: tree child child type: PPCInlineCharacterNode.

   256 ! !

   257