This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
58a8cf2eed2224d8f43482d40e56cc6f4c0d0fd4
[perl5.git] / ext / B / t / f_sort.t
1 #!perl
2
3 BEGIN {
4     unshift @INC, 't';
5     require Config;
6     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7         print "1..0 # Skip -- Perl configured without B module\n";
8         exit 0;
9     }
10     if (!$Config::Config{useperlio}) {
11         print "1..0 # Skip -- need perlio to walk the optree\n";
12         exit 0;
13     }
14 }
15 use OptreeCheck;
16 plan tests => 40;
17
18 =head1 f_sort.t
19
20 Code test snippets here are adapted from `perldoc -f map`
21
22 Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
23 (map|grep)(start|while) opcodes have different flags in 5.9, their
24 private flags /1, /2 are gone in blead (for the cases covered)
25
26 When the optree stuff was integrated into 5.8.6, these tests failed,
27 and were todo'd.  They're now done, by version-specific tweaking in
28 mkCheckRex(), therefore the skip is removed too.
29
30 =head1 Test Notes
31
32 # chunk: #!perl
33 #examples poached from perldoc -f sort
34
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
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/COMMON
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/COMMON
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[t3] KS/COMMON
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/COMMON
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/COMMON
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/COMMON
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
170 # 6  <@> sort lK/DESC
171 # 7  <0> pushmark s
172 # 8  <#> gv[*articles] s
173 # 9  <1> rv2av[t2] lKRM*/1
174 # a  <2> aassign[t3] KS/COMMON
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
182 # 6  <@> sort lK/DESC
183 # 7  <0> pushmark s
184 # 8  <$> gv(*articles) s
185 # 9  <1> rv2av[t1] lKRM*/1
186 # a  <2> aassign[t2] KS/COMMON
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[t3] KS/COMMON
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/COMMON
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
244 # 6  <@> sort lK/DESC,NUM
245 # 7  <0> pushmark s
246 # 8  <#> gv[*articles] s
247 # 9  <1> rv2av[t2] lKRM*/1
248 # a  <2> aassign[t3] KS/COMMON
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
256 # 6  <@> sort lK/DESC,NUM
257 # 7  <0> pushmark s
258 # 8  <$> gv(*articles) s
259 # 9  <1> rv2av[t1] lKRM*/1
260 # a  <2> aassign[t2] KS/COMMON
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/COMMON
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/COMMON
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/COMMON
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/COMMON
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
361 checkOptree(name   => q{sort USERSUB LIST },
362             bcopts => q{-exec},
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
490 checkOptree(name   => q{Compound sort/map Expression },
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 sK*/1
513 # i      <@> leave lKP
514 #            goto 9
515 # j  <@> sort lKMS*
516 # k  <@> mapstart lK*
517 # l  <|> mapwhile(other->m)[t26] lK
518 # m      <#> gv[*_] s
519 # n      <1> rv2sv sKM/DREFAV,1
520 # o      <1> rv2av[t4] sKR/1
521 # p      <$> const[IV 0] s
522 # q      <2> aelem sK/2
523 # -      <@> scope lK
524 #            goto l
525 # r  <0> pushmark s
526 # s  <#> gv[*new] s
527 # t  <1> rv2av[t2] lKRM*/1
528 # u  <2> aassign[t27] KS/COMMON
529 # v  <1> leavesub[1 ref] K/REFC,1
530 EOT_EOT
531 # 1  <;> nextstate(main 609 (eval 34):3) v:{
532 # 2  <0> pushmark s
533 # 3  <0> pushmark s
534 # 4  <0> pushmark s
535 # 5  <0> pushmark s
536 # 6  <$> gv(*old) s
537 # 7  <1> rv2av[t10] lKM/1
538 # 8  <@> mapstart lK*
539 # 9  <|> mapwhile(other->a)[t11] lK
540 # a      <0> enter l
541 # b      <;> nextstate(main 608 (eval 34):2) v:{
542 # c      <0> pushmark s
543 # d      <$> gvsv(*_) s
544 # e      </> match(/"=(\\d+)"/) l/RTIME
545 # f      <$> gvsv(*_) s
546 # g      <1> uc[t9] sK/1
547 # h      <@> anonlist sK*/1
548 # i      <@> leave lKP
549 #            goto 9
550 # j  <@> sort lKMS*
551 # k  <@> mapstart lK*
552 # l  <|> mapwhile(other->m)[t12] lK
553 # m      <$> gv(*_) s
554 # n      <1> rv2sv sKM/DREFAV,1
555 # o      <1> rv2av[t2] sKR/1
556 # p      <$> const(IV 0) s
557 # q      <2> aelem sK/2
558 # -      <@> scope lK
559 #            goto l
560 # r  <0> pushmark s
561 # s  <$> gv(*new) s
562 # t  <1> rv2av[t1] lKRM*/1
563 # u  <2> aassign[t13] KS/COMMON
564 # v  <1> leavesub[1 ref] K/REFC,1
565 EONT_EONT
566     
567
568 =for gentest
569
570 # chunk: # using a prototype allows you to use any comparison subroutine
571 # as a sort subroutine (including other package's subroutines)
572 package other;
573 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
574 package main;
575 @new = sort other::backwards @old;
576
577 =cut
578
579 checkOptree(name   => q{sort other::sub LIST },
580             bcopts => q{-exec},
581             code   => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
582                         package main; @new = sort other::backwards @old; },
583             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
584 # 1  <;> nextstate(main 614 (eval 36):2) v:{
585 # 2  <0> pushmark s
586 # 3  <0> pushmark s
587 # 4  <$> const[PV "other::backwards"] s/BARE
588 # 5  <#> gv[*old] s
589 # 6  <1> rv2av[t4] lK/1
590 # 7  <@> sort lKS
591 # 8  <0> pushmark s
592 # 9  <#> gv[*new] s
593 # a  <1> rv2av[t2] lKRM*/1
594 # b  <2> aassign[t5] KS/COMMON
595 # c  <1> leavesub[1 ref] K/REFC,1
596 EOT_EOT
597 # 1  <;> nextstate(main 614 (eval 36):2) v:{
598 # 2  <0> pushmark s
599 # 3  <0> pushmark s
600 # 4  <$> const(PV "other::backwards") s/BARE
601 # 5  <$> gv(*old) s
602 # 6  <1> rv2av[t2] lK/1
603 # 7  <@> sort lKS
604 # 8  <0> pushmark s
605 # 9  <$> gv(*new) s
606 # a  <1> rv2av[t1] lKRM*/1
607 # b  <2> aassign[t3] KS/COMMON
608 # c  <1> leavesub[1 ref] K/REFC,1
609 EONT_EONT
610     
611
612 =for gentest
613
614 # chunk: # repeat, condensed. $main::a and $b are unaffected
615 sub other::backwards ($$) { $_[1] cmp $_[0]; }
616 @new = sort other::backwards @old;
617
618 =cut
619
620 checkOptree(note   => q{},
621             bcopts => q{-exec},
622             code   => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
623             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
624 # 1  <;> nextstate(main 619 (eval 38):1) v
625 # 2  <0> pushmark s
626 # 3  <0> pushmark s
627 # 4  <$> const[PV "other::backwards"] s/BARE
628 # 5  <#> gv[*old] s
629 # 6  <1> rv2av[t4] lK/1
630 # 7  <@> sort lKS
631 # 8  <0> pushmark s
632 # 9  <#> gv[*new] s
633 # a  <1> rv2av[t2] lKRM*/1
634 # b  <2> aassign[t5] KS/COMMON
635 # c  <1> leavesub[1 ref] K/REFC,1
636 EOT_EOT
637 # 1  <;> nextstate(main 546 (eval 15):1) v
638 # 2  <0> pushmark s
639 # 3  <0> pushmark s
640 # 4  <$> const(PV "other::backwards") s/BARE
641 # 5  <$> gv(*old) s
642 # 6  <1> rv2av[t2] lK/1
643 # 7  <@> sort lKS
644 # 8  <0> pushmark s
645 # 9  <$> gv(*new) s
646 # a  <1> rv2av[t1] lKRM*/1
647 # b  <2> aassign[t3] KS/COMMON
648 # c  <1> leavesub[1 ref] K/REFC,1
649 EONT_EONT
650     
651
652 =for gentest
653
654 # chunk: # guarantee stability, regardless of algorithm
655 use sort 'stable';
656 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
657
658 =cut
659
660 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
661 # 1  <;> nextstate(main 656 (eval 40):1) v:%,{
662 # 2  <0> pushmark s
663 # 3  <0> pushmark s
664 # 4  <#> gv[*old] s
665 # 5  <1> rv2av[t9] lK/1
666 # 6  <@> sort lKS*/STABLE
667 # 7  <0> pushmark s
668 # 8  <#> gv[*new] s
669 # 9  <1> rv2av[t2] lKRM*/1
670 # a  <2> aassign[t14] KS/COMMON
671 # b  <1> leavesub[1 ref] K/REFC,1
672 EOT_EOT
673 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
674 # 2  <0> pushmark s
675 # 3  <0> pushmark s
676 # 4  <$> gv(*old) s
677 # 5  <1> rv2av[t5] lK/1
678 # 6  <@> sort lKS*/STABLE
679 # 7  <0> pushmark s
680 # 8  <$> gv(*new) s
681 # 9  <1> rv2av[t1] lKRM*/1
682 # a  <2> aassign[t6] KS/COMMON
683 # b  <1> leavesub[1 ref] K/REFC,1
684 EONT_EONT
685
686 if($] < 5.009) {
687     # 5.8.x doesn't show the /STABLE flag, so massage the golden results.
688     s!/STABLE!!s foreach ($expect, $expect_nt);
689 }
690
691 checkOptree(note   => q{},
692             bcopts => q{-exec},
693             code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
694             expect => $expect, expect_nt => $expect_nt);
695
696 =for gentest
697
698 # chunk: # force use of mergesort (not portable outside Perl 5.8)
699 use sort '_mergesort';
700 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
701
702 =cut
703
704 checkOptree(note   => q{},
705             bcopts => q{-exec},
706             code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
707             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
708 # 1  <;> nextstate(main 662 (eval 42):1) v:%,{
709 # 2  <0> pushmark s
710 # 3  <0> pushmark s
711 # 4  <#> gv[*old] s
712 # 5  <1> rv2av[t9] lK/1
713 # 6  <@> sort lKS*
714 # 7  <0> pushmark s
715 # 8  <#> gv[*new] s
716 # 9  <1> rv2av[t2] lKRM*/1
717 # a  <2> aassign[t14] KS/COMMON
718 # b  <1> leavesub[1 ref] K/REFC,1
719 EOT_EOT
720 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
721 # 2  <0> pushmark s
722 # 3  <0> pushmark s
723 # 4  <$> gv(*old) s
724 # 5  <1> rv2av[t5] lK/1
725 # 6  <@> sort lKS*
726 # 7  <0> pushmark s
727 # 8  <$> gv(*new) s
728 # 9  <1> rv2av[t1] lKRM*/1
729 # a  <2> aassign[t6] KS/COMMON
730 # b  <1> leavesub[1 ref] K/REFC,1
731 EONT_EONT
732     
733
734 =for gentest
735
736 # chunk: # you should have a good reason to do this!
737 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
738
739 =cut
740
741 checkOptree(note   => q{},
742             bcopts => q{-exec},
743             code   => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
744             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
745 # 1  <;> nextstate(main 667 (eval 44):1) v
746 # 2  <0> pushmark s
747 # 3  <0> pushmark s
748 # 4  <#> gv[*files] s
749 # 5  <1> rv2av[t7] lK/1
750 # 6  <@> sort lKS*
751 # 7  <0> pushmark s
752 # 8  <#> gv[*articles] s
753 # 9  <1> rv2av[t2] lKRM*/1
754 # a  <2> aassign[t8] KS/COMMON
755 # b  <1> leavesub[1 ref] K/REFC,1
756 EOT_EOT
757 # 1  <;> nextstate(main 546 (eval 15):1) v
758 # 2  <0> pushmark s
759 # 3  <0> pushmark s
760 # 4  <$> gv(*files) s
761 # 5  <1> rv2av[t3] lK/1
762 # 6  <@> sort lKS*
763 # 7  <0> pushmark s
764 # 8  <$> gv(*articles) s
765 # 9  <1> rv2av[t1] lKRM*/1
766 # a  <2> aassign[t4] KS/COMMON
767 # b  <1> leavesub[1 ref] K/REFC,1
768 EONT_EONT
769     
770
771 =for gentest
772
773 # chunk: # fancy
774 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
775
776 =cut
777
778 checkOptree(note   => q{},
779             bcopts => q{-exec},
780             code   => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
781             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
782 # 1  <;> nextstate(main 673 (eval 46):1) v
783 # 2  <0> pushmark s
784 # 3  <0> pushmark s
785 # 4  <0> pushmark s
786 # 5  <#> gv[*input] s
787 # 6  <1> rv2av[t9] lKM/1
788 # 7  <@> grepstart lK*
789 # 8  <|> grepwhile(other->9)[t10] lK
790 # 9      <#> gvsv[*_] s
791 # a      <#> gvsv[*_] s
792 # b      <2> eq sK/2
793 # -      <@> scope sK
794 #            goto 8
795 # c  <@> sort lK/NUM
796 # d  <0> pushmark s
797 # e  <#> gv[*result] s
798 # f  <1> rv2av[t2] lKRM*/1
799 # g  <2> aassign[t3] KS/COMMON
800 # h  <1> leavesub[1 ref] K/REFC,1
801 EOT_EOT
802 # 1  <;> nextstate(main 547 (eval 15):1) v
803 # 2  <0> pushmark s
804 # 3  <0> pushmark s
805 # 4  <0> pushmark s
806 # 5  <$> gv(*input) s
807 # 6  <1> rv2av[t3] lKM/1
808 # 7  <@> grepstart lK*
809 # 8  <|> grepwhile(other->9)[t4] lK
810 # 9      <$> gvsv(*_) s
811 # a      <$> gvsv(*_) s
812 # b      <2> eq sK/2
813 # -      <@> scope sK
814 #            goto 8
815 # c  <@> sort lK/NUM
816 # d  <0> pushmark s
817 # e  <$> gv(*result) s
818 # f  <1> rv2av[t1] lKRM*/1
819 # g  <2> aassign[t2] KS/COMMON
820 # h  <1> leavesub[1 ref] K/REFC,1
821 EONT_EONT
822     
823
824 =for gentest
825
826 # chunk: # void return context sort
827 sort { $a <=> $b } @input;
828
829 =cut
830
831 checkOptree(note   => q{},
832             bcopts => q{-exec},
833             code   => q{sort { $a <=> $b } @input; },
834             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
835 # 1  <;> nextstate(main 678 (eval 48):1) v
836 # 2  <0> pushmark s
837 # 3  <#> gv[*input] s
838 # 4  <1> rv2av[t5] lK/1
839 # 5  <@> sort K/NUM
840 # 6  <1> leavesub[1 ref] K/REFC,1
841 EOT_EOT
842 # 1  <;> nextstate(main 546 (eval 15):1) v
843 # 2  <0> pushmark s
844 # 3  <$> gv(*input) s
845 # 4  <1> rv2av[t2] lK/1
846 # 5  <@> sort K/NUM
847 # 6  <1> leavesub[1 ref] K/REFC,1
848 EONT_EONT
849     
850
851 =for gentest
852
853 # chunk: # more void context, propagating ?
854 sort { $a <=> $b } grep { $_ == $_ } @input;
855
856 =cut
857
858 checkOptree(note   => q{},
859             bcopts => q{-exec},
860             code   => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
861             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
862 # 1  <;> nextstate(main 684 (eval 50):1) v
863 # 2  <0> pushmark s
864 # 3  <0> pushmark s
865 # 4  <#> gv[*input] s
866 # 5  <1> rv2av[t7] lKM/1
867 # 6  <@> grepstart lK*
868 # 7  <|> grepwhile(other->8)[t8] lK
869 # 8      <#> gvsv[*_] s
870 # 9      <#> gvsv[*_] s
871 # a      <2> eq sK/2
872 # -      <@> scope sK
873 #            goto 7
874 # b  <@> sort K/NUM
875 # c  <1> leavesub[1 ref] K/REFC,1
876 EOT_EOT
877 # 1  <;> nextstate(main 547 (eval 15):1) v
878 # 2  <0> pushmark s
879 # 3  <0> pushmark s
880 # 4  <$> gv(*input) s
881 # 5  <1> rv2av[t2] lKM/1
882 # 6  <@> grepstart lK*
883 # 7  <|> grepwhile(other->8)[t3] lK
884 # 8      <$> gvsv(*_) s
885 # 9      <$> gvsv(*_) s
886 # a      <2> eq sK/2
887 # -      <@> scope sK
888 #            goto 7
889 # b  <@> sort K/NUM
890 # c  <1> leavesub[1 ref] K/REFC,1
891 EONT_EONT
892     
893
894 =for gentest
895
896 # chunk: # scalar return context sort
897 $s = sort { $a <=> $b } @input;
898
899 =cut
900
901 checkOptree(note   => q{},
902             bcopts => q{-exec},
903             code   => q{$s = sort { $a <=> $b } @input; },
904             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
905 # 1  <;> nextstate(main 689 (eval 52):1) v:{
906 # 2  <0> pushmark s
907 # 3  <#> gv[*input] s
908 # 4  <1> rv2av[t6] lK/1
909 # 5  <@> sort sK/NUM
910 # 6  <#> gvsv[*s] s
911 # 7  <2> sassign sKS/2
912 # 8  <1> leavesub[1 ref] K/REFC,1
913 EOT_EOT
914 # 1  <;> nextstate(main 546 (eval 15):1) v:{
915 # 2  <0> pushmark s
916 # 3  <$> gv(*input) s
917 # 4  <1> rv2av[t2] lK/1
918 # 5  <@> sort sK/NUM
919 # 6  <$> gvsv(*s) s
920 # 7  <2> sassign sKS/2
921 # 8  <1> leavesub[1 ref] K/REFC,1
922 EONT_EONT
923     
924
925 =for gentest
926
927 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
928
929 =cut
930
931 checkOptree(note   => q{},
932             bcopts => q{-exec},
933             code   => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
934             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
935 # 1  <;> nextstate(main 695 (eval 54):1) v:{
936 # 2  <0> pushmark s
937 # 3  <0> pushmark s
938 # 4  <#> gv[*input] s
939 # 5  <1> rv2av[t8] lKM/1
940 # 6  <@> grepstart lK*
941 # 7  <|> grepwhile(other->8)[t9] lK
942 # 8      <#> gvsv[*_] s
943 # 9      <#> gvsv[*_] s
944 # a      <2> eq sK/2
945 # -      <@> scope sK
946 #            goto 7
947 # b  <@> sort sK/NUM
948 # c  <#> gvsv[*s] s
949 # d  <2> sassign sKS/2
950 # e  <1> leavesub[1 ref] K/REFC,1
951 EOT_EOT
952 # 1  <;> nextstate(main 547 (eval 15):1) v:{
953 # 2  <0> pushmark s
954 # 3  <0> pushmark s
955 # 4  <$> gv(*input) s
956 # 5  <1> rv2av[t2] lKM/1
957 # 6  <@> grepstart lK*
958 # 7  <|> grepwhile(other->8)[t3] lK
959 # 8      <$> gvsv(*_) s
960 # 9      <$> gvsv(*_) s
961 # a      <2> eq sK/2
962 # -      <@> scope sK
963 #            goto 7
964 # b  <@> sort sK/NUM
965 # c  <$> gvsv(*s) s
966 # d  <2> sassign sKS/2
967 # e  <1> leavesub[1 ref] K/REFC,1
968 EONT_EONT
969