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