13 assert: object type: class |
13 assert: object type: class |
14 self assert: object class == class |
14 self assert: object class == class |
15 ! |
15 ! |
16 |
16 |
17 optimize: p |
17 optimize: p |
18 ^ p asCompilerTree optimizeTree |
18 ^ self optimize: p parameters: #() |
|
19 ! |
|
20 |
|
21 optimize: p parameters: parameters |
|
22 ^ p asCompilerTree optimizeTree: parameters |
19 ! ! |
23 ! ! |
20 |
24 |
21 !PPCOptimizingTest methodsFor:'tests'! |
25 !PPCOptimizingTest methodsFor:'tests'! |
22 |
26 |
23 testAnyPredicate |
27 testAnyPredicate |
114 self assert: tree children first type: PPCInlineNotMessagePredicateNode. |
118 self assert: tree children first type: PPCInlineNotMessagePredicateNode. |
115 self assert: tree children second type: PPCInlineNotCharSetPredicateNode. |
119 self assert: tree children second type: PPCInlineNotCharSetPredicateNode. |
116 ! |
120 ! |
117 |
121 |
118 testInlinePluggable |
122 testInlinePluggable |
119 | tree | |
123 | tree | |
120 tree := self optimize: [:ctx | nil] asParser star. |
124 tree := self optimize: [:ctx | nil] asParser star. |
121 |
125 |
122 self assert: tree type: PPCStarNode. |
126 self assert: tree type: PPCStarNode. |
123 "Sadly, on Smalltalk/X blocks cannot be inlined because |
127 self assert: tree child type: PPCInlinePluggableNode. |
124 the VM does not provide enough information to map |
|
125 it back to source code. Very bad indeed!!" |
|
126 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
|
127 self assert: tree child type: PPCPluggableNode. |
|
128 ] ifFalse:[ |
|
129 self assert: tree child type: PPCInlinePluggableNode. |
|
130 ] |
|
131 |
|
132 "Modified: / 08-11-2014 / 00:57:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
133 ! |
128 ! |
134 |
129 |
135 testInlinePredicate |
130 testInlinePredicate |
136 | tree | |
131 | tree | |
137 tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo)). |
132 tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [ e = $b ]] message: #foo)). |
147 |
142 |
148 self assert: tree type: PPCMessagePredicateNode. |
143 self assert: tree type: PPCMessagePredicateNode. |
149 self assert: tree message = #isLetter. |
144 self assert: tree message = #isLetter. |
150 ! |
145 ! |
151 |
146 |
|
147 testNotAction |
|
148 | tree | |
|
149 tree := self optimize: (($f asParser, $o asParser) ==> #second) not. |
|
150 |
|
151 self assert: tree type: PPCNotNode. |
|
152 self assert: tree child type: PPCTokenSequenceNode. |
|
153 ! |
|
154 |
152 testNotCharSetPredicate |
155 testNotCharSetPredicate |
153 | tree | |
156 | tree | |
154 tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not. |
157 tree := self optimize: (PPPredicateObjectParser on: [:each | each = $b or: [each = $c] ] message: #foo) asParser not. |
155 |
158 |
156 self assert: tree type: PPCNotCharSetPredicateNode. |
159 self assert: tree type: PPCNotCharSetPredicateNode. |
169 tree := self optimize: #letter asParser not. |
172 tree := self optimize: #letter asParser not. |
170 |
173 |
171 self assert: tree type: PPCNotMessagePredicateNode. |
174 self assert: tree type: PPCNotMessagePredicateNode. |
172 ! |
175 ! |
173 |
176 |
|
177 testNotSequence |
|
178 | tree | |
|
179 tree := self optimize: ($f asParser, $o asParser) not. |
|
180 |
|
181 self assert: tree type: PPCNotNode. |
|
182 self assert: tree child type: PPCTokenSequenceNode. |
|
183 ! |
|
184 |
174 testStarAny |
185 testStarAny |
175 | tree | |
186 | tree | |
176 tree := self optimize: #any asParser star. |
187 tree := self optimize: #any asParser star. |
177 |
188 |
178 self assert: tree type: PPCStarAnyNode. |
189 self assert: tree type: PPCStarAnyNode. |
188 testStarMessagePredicate |
199 testStarMessagePredicate |
189 | tree | |
200 | tree | |
190 tree := self optimize: #letter asParser star. |
201 tree := self optimize: #letter asParser star. |
191 |
202 |
192 self assert: tree type: PPCStarMessagePredicateNode. |
203 self assert: tree type: PPCStarMessagePredicateNode. |
|
204 ! |
|
205 |
|
206 testStarSeparator |
|
207 | tree | |
|
208 tree := self optimize: #space asParser star trimmingToken parameters: { #inline -> false }. |
|
209 |
|
210 self assert: tree type: PPCTrimmingTokenNode. |
|
211 self assert: tree child type: PPCTokenStarSeparatorNode. |
|
212 ! |
|
213 |
|
214 testStarSeparator2 |
|
215 | tree | |
|
216 tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken. |
|
217 |
|
218 self assert: tree type: PPCTrimmingTokenNode. |
|
219 self assert: tree child type: PPCTokenSequenceNode. |
|
220 self assert: tree child children first type: PPCInlineTokenStarSeparatorNode. |
193 ! |
221 ! |
194 |
222 |
195 testSymbolAction |
223 testSymbolAction |
196 | tree | |
224 | tree | |
197 tree := self optimize: (#letter asParser) ==> #second. |
225 tree := self optimize: (#letter asParser) ==> #second. |
208 |
236 |
209 self assert: tree type: PPCTokenNode. |
237 self assert: tree type: PPCTokenNode. |
210 self assert: tree child type: PPCTokenSequenceNode. |
238 self assert: tree child type: PPCTokenSequenceNode. |
211 self assert: tree child children size = 2. |
239 self assert: tree child children size = 2. |
212 self assert: tree child children first type: PPCInlineMessagePredicateNode. |
240 self assert: tree child children first type: PPCInlineMessagePredicateNode. |
213 self assert: tree child children second type: PPCTokenStarMessagePredicateNode. |
241 self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode. |
214 ! |
242 ! |
215 |
243 |
216 testTokenSequence |
244 testTokenSequence |
217 | tree | |
245 | tree | |
218 tree := self optimize: ($a asParser, $b asParser) token. |
246 tree := self optimize: ($a asParser, $b asParser) token. |
229 testTrimmingToken |
257 testTrimmingToken |
230 | tree | |
258 | tree | |
231 tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken). |
259 tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken). |
232 |
260 |
233 self assert: tree type: PPCTrimmingTokenNode. |
261 self assert: tree type: PPCTrimmingTokenNode. |
234 self assert: tree whitespace type: PPCTokenStarMessagePredicateNode. |
262 self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode. |
235 self assert: tree child type: PPCTokenSequenceNode. |
263 self assert: tree child type: PPCTokenSequenceNode. |
236 self assert: tree child children size = 2. |
264 self assert: tree child children size = 2. |
237 self assert: tree child children first type: PPCInlineMessagePredicateNode. |
265 self assert: tree child children first type: PPCInlineMessagePredicateNode. |
238 self assert: tree child children second type: PPCTokenStarMessagePredicateNode. |
266 self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode. |
239 ! |
267 ! |
240 |
268 |
241 testTrimmingToken2 |
269 testTrimmingToken2 |
242 | parser tree | |
270 | parser tree | |
243 parser := 'foo' asParser trimmingToken. |
271 parser := 'foo' asParser trimmingToken. |
250 parser := ('foo' asParser, $b asParser) trimmingToken. |
278 parser := ('foo' asParser, $b asParser) trimmingToken. |
251 tree := parser asCompilerTree optimizeTree. |
279 tree := parser asCompilerTree optimizeTree. |
252 |
280 |
253 self assert: tree type: PPCTrimmingTokenNode. |
281 self assert: tree type: PPCTrimmingTokenNode. |
254 self assert: tree child type: PPCTokenSequenceNode. |
282 self assert: tree child type: PPCTokenSequenceNode. |
255 self assert: tree whitespace type: PPCTokenStarMessagePredicateNode. |
283 self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode. |
256 |
284 |
257 parser := $d asParser trimmingToken star. |
285 parser := $d asParser trimmingToken star. |
258 tree := parser asCompilerTree optimizeTree. |
286 tree := parser asCompilerTree optimizeTree. |
259 |
287 |
260 self assert: tree type: PPCStarNode. |
288 self assert: tree type: PPCStarNode. |
261 self assert: tree child type: PPCTrimmingTokenNode. |
289 self assert: tree child type: PPCTrimmingTokenNode. |
262 self assert: tree child child type: PPCInlineCharacterNode. |
290 self assert: tree child child type: PPCInlineCharacterNode. |
|
291 ! |
|
292 |
|
293 testTrimmingToken3 |
|
294 | parser tree | |
|
295 parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar'). |
|
296 tree := parser asCompilerTree optimizeTree. |
|
297 |
|
298 self assert: tree type: PPCSequenceNode. |
|
299 self assert: tree children first type: PPCTrimmingTokenNode. |
|
300 self assert: tree children second type: PPCTrimmingTokenNode. |
|
301 ! |
|
302 |
|
303 testTrimmingTokenNested |
|
304 | parser tree foo| |
|
305 foo := 'foo' asParser trimmingToken name: 'foo'. |
|
306 parser := (foo not, 'bar' asParser) trimmingToken name: 'token'. |
|
307 tree := self optimize: parser. |
|
308 |
|
309 self assert: tree type: PPCTrimmingTokenNode. |
|
310 self assert: tree children second type: PPCTokenSequenceNode. |
|
311 self assert: tree children second children first type: PPCInlineNotLiteralNode. |
263 ! ! |
312 ! ! |
264 |
313 |
265 !PPCOptimizingTest class methodsFor:'documentation'! |
314 !PPCOptimizingTest class methodsFor:'documentation'! |
266 |
315 |
267 version_HG |
316 version_HG |