Commit | Line | Data |
---|---|---|
cc02ea56 JC |
1 | #!perl |
2 | ||
3 | BEGIN { | |
4 | chdir q(t); | |
5 | @INC = qw(../lib ../ext/B/t); | |
6 | require q(./test.pl); | |
7 | } | |
8 | use OptreeCheck; | |
9 | plan tests => 20; | |
10 | ||
11 | ||
7ce9b5fb | 12 | =head1 Test Notes |
cc02ea56 JC |
13 | |
14 | # chunk: #!perl | |
15 | #examples poached from perldoc -f sort | |
16 | ||
7ce9b5fb JC |
17 | NOTE: name is no longer a required arg for checkOptree, as label is |
18 | synthesized out of others. HOWEVER, if the test-code has newlines in | |
19 | it, the label must be overridden by an explicit name. | |
20 | ||
21 | This is because t/TEST is quite particular about the test output it | |
22 | processes, and multi-line labels violate its 1-line-per-test | |
23 | expectations. | |
24 | ||
cc02ea56 JC |
25 | =for gentest |
26 | ||
27 | # chunk: # sort lexically | |
28 | @articles = sort @files; | |
29 | ||
30 | =cut | |
31 | ||
32 | checkOptree(note => q{}, | |
33 | bcopts => q{-exec}, | |
34 | code => q{@articles = sort @files; }, | |
35 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
36 | # 1 <;> nextstate(main 545 (eval 15):1) v | |
37 | # 2 <0> pushmark s | |
38 | # 3 <0> pushmark s | |
39 | # 4 <#> gv[*files] s | |
40 | # 5 <1> rv2av[t4] lK/1 | |
41 | # 6 <@> sort lK | |
42 | # 7 <0> pushmark s | |
43 | # 8 <#> gv[*articles] s | |
44 | # 9 <1> rv2av[t2] lKRM*/1 | |
45 | # a <2> aassign[t5] KS | |
46 | # b <1> leavesub[1 ref] K/REFC,1 | |
47 | EOT_EOT | |
48 | # 1 <;> nextstate(main 545 (eval 15):1) v | |
49 | # 2 <0> pushmark s | |
50 | # 3 <0> pushmark s | |
51 | # 4 <$> gv(*files) s | |
52 | # 5 <1> rv2av[t2] lK/1 | |
53 | # 6 <@> sort lK | |
54 | # 7 <0> pushmark s | |
55 | # 8 <$> gv(*articles) s | |
56 | # 9 <1> rv2av[t1] lKRM*/1 | |
57 | # a <2> aassign[t3] KS | |
58 | # b <1> leavesub[1 ref] K/REFC,1 | |
59 | EONT_EONT | |
60 | ||
61 | ||
62 | =for gentest | |
63 | ||
64 | # chunk: # same thing, but with explicit sort routine | |
65 | @articles = sort {$a cmp $b} @files; | |
66 | ||
67 | =cut | |
68 | ||
69 | checkOptree(note => q{}, | |
70 | bcopts => q{-exec}, | |
71 | code => q{@articles = sort {$a cmp $b} @files; }, | |
72 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
73 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
74 | # 2 <0> pushmark s | |
75 | # 3 <0> pushmark s | |
76 | # 4 <#> gv[*files] s | |
77 | # 5 <1> rv2av[t7] lK/1 | |
78 | # 6 <@> sort lK | |
79 | # 7 <0> pushmark s | |
80 | # 8 <#> gv[*articles] s | |
81 | # 9 <1> rv2av[t2] lKRM*/1 | |
82 | # a <2> aassign[t5] KS | |
83 | # b <1> leavesub[1 ref] K/REFC,1 | |
84 | EOT_EOT | |
85 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
86 | # 2 <0> pushmark s | |
87 | # 3 <0> pushmark s | |
88 | # 4 <$> gv(*files) s | |
89 | # 5 <1> rv2av[t3] lK/1 | |
90 | # 6 <@> sort lK | |
91 | # 7 <0> pushmark s | |
92 | # 8 <$> gv(*articles) s | |
93 | # 9 <1> rv2av[t1] lKRM*/1 | |
94 | # a <2> aassign[t2] KS | |
95 | # b <1> leavesub[1 ref] K/REFC,1 | |
96 | EONT_EONT | |
97 | ||
98 | ||
99 | =for gentest | |
100 | ||
101 | # chunk: # now case-insensitively | |
102 | @articles = sort {uc($a) cmp uc($b)} @files; | |
103 | ||
104 | =cut | |
105 | ||
106 | checkOptree(note => q{}, | |
107 | bcopts => q{-exec}, | |
108 | code => q{@articles = sort {uc($a) cmp uc($b)} @files; }, | |
109 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
110 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
111 | # 2 <0> pushmark s | |
112 | # 3 <0> pushmark s | |
113 | # 4 <#> gv[*files] s | |
114 | # 5 <1> rv2av[t9] lK/1 | |
115 | # 6 <@> sort lKS* | |
116 | # 7 <0> pushmark s | |
117 | # 8 <#> gv[*articles] s | |
118 | # 9 <1> rv2av[t2] lKRM*/1 | |
119 | # a <2> aassign[t10] KS | |
120 | # b <1> leavesub[1 ref] K/REFC,1 | |
121 | EOT_EOT | |
122 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
123 | # 2 <0> pushmark s | |
124 | # 3 <0> pushmark s | |
125 | # 4 <$> gv(*files) s | |
126 | # 5 <1> rv2av[t5] lK/1 | |
127 | # 6 <@> sort lKS* | |
128 | # 7 <0> pushmark s | |
129 | # 8 <$> gv(*articles) s | |
130 | # 9 <1> rv2av[t1] lKRM*/1 | |
131 | # a <2> aassign[t6] KS | |
132 | # b <1> leavesub[1 ref] K/REFC,1 | |
133 | EONT_EONT | |
134 | ||
135 | ||
136 | =for gentest | |
137 | ||
138 | # chunk: # same thing in reversed order | |
139 | @articles = sort {$b cmp $a} @files; | |
140 | ||
141 | =cut | |
142 | ||
143 | checkOptree(note => q{}, | |
144 | bcopts => q{-exec}, | |
145 | code => q{@articles = sort {$b cmp $a} @files; }, | |
146 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
147 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
148 | # 2 <0> pushmark s | |
149 | # 3 <0> pushmark s | |
150 | # 4 <#> gv[*files] s | |
151 | # 5 <1> rv2av[t7] lK/1 | |
152 | # 6 <@> sort lK/REV | |
153 | # 7 <0> pushmark s | |
154 | # 8 <#> gv[*articles] s | |
155 | # 9 <1> rv2av[t2] lKRM*/1 | |
156 | # a <2> aassign[t5] KS | |
157 | # b <1> leavesub[1 ref] K/REFC,1 | |
158 | EOT_EOT | |
159 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
160 | # 2 <0> pushmark s | |
161 | # 3 <0> pushmark s | |
162 | # 4 <$> gv(*files) s | |
163 | # 5 <1> rv2av[t3] lK/1 | |
164 | # 6 <@> sort lK/REV | |
165 | # 7 <0> pushmark s | |
166 | # 8 <$> gv(*articles) s | |
167 | # 9 <1> rv2av[t1] lKRM*/1 | |
168 | # a <2> aassign[t2] KS | |
169 | # b <1> leavesub[1 ref] K/REFC,1 | |
170 | EONT_EONT | |
171 | ||
172 | ||
173 | =for gentest | |
174 | ||
175 | # chunk: # sort numerically ascending | |
176 | @articles = sort {$a <=> $b} @files; | |
177 | ||
178 | =cut | |
179 | ||
180 | checkOptree(note => q{}, | |
181 | bcopts => q{-exec}, | |
182 | code => q{@articles = sort {$a <=> $b} @files; }, | |
183 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
184 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
185 | # 2 <0> pushmark s | |
186 | # 3 <0> pushmark s | |
187 | # 4 <#> gv[*files] s | |
188 | # 5 <1> rv2av[t7] lK/1 | |
189 | # 6 <@> sort lK/NUM | |
190 | # 7 <0> pushmark s | |
191 | # 8 <#> gv[*articles] s | |
192 | # 9 <1> rv2av[t2] lKRM*/1 | |
193 | # a <2> aassign[t5] KS | |
194 | # b <1> leavesub[1 ref] K/REFC,1 | |
195 | EOT_EOT | |
196 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
197 | # 2 <0> pushmark s | |
198 | # 3 <0> pushmark s | |
199 | # 4 <$> gv(*files) s | |
200 | # 5 <1> rv2av[t3] lK/1 | |
201 | # 6 <@> sort lK/NUM | |
202 | # 7 <0> pushmark s | |
203 | # 8 <$> gv(*articles) s | |
204 | # 9 <1> rv2av[t1] lKRM*/1 | |
205 | # a <2> aassign[t2] KS | |
206 | # b <1> leavesub[1 ref] K/REFC,1 | |
207 | EONT_EONT | |
208 | ||
209 | ||
210 | =for gentest | |
211 | ||
212 | # chunk: # sort numerically descending | |
213 | @articles = sort {$b <=> $a} @files; | |
214 | ||
215 | =cut | |
216 | ||
217 | checkOptree(note => q{}, | |
218 | bcopts => q{-exec}, | |
219 | code => q{@articles = sort {$b <=> $a} @files; }, | |
220 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
221 | # 1 <;> nextstate(main 587 (eval 26):1) v | |
222 | # 2 <0> pushmark s | |
223 | # 3 <0> pushmark s | |
224 | # 4 <#> gv[*files] s | |
225 | # 5 <1> rv2av[t7] lK/1 | |
226 | # 6 <@> sort lK/REV,NUM | |
227 | # 7 <0> pushmark s | |
228 | # 8 <#> gv[*articles] s | |
229 | # 9 <1> rv2av[t2] lKRM*/1 | |
230 | # a <2> aassign[t5] KS | |
231 | # b <1> leavesub[1 ref] K/REFC,1 | |
232 | EOT_EOT | |
233 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
234 | # 2 <0> pushmark s | |
235 | # 3 <0> pushmark s | |
236 | # 4 <$> gv(*files) s | |
237 | # 5 <1> rv2av[t3] lK/1 | |
238 | # 6 <@> sort lK/REV,NUM | |
239 | # 7 <0> pushmark s | |
240 | # 8 <$> gv(*articles) s | |
241 | # 9 <1> rv2av[t1] lKRM*/1 | |
242 | # a <2> aassign[t2] KS | |
243 | # b <1> leavesub[1 ref] K/REFC,1 | |
244 | EONT_EONT | |
245 | ||
246 | ||
247 | =for gentest | |
248 | ||
249 | # chunk: # this sorts the %age hash by value instead of key | |
250 | # using an in-line function | |
251 | @eldest = sort { $age{$b} <=> $age{$a} } keys %age; | |
252 | ||
253 | =cut | |
254 | ||
255 | checkOptree(note => q{}, | |
256 | bcopts => q{-exec}, | |
257 | code => q{@eldest = sort { $age{$b} <=> $age{$a} } keys %age; }, | |
258 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
259 | # 1 <;> nextstate(main 592 (eval 28):1) v | |
260 | # 2 <0> pushmark s | |
261 | # 3 <0> pushmark s | |
262 | # 4 <#> gv[*age] s | |
263 | # 5 <1> rv2hv[t9] lKRM/1 | |
264 | # 6 <1> keys[t10] lK/1 | |
265 | # 7 <@> sort lKS* | |
266 | # 8 <0> pushmark s | |
267 | # 9 <#> gv[*eldest] s | |
268 | # a <1> rv2av[t2] lKRM*/1 | |
269 | # b <2> aassign[t11] KS | |
270 | # c <1> leavesub[1 ref] K/REFC,1 | |
271 | EOT_EOT | |
272 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
273 | # 2 <0> pushmark s | |
274 | # 3 <0> pushmark s | |
275 | # 4 <$> gv(*age) s | |
276 | # 5 <1> rv2hv[t3] lKRM/1 | |
277 | # 6 <1> keys[t4] lK/1 | |
278 | # 7 <@> sort lKS* | |
279 | # 8 <0> pushmark s | |
280 | # 9 <$> gv(*eldest) s | |
281 | # a <1> rv2av[t1] lKRM*/1 | |
282 | # b <2> aassign[t5] KS | |
283 | # c <1> leavesub[1 ref] K/REFC,1 | |
284 | EONT_EONT | |
285 | ||
286 | ||
287 | =for gentest | |
288 | ||
289 | # chunk: # sort using explicit subroutine name | |
290 | sub byage { | |
291 | $age{$a} <=> $age{$b}; # presuming numeric | |
292 | } | |
293 | @sortedclass = sort byage @class; | |
294 | ||
295 | =cut | |
296 | ||
297 | checkOptree(note => q{}, | |
298 | bcopts => q{-exec}, | |
299 | code => q{sub byage { $age{$a} <=> $age{$b}; } @sortedclass = sort byage @class; }, | |
300 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
301 | # 1 <;> nextstate(main 597 (eval 30):1) v | |
302 | # 2 <0> pushmark s | |
303 | # 3 <0> pushmark s | |
304 | # 4 <$> const[PV "byage"] s/BARE | |
305 | # 5 <#> gv[*class] s | |
306 | # 6 <1> rv2av[t4] lK/1 | |
307 | # 7 <@> sort lKS | |
308 | # 8 <0> pushmark s | |
309 | # 9 <#> gv[*sortedclass] s | |
310 | # a <1> rv2av[t2] lKRM*/1 | |
311 | # b <2> aassign[t5] KS | |
312 | # c <1> leavesub[1 ref] K/REFC,1 | |
313 | EOT_EOT | |
314 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
315 | # 2 <0> pushmark s | |
316 | # 3 <0> pushmark s | |
317 | # 4 <$> const(PV "byage") s/BARE | |
318 | # 5 <$> gv(*class) s | |
319 | # 6 <1> rv2av[t2] lK/1 | |
320 | # 7 <@> sort lKS | |
321 | # 8 <0> pushmark s | |
322 | # 9 <$> gv(*sortedclass) s | |
323 | # a <1> rv2av[t1] lKRM*/1 | |
324 | # b <2> aassign[t3] KS | |
325 | # c <1> leavesub[1 ref] K/REFC,1 | |
326 | EONT_EONT | |
327 | ||
328 | ||
329 | =for gentest | |
330 | ||
331 | # chunk: sub backwards { $b cmp $a } | |
332 | @harry = qw(dog cat x Cain Abel); | |
333 | @george = qw(gone chased yz Punished Axed); | |
334 | print sort @harry; | |
335 | # prints AbelCaincatdogx | |
336 | print sort backwards @harry; | |
337 | # prints xdogcatCainAbel | |
338 | print sort @george, 'to', @harry; | |
339 | # prints AbelAxedCainPunishedcatchaseddoggonetoxyz | |
340 | ||
341 | =cut | |
342 | ||
7ce9b5fb | 343 | checkOptree(name => q{sort USERSUB LIST }, |
cc02ea56 | 344 | bcopts => q{-exec}, |
cc02ea56 JC |
345 | code => q{sub backwards { $b cmp $a } |
346 | @harry = qw(dog cat x Cain Abel); | |
347 | @george = qw(gone chased yz Punished Axed); | |
348 | print sort @harry; print sort backwards @harry; | |
349 | print sort @george, 'to', @harry; }, | |
350 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
351 | # 1 <;> nextstate(main 602 (eval 32):2) v | |
352 | # 2 <0> pushmark s | |
353 | # 3 <$> const[PV "dog"] s | |
354 | # 4 <$> const[PV "cat"] s | |
355 | # 5 <$> const[PV "x"] s | |
356 | # 6 <$> const[PV "Cain"] s | |
357 | # 7 <$> const[PV "Abel"] s | |
358 | # 8 <0> pushmark s | |
359 | # 9 <#> gv[*harry] s | |
360 | # a <1> rv2av[t2] lKRM*/1 | |
361 | # b <2> aassign[t3] vKS | |
362 | # c <;> nextstate(main 602 (eval 32):3) v | |
363 | # d <0> pushmark s | |
364 | # e <$> const[PV "gone"] s | |
365 | # f <$> const[PV "chased"] s | |
366 | # g <$> const[PV "yz"] s | |
367 | # h <$> const[PV "Punished"] s | |
368 | # i <$> const[PV "Axed"] s | |
369 | # j <0> pushmark s | |
370 | # k <#> gv[*george] s | |
371 | # l <1> rv2av[t5] lKRM*/1 | |
372 | # m <2> aassign[t6] vKS | |
373 | # n <;> nextstate(main 602 (eval 32):4) v | |
374 | # o <0> pushmark s | |
375 | # p <0> pushmark s | |
376 | # q <#> gv[*harry] s | |
377 | # r <1> rv2av[t8] lK/1 | |
378 | # s <@> sort lK | |
379 | # t <@> print vK | |
380 | # u <;> nextstate(main 602 (eval 32):4) v | |
381 | # v <0> pushmark s | |
382 | # w <0> pushmark s | |
383 | # x <$> const[PV "backwards"] s/BARE | |
384 | # y <#> gv[*harry] s | |
385 | # z <1> rv2av[t10] lK/1 | |
386 | # 10 <@> sort lKS | |
387 | # 11 <@> print vK | |
388 | # 12 <;> nextstate(main 602 (eval 32):5) v | |
389 | # 13 <0> pushmark s | |
390 | # 14 <0> pushmark s | |
391 | # 15 <#> gv[*george] s | |
392 | # 16 <1> rv2av[t12] lK/1 | |
393 | # 17 <$> const[PV "to"] s | |
394 | # 18 <#> gv[*harry] s | |
395 | # 19 <1> rv2av[t14] lK/1 | |
396 | # 1a <@> sort lK | |
397 | # 1b <@> print sK | |
398 | # 1c <1> leavesub[1 ref] K/REFC,1 | |
399 | EOT_EOT | |
400 | # 1 <;> nextstate(main 602 (eval 32):2) v | |
401 | # 2 <0> pushmark s | |
402 | # 3 <$> const(PV "dog") s | |
403 | # 4 <$> const(PV "cat") s | |
404 | # 5 <$> const(PV "x") s | |
405 | # 6 <$> const(PV "Cain") s | |
406 | # 7 <$> const(PV "Abel") s | |
407 | # 8 <0> pushmark s | |
408 | # 9 <$> gv(*harry) s | |
409 | # a <1> rv2av[t1] lKRM*/1 | |
410 | # b <2> aassign[t2] vKS | |
411 | # c <;> nextstate(main 602 (eval 32):3) v | |
412 | # d <0> pushmark s | |
413 | # e <$> const(PV "gone") s | |
414 | # f <$> const(PV "chased") s | |
415 | # g <$> const(PV "yz") s | |
416 | # h <$> const(PV "Punished") s | |
417 | # i <$> const(PV "Axed") s | |
418 | # j <0> pushmark s | |
419 | # k <$> gv(*george) s | |
420 | # l <1> rv2av[t3] lKRM*/1 | |
421 | # m <2> aassign[t4] vKS | |
422 | # n <;> nextstate(main 602 (eval 32):4) v | |
423 | # o <0> pushmark s | |
424 | # p <0> pushmark s | |
425 | # q <$> gv(*harry) s | |
426 | # r <1> rv2av[t5] lK/1 | |
427 | # s <@> sort lK | |
428 | # t <@> print vK | |
429 | # u <;> nextstate(main 602 (eval 32):4) v | |
430 | # v <0> pushmark s | |
431 | # w <0> pushmark s | |
432 | # x <$> const(PV "backwards") s/BARE | |
433 | # y <$> gv(*harry) s | |
434 | # z <1> rv2av[t6] lK/1 | |
435 | # 10 <@> sort lKS | |
436 | # 11 <@> print vK | |
437 | # 12 <;> nextstate(main 602 (eval 32):5) v | |
438 | # 13 <0> pushmark s | |
439 | # 14 <0> pushmark s | |
440 | # 15 <$> gv(*george) s | |
441 | # 16 <1> rv2av[t7] lK/1 | |
442 | # 17 <$> const(PV "to") s | |
443 | # 18 <$> gv(*harry) s | |
444 | # 19 <1> rv2av[t8] lK/1 | |
445 | # 1a <@> sort lK | |
446 | # 1b <@> print sK | |
447 | # 1c <1> leavesub[1 ref] K/REFC,1 | |
448 | EONT_EONT | |
449 | ||
450 | ||
451 | =for gentest | |
452 | ||
453 | # chunk: # inefficiently sort by descending numeric compare using | |
454 | # the first integer after the first = sign, or the | |
455 | # whole record case-insensitively otherwise | |
456 | @new = @old[ sort { | |
457 | $nums[$b] <=> $nums[$a] | |
458 | || $caps[$a] cmp $caps[$b] | |
459 | } 0..$#old ]; | |
460 | ||
461 | =cut | |
462 | =for gentest | |
463 | ||
464 | # chunk: # same thing, but without any temps | |
465 | @new = map { $_->[0] } | |
466 | sort { $b->[1] <=> $a->[1] | |
467 | || $a->[2] cmp $b->[2] | |
468 | } map { [$_, /=(\d+)/, uc($_)] } @old; | |
469 | ||
470 | =cut | |
471 | ||
7ce9b5fb | 472 | checkOptree(name => q{Compound sort/map Expression }, |
cc02ea56 JC |
473 | bcopts => q{-exec}, |
474 | code => q{ @new = map { $_->[0] } | |
475 | sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } | |
476 | map { [$_, /=(\d+)/, uc($_)] } @old; }, | |
477 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
478 | # 1 <;> nextstate(main 609 (eval 34):3) v | |
479 | # 2 <0> pushmark s | |
480 | # 3 <0> pushmark s | |
481 | # 4 <0> pushmark s | |
482 | # 5 <0> pushmark s | |
483 | # 6 <#> gv[*old] s | |
484 | # 7 <1> rv2av[t19] lKM/1 | |
485 | # 8 <@> mapstart lK* | |
486 | # 9 <|> mapwhile(other->a)[t20] lK | |
487 | # a <0> enter l | |
488 | # b <;> nextstate(main 608 (eval 34):2) v | |
489 | # c <0> pushmark s | |
490 | # d <#> gvsv[*_] s | |
491 | # e </> match(/"=(\\d+)"/) l/RTIME | |
492 | # f <#> gvsv[*_] s | |
493 | # g <1> uc[t17] sK/1 | |
494 | # h <@> anonlist sKRM/1 | |
495 | # i <1> srefgen sK/1 | |
496 | # j <@> leave lKP | |
497 | # goto 9 | |
498 | # k <@> sort lKMS* | |
499 | # l <@> mapstart lK* | |
500 | # m <|> mapwhile(other->n)[t26] lK | |
501 | # n <#> gv[*_] s | |
502 | # o <1> rv2sv sKM/DREFAV,1 | |
503 | # p <1> rv2av[t4] sKR/1 | |
504 | # q <$> const[IV 0] s | |
505 | # r <2> aelem sK/2 | |
506 | # - <@> scope lK | |
507 | # goto m | |
508 | # s <0> pushmark s | |
509 | # t <#> gv[*new] s | |
510 | # u <1> rv2av[t2] lKRM*/1 | |
511 | # v <2> aassign[t27] KS/COMMON | |
512 | # w <1> leavesub[1 ref] K/REFC,1 | |
513 | EOT_EOT | |
514 | # 1 <;> nextstate(main 609 (eval 34):3) v | |
515 | # 2 <0> pushmark s | |
516 | # 3 <0> pushmark s | |
517 | # 4 <0> pushmark s | |
518 | # 5 <0> pushmark s | |
519 | # 6 <$> gv(*old) s | |
520 | # 7 <1> rv2av[t10] lKM/1 | |
521 | # 8 <@> mapstart lK* | |
522 | # 9 <|> mapwhile(other->a)[t11] lK | |
523 | # a <0> enter l | |
524 | # b <;> nextstate(main 608 (eval 34):2) v | |
525 | # c <0> pushmark s | |
526 | # d <$> gvsv(*_) s | |
527 | # e </> match(/"=(\\d+)"/) l/RTIME | |
528 | # f <$> gvsv(*_) s | |
529 | # g <1> uc[t9] sK/1 | |
530 | # h <@> anonlist sKRM/1 | |
531 | # i <1> srefgen sK/1 | |
532 | # j <@> leave lKP | |
533 | # goto 9 | |
534 | # k <@> sort lKMS* | |
535 | # l <@> mapstart lK* | |
536 | # m <|> mapwhile(other->n)[t12] lK | |
537 | # n <$> gv(*_) s | |
538 | # o <1> rv2sv sKM/DREFAV,1 | |
539 | # p <1> rv2av[t2] sKR/1 | |
540 | # q <$> const(IV 0) s | |
541 | # r <2> aelem sK/2 | |
542 | # - <@> scope lK | |
543 | # goto m | |
544 | # s <0> pushmark s | |
545 | # t <$> gv(*new) s | |
546 | # u <1> rv2av[t1] lKRM*/1 | |
547 | # v <2> aassign[t13] KS/COMMON | |
548 | # w <1> leavesub[1 ref] K/REFC,1 | |
549 | EONT_EONT | |
550 | ||
551 | ||
552 | =for gentest | |
553 | ||
554 | # chunk: # using a prototype allows you to use any comparison subroutine | |
555 | # as a sort subroutine (including other package's subroutines) | |
556 | package other; | |
557 | sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here | |
558 | package main; | |
559 | @new = sort other::backwards @old; | |
560 | ||
561 | =cut | |
562 | ||
7ce9b5fb | 563 | checkOptree(name => q{sort other::sub LIST }, |
cc02ea56 JC |
564 | bcopts => q{-exec}, |
565 | code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; } | |
566 | package main; @new = sort other::backwards @old; }, | |
567 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
568 | # 1 <;> nextstate(main 614 (eval 36):2) v | |
569 | # 2 <0> pushmark s | |
570 | # 3 <0> pushmark s | |
571 | # 4 <$> const[PV "other::backwards"] s/BARE | |
572 | # 5 <#> gv[*old] s | |
573 | # 6 <1> rv2av[t4] lK/1 | |
574 | # 7 <@> sort lKS | |
575 | # 8 <0> pushmark s | |
576 | # 9 <#> gv[*new] s | |
577 | # a <1> rv2av[t2] lKRM*/1 | |
578 | # b <2> aassign[t5] KS | |
579 | # c <1> leavesub[1 ref] K/REFC,1 | |
580 | EOT_EOT | |
581 | # 1 <;> nextstate(main 614 (eval 36):2) v | |
582 | # 2 <0> pushmark s | |
583 | # 3 <0> pushmark s | |
584 | # 4 <$> const(PV "other::backwards") s/BARE | |
585 | # 5 <$> gv(*old) s | |
586 | # 6 <1> rv2av[t2] lK/1 | |
587 | # 7 <@> sort lKS | |
588 | # 8 <0> pushmark s | |
589 | # 9 <$> gv(*new) s | |
590 | # a <1> rv2av[t1] lKRM*/1 | |
591 | # b <2> aassign[t3] KS | |
592 | # c <1> leavesub[1 ref] K/REFC,1 | |
593 | EONT_EONT | |
594 | ||
595 | ||
596 | =for gentest | |
597 | ||
598 | # chunk: # repeat, condensed. $main::a and $b are unaffected | |
599 | sub other::backwards ($$) { $_[1] cmp $_[0]; } | |
600 | @new = sort other::backwards @old; | |
601 | ||
602 | =cut | |
603 | ||
604 | checkOptree(note => q{}, | |
605 | bcopts => q{-exec}, | |
606 | code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; }, | |
607 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
608 | # 1 <;> nextstate(main 619 (eval 38):1) v | |
609 | # 2 <0> pushmark s | |
610 | # 3 <0> pushmark s | |
611 | # 4 <$> const[PV "other::backwards"] s/BARE | |
612 | # 5 <#> gv[*old] s | |
613 | # 6 <1> rv2av[t4] lK/1 | |
614 | # 7 <@> sort lKS | |
615 | # 8 <0> pushmark s | |
616 | # 9 <#> gv[*new] s | |
617 | # a <1> rv2av[t2] lKRM*/1 | |
618 | # b <2> aassign[t5] KS | |
619 | # c <1> leavesub[1 ref] K/REFC,1 | |
620 | EOT_EOT | |
621 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
622 | # 2 <0> pushmark s | |
623 | # 3 <0> pushmark s | |
624 | # 4 <$> const(PV "other::backwards") s/BARE | |
625 | # 5 <$> gv(*old) s | |
626 | # 6 <1> rv2av[t2] lK/1 | |
627 | # 7 <@> sort lKS | |
628 | # 8 <0> pushmark s | |
629 | # 9 <$> gv(*new) s | |
630 | # a <1> rv2av[t1] lKRM*/1 | |
631 | # b <2> aassign[t3] KS | |
632 | # c <1> leavesub[1 ref] K/REFC,1 | |
633 | EONT_EONT | |
634 | ||
635 | ||
636 | =for gentest | |
637 | ||
638 | # chunk: # guarantee stability, regardless of algorithm | |
639 | use sort 'stable'; | |
640 | @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; | |
641 | ||
642 | =cut | |
643 | ||
644 | checkOptree(note => q{}, | |
645 | bcopts => q{-exec}, | |
646 | code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; }, | |
647 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
648 | # 1 <;> nextstate(main 656 (eval 40):1) v | |
649 | # 2 <0> pushmark s | |
650 | # 3 <0> pushmark s | |
651 | # 4 <#> gv[*old] s | |
652 | # 5 <1> rv2av[t9] lK/1 | |
653 | # 6 <@> sort lKS* | |
654 | # 7 <0> pushmark s | |
655 | # 8 <#> gv[*new] s | |
656 | # 9 <1> rv2av[t2] lKRM*/1 | |
657 | # a <2> aassign[t14] KS | |
658 | # b <1> leavesub[1 ref] K/REFC,1 | |
659 | EOT_EOT | |
660 | # 1 <;> nextstate(main 578 (eval 15):1) v | |
661 | # 2 <0> pushmark s | |
662 | # 3 <0> pushmark s | |
663 | # 4 <$> gv(*old) s | |
664 | # 5 <1> rv2av[t5] lK/1 | |
665 | # 6 <@> sort lKS* | |
666 | # 7 <0> pushmark s | |
667 | # 8 <$> gv(*new) s | |
668 | # 9 <1> rv2av[t1] lKRM*/1 | |
669 | # a <2> aassign[t6] KS | |
670 | # b <1> leavesub[1 ref] K/REFC,1 | |
671 | EONT_EONT | |
672 | ||
673 | ||
674 | =for gentest | |
675 | ||
676 | # chunk: # force use of mergesort (not portable outside Perl 5.8) | |
677 | use sort '_mergesort'; | |
678 | @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; | |
679 | ||
680 | =cut | |
681 | ||
682 | checkOptree(note => q{}, | |
683 | bcopts => q{-exec}, | |
684 | code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; }, | |
685 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
686 | # 1 <;> nextstate(main 662 (eval 42):1) v | |
687 | # 2 <0> pushmark s | |
688 | # 3 <0> pushmark s | |
689 | # 4 <#> gv[*old] s | |
690 | # 5 <1> rv2av[t9] lK/1 | |
691 | # 6 <@> sort lKS* | |
692 | # 7 <0> pushmark s | |
693 | # 8 <#> gv[*new] s | |
694 | # 9 <1> rv2av[t2] lKRM*/1 | |
695 | # a <2> aassign[t14] KS | |
696 | # b <1> leavesub[1 ref] K/REFC,1 | |
697 | EOT_EOT | |
698 | # 1 <;> nextstate(main 578 (eval 15):1) v | |
699 | # 2 <0> pushmark s | |
700 | # 3 <0> pushmark s | |
701 | # 4 <$> gv(*old) s | |
702 | # 5 <1> rv2av[t5] lK/1 | |
703 | # 6 <@> sort lKS* | |
704 | # 7 <0> pushmark s | |
705 | # 8 <$> gv(*new) s | |
706 | # 9 <1> rv2av[t1] lKRM*/1 | |
707 | # a <2> aassign[t6] KS | |
708 | # b <1> leavesub[1 ref] K/REFC,1 | |
709 | EONT_EONT | |
710 | ||
711 | ||
712 | =for gentest | |
713 | ||
714 | # chunk: # you should have a good reason to do this! | |
715 | @articles = sort {$FooPack::b <=> $FooPack::a} @files; | |
716 | ||
717 | =cut | |
718 | ||
719 | checkOptree(note => q{}, | |
720 | bcopts => q{-exec}, | |
721 | code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; }, | |
722 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
723 | # 1 <;> nextstate(main 667 (eval 44):1) v | |
724 | # 2 <0> pushmark s | |
725 | # 3 <0> pushmark s | |
726 | # 4 <#> gv[*files] s | |
727 | # 5 <1> rv2av[t7] lK/1 | |
728 | # 6 <@> sort lKS* | |
729 | # 7 <0> pushmark s | |
730 | # 8 <#> gv[*articles] s | |
731 | # 9 <1> rv2av[t2] lKRM*/1 | |
732 | # a <2> aassign[t8] KS | |
733 | # b <1> leavesub[1 ref] K/REFC,1 | |
734 | EOT_EOT | |
735 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
736 | # 2 <0> pushmark s | |
737 | # 3 <0> pushmark s | |
738 | # 4 <$> gv(*files) s | |
739 | # 5 <1> rv2av[t3] lK/1 | |
740 | # 6 <@> sort lKS* | |
741 | # 7 <0> pushmark s | |
742 | # 8 <$> gv(*articles) s | |
743 | # 9 <1> rv2av[t1] lKRM*/1 | |
744 | # a <2> aassign[t4] KS | |
745 | # b <1> leavesub[1 ref] K/REFC,1 | |
746 | EONT_EONT | |
747 | ||
748 | ||
749 | =for gentest | |
750 | ||
751 | # chunk: # fancy | |
752 | @result = sort { $a <=> $b } grep { $_ == $_ } @input; | |
753 | ||
754 | =cut | |
755 | ||
756 | checkOptree(note => q{}, | |
757 | bcopts => q{-exec}, | |
758 | code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; }, | |
759 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
760 | # 1 <;> nextstate(main 673 (eval 46):1) v | |
761 | # 2 <0> pushmark s | |
762 | # 3 <0> pushmark s | |
763 | # 4 <0> pushmark s | |
764 | # 5 <#> gv[*input] s | |
765 | # 6 <1> rv2av[t9] lKM/1 | |
766 | # 7 <@> grepstart lK* | |
767 | # 8 <|> grepwhile(other->9)[t10] lK | |
768 | # 9 <#> gvsv[*_] s | |
769 | # a <#> gvsv[*_] s | |
770 | # b <2> eq sK/2 | |
771 | # - <@> scope sK | |
772 | # goto 8 | |
773 | # c <@> sort lK/NUM | |
774 | # d <0> pushmark s | |
775 | # e <#> gv[*result] s | |
776 | # f <1> rv2av[t2] lKRM*/1 | |
777 | # g <2> aassign[t5] KS/COMMON | |
778 | # h <1> leavesub[1 ref] K/REFC,1 | |
779 | EOT_EOT | |
780 | # 1 <;> nextstate(main 547 (eval 15):1) v | |
781 | # 2 <0> pushmark s | |
782 | # 3 <0> pushmark s | |
783 | # 4 <0> pushmark s | |
784 | # 5 <$> gv(*input) s | |
785 | # 6 <1> rv2av[t3] lKM/1 | |
786 | # 7 <@> grepstart lK* | |
787 | # 8 <|> grepwhile(other->9)[t4] lK | |
788 | # 9 <$> gvsv(*_) s | |
789 | # a <$> gvsv(*_) s | |
790 | # b <2> eq sK/2 | |
791 | # - <@> scope sK | |
792 | # goto 8 | |
793 | # c <@> sort lK/NUM | |
794 | # d <0> pushmark s | |
795 | # e <$> gv(*result) s | |
796 | # f <1> rv2av[t1] lKRM*/1 | |
797 | # g <2> aassign[t2] KS/COMMON | |
798 | # h <1> leavesub[1 ref] K/REFC,1 | |
799 | EONT_EONT | |
800 | ||
801 | ||
802 | =for gentest | |
803 | ||
804 | # chunk: # void return context sort | |
805 | sort { $a <=> $b } @input; | |
806 | ||
807 | =cut | |
808 | ||
809 | checkOptree(note => q{}, | |
810 | bcopts => q{-exec}, | |
811 | code => q{sort { $a <=> $b } @input; }, | |
812 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
813 | # 1 <;> nextstate(main 678 (eval 48):1) v | |
814 | # 2 <0> pushmark s | |
815 | # 3 <#> gv[*input] s | |
816 | # 4 <1> rv2av[t5] lK/1 | |
817 | # 5 <@> sort K/NUM | |
818 | # 6 <1> leavesub[1 ref] K/REFC,1 | |
819 | EOT_EOT | |
820 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
821 | # 2 <0> pushmark s | |
822 | # 3 <$> gv(*input) s | |
823 | # 4 <1> rv2av[t2] lK/1 | |
824 | # 5 <@> sort K/NUM | |
825 | # 6 <1> leavesub[1 ref] K/REFC,1 | |
826 | EONT_EONT | |
827 | ||
828 | ||
829 | =for gentest | |
830 | ||
831 | # chunk: # more void context, propagating ? | |
832 | sort { $a <=> $b } grep { $_ == $_ } @input; | |
833 | ||
834 | =cut | |
835 | ||
836 | checkOptree(note => q{}, | |
837 | bcopts => q{-exec}, | |
838 | code => q{sort { $a <=> $b } grep { $_ == $_ } @input; }, | |
839 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
840 | # 1 <;> nextstate(main 684 (eval 50):1) v | |
841 | # 2 <0> pushmark s | |
842 | # 3 <0> pushmark s | |
843 | # 4 <#> gv[*input] s | |
844 | # 5 <1> rv2av[t7] lKM/1 | |
845 | # 6 <@> grepstart lK* | |
846 | # 7 <|> grepwhile(other->8)[t8] lK | |
847 | # 8 <#> gvsv[*_] s | |
848 | # 9 <#> gvsv[*_] s | |
849 | # a <2> eq sK/2 | |
850 | # - <@> scope sK | |
851 | # goto 7 | |
852 | # b <@> sort K/NUM | |
853 | # c <1> leavesub[1 ref] K/REFC,1 | |
854 | EOT_EOT | |
855 | # 1 <;> nextstate(main 547 (eval 15):1) v | |
856 | # 2 <0> pushmark s | |
857 | # 3 <0> pushmark s | |
858 | # 4 <$> gv(*input) s | |
859 | # 5 <1> rv2av[t2] lKM/1 | |
860 | # 6 <@> grepstart lK* | |
861 | # 7 <|> grepwhile(other->8)[t3] lK | |
862 | # 8 <$> gvsv(*_) s | |
863 | # 9 <$> gvsv(*_) s | |
864 | # a <2> eq sK/2 | |
865 | # - <@> scope sK | |
866 | # goto 7 | |
867 | # b <@> sort K/NUM | |
868 | # c <1> leavesub[1 ref] K/REFC,1 | |
869 | EONT_EONT | |
870 | ||
871 | ||
872 | =for gentest | |
873 | ||
874 | # chunk: # scalar return context sort | |
875 | $s = sort { $a <=> $b } @input; | |
876 | ||
877 | =cut | |
878 | ||
879 | checkOptree(note => q{}, | |
880 | bcopts => q{-exec}, | |
881 | code => q{$s = sort { $a <=> $b } @input; }, | |
882 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
883 | # 1 <;> nextstate(main 689 (eval 52):1) v | |
884 | # 2 <0> pushmark s | |
885 | # 3 <#> gv[*input] s | |
886 | # 4 <1> rv2av[t6] lK/1 | |
887 | # 5 <@> sort sK/NUM | |
888 | # 6 <#> gvsv[*s] s | |
889 | # 7 <2> sassign sKS/2 | |
890 | # 8 <1> leavesub[1 ref] K/REFC,1 | |
891 | EOT_EOT | |
892 | # 1 <;> nextstate(main 546 (eval 15):1) v | |
893 | # 2 <0> pushmark s | |
894 | # 3 <$> gv(*input) s | |
895 | # 4 <1> rv2av[t2] lK/1 | |
896 | # 5 <@> sort sK/NUM | |
897 | # 6 <$> gvsv(*s) s | |
898 | # 7 <2> sassign sKS/2 | |
899 | # 8 <1> leavesub[1 ref] K/REFC,1 | |
900 | EONT_EONT | |
901 | ||
902 | ||
903 | =for gentest | |
904 | ||
905 | # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input; | |
906 | ||
907 | =cut | |
908 | ||
909 | checkOptree(note => q{}, | |
910 | bcopts => q{-exec}, | |
911 | code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; }, | |
912 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
913 | # 1 <;> nextstate(main 695 (eval 54):1) v | |
914 | # 2 <0> pushmark s | |
915 | # 3 <0> pushmark s | |
916 | # 4 <#> gv[*input] s | |
917 | # 5 <1> rv2av[t8] lKM/1 | |
918 | # 6 <@> grepstart lK* | |
919 | # 7 <|> grepwhile(other->8)[t9] lK | |
920 | # 8 <#> gvsv[*_] s | |
921 | # 9 <#> gvsv[*_] s | |
922 | # a <2> eq sK/2 | |
923 | # - <@> scope sK | |
924 | # goto 7 | |
925 | # b <@> sort sK/NUM | |
926 | # c <#> gvsv[*s] s | |
927 | # d <2> sassign sKS/2 | |
928 | # e <1> leavesub[1 ref] K/REFC,1 | |
929 | EOT_EOT | |
930 | # 1 <;> nextstate(main 547 (eval 15):1) v | |
931 | # 2 <0> pushmark s | |
932 | # 3 <0> pushmark s | |
933 | # 4 <$> gv(*input) s | |
934 | # 5 <1> rv2av[t2] lKM/1 | |
935 | # 6 <@> grepstart lK* | |
936 | # 7 <|> grepwhile(other->8)[t3] lK | |
937 | # 8 <$> gvsv(*_) s | |
938 | # 9 <$> gvsv(*_) s | |
939 | # a <2> eq sK/2 | |
940 | # - <@> scope sK | |
941 | # goto 7 | |
942 | # b <@> sort sK/NUM | |
943 | # c <$> gvsv(*s) s | |
944 | # d <2> sassign sKS/2 | |
945 | # e <1> leavesub[1 ref] K/REFC,1 | |
946 | EONT_EONT | |
947 |