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