5 @INC = qw(../lib ../ext/B/t);
15 #examples poached from perldoc -f sort
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.
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
27 # chunk: # sort lexically
28 @articles = sort @files;
32 checkOptree(note => q{},
34 code => q{@articles = sort @files; },
35 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36 # 1 <;> nextstate(main 545 (eval 15):1) v
40 # 5 <1> rv2av[t4] lK/1
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
48 # 1 <;> nextstate(main 545 (eval 15):1) v
52 # 5 <1> rv2av[t2] lK/1
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
64 # chunk: # same thing, but with explicit sort routine
65 @articles = sort {$a cmp $b} @files;
69 checkOptree(note => q{},
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
77 # 5 <1> rv2av[t7] lK/1
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
85 # 1 <;> nextstate(main 546 (eval 15):1) v
89 # 5 <1> rv2av[t3] lK/1
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
101 # chunk: # now case-insensitively
102 @articles = sort {uc($a) cmp uc($b)} @files;
106 checkOptree(note => q{},
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
114 # 5 <1> rv2av[t9] lK/1
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
122 # 1 <;> nextstate(main 546 (eval 15):1) v
126 # 5 <1> rv2av[t5] lK/1
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
138 # chunk: # same thing in reversed order
139 @articles = sort {$b cmp $a} @files;
143 checkOptree(note => q{},
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
151 # 5 <1> rv2av[t7] lK/1
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
159 # 1 <;> nextstate(main 546 (eval 15):1) v
163 # 5 <1> rv2av[t3] lK/1
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
175 # chunk: # sort numerically ascending
176 @articles = sort {$a <=> $b} @files;
180 checkOptree(note => q{},
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
188 # 5 <1> rv2av[t7] lK/1
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
196 # 1 <;> nextstate(main 546 (eval 15):1) v
200 # 5 <1> rv2av[t3] lK/1
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
212 # chunk: # sort numerically descending
213 @articles = sort {$b <=> $a} @files;
217 checkOptree(note => q{},
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
225 # 5 <1> rv2av[t7] lK/1
226 # 6 <@> sort lK/REV,NUM
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
233 # 1 <;> nextstate(main 546 (eval 15):1) v
237 # 5 <1> rv2av[t3] lK/1
238 # 6 <@> sort lK/REV,NUM
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
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;
255 checkOptree(note => q{},
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
263 # 5 <1> rv2hv[t9] lKRM/1
264 # 6 <1> keys[t10] lK/1
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
272 # 1 <;> nextstate(main 546 (eval 15):1) v
276 # 5 <1> rv2hv[t3] lKRM/1
277 # 6 <1> keys[t4] lK/1
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
289 # chunk: # sort using explicit subroutine name
291 $age{$a} <=> $age{$b}; # presuming numeric
293 @sortedclass = sort byage @class;
297 checkOptree(note => q{},
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
304 # 4 <$> const[PV "byage"] s/BARE
306 # 6 <1> rv2av[t4] lK/1
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
314 # 1 <;> nextstate(main 546 (eval 15):1) v
317 # 4 <$> const(PV "byage") s/BARE
319 # 6 <1> rv2av[t2] lK/1
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
331 # chunk: sub backwards { $b cmp $a }
332 @harry = qw(dog cat x Cain Abel);
333 @george = qw(gone chased yz Punished Axed);
335 # prints AbelCaincatdogx
336 print sort backwards @harry;
337 # prints xdogcatCainAbel
338 print sort @george, 'to', @harry;
339 # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
343 checkOptree(name => q{sort USERSUB LIST },
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
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
360 # a <1> rv2av[t2] lKRM*/1
361 # b <2> aassign[t3] vKS
362 # c <;> nextstate(main 602 (eval 32):3) v
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
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
377 # r <1> rv2av[t8] lK/1
380 # u <;> nextstate(main 602 (eval 32):4) v
383 # x <$> const[PV "backwards"] s/BARE
385 # z <1> rv2av[t10] lK/1
388 # 12 <;> nextstate(main 602 (eval 32):5) v
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
398 # 1c <1> leavesub[1 ref] K/REFC,1
400 # 1 <;> nextstate(main 602 (eval 32):2) v
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
409 # a <1> rv2av[t1] lKRM*/1
410 # b <2> aassign[t2] vKS
411 # c <;> nextstate(main 602 (eval 32):3) v
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
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
426 # r <1> rv2av[t5] lK/1
429 # u <;> nextstate(main 602 (eval 32):4) v
432 # x <$> const(PV "backwards") s/BARE
434 # z <1> rv2av[t6] lK/1
437 # 12 <;> nextstate(main 602 (eval 32):5) v
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
447 # 1c <1> leavesub[1 ref] K/REFC,1
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
457 $nums[$b] <=> $nums[$a]
458 || $caps[$a] cmp $caps[$b]
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;
472 checkOptree(name => q{Compound sort/map Expression },
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
484 # 7 <1> rv2av[t19] lKM/1
486 # 9 <|> mapwhile(other->a)[t20] lK
488 # b <;> nextstate(main 608 (eval 34):2) v
491 # e </> match(/"=(\\d+)"/) l/RTIME
494 # h <@> anonlist sKRM/1
500 # m <|> mapwhile(other->n)[t26] lK
502 # o <1> rv2sv sKM/DREFAV,1
503 # p <1> rv2av[t4] sKR/1
504 # q <$> const[IV 0] s
510 # u <1> rv2av[t2] lKRM*/1
511 # v <2> aassign[t27] KS/COMMON
512 # w <1> leavesub[1 ref] K/REFC,1
514 # 1 <;> nextstate(main 609 (eval 34):3) v
520 # 7 <1> rv2av[t10] lKM/1
522 # 9 <|> mapwhile(other->a)[t11] lK
524 # b <;> nextstate(main 608 (eval 34):2) v
527 # e </> match(/"=(\\d+)"/) l/RTIME
530 # h <@> anonlist sKRM/1
536 # m <|> mapwhile(other->n)[t12] lK
538 # o <1> rv2sv sKM/DREFAV,1
539 # p <1> rv2av[t2] sKR/1
540 # q <$> const(IV 0) s
546 # u <1> rv2av[t1] lKRM*/1
547 # v <2> aassign[t13] KS/COMMON
548 # w <1> leavesub[1 ref] K/REFC,1
554 # chunk: # using a prototype allows you to use any comparison subroutine
555 # as a sort subroutine (including other package's subroutines)
557 sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
559 @new = sort other::backwards @old;
563 checkOptree(name => q{sort other::sub LIST },
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
571 # 4 <$> const[PV "other::backwards"] s/BARE
573 # 6 <1> rv2av[t4] lK/1
577 # a <1> rv2av[t2] lKRM*/1
578 # b <2> aassign[t5] KS
579 # c <1> leavesub[1 ref] K/REFC,1
581 # 1 <;> nextstate(main 614 (eval 36):2) v
584 # 4 <$> const(PV "other::backwards") s/BARE
586 # 6 <1> rv2av[t2] lK/1
590 # a <1> rv2av[t1] lKRM*/1
591 # b <2> aassign[t3] KS
592 # c <1> leavesub[1 ref] K/REFC,1
598 # chunk: # repeat, condensed. $main::a and $b are unaffected
599 sub other::backwards ($$) { $_[1] cmp $_[0]; }
600 @new = sort other::backwards @old;
604 checkOptree(note => q{},
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
611 # 4 <$> const[PV "other::backwards"] s/BARE
613 # 6 <1> rv2av[t4] lK/1
617 # a <1> rv2av[t2] lKRM*/1
618 # b <2> aassign[t5] KS
619 # c <1> leavesub[1 ref] K/REFC,1
621 # 1 <;> nextstate(main 546 (eval 15):1) v
624 # 4 <$> const(PV "other::backwards") s/BARE
626 # 6 <1> rv2av[t2] lK/1
630 # a <1> rv2av[t1] lKRM*/1
631 # b <2> aassign[t3] KS
632 # c <1> leavesub[1 ref] K/REFC,1
638 # chunk: # guarantee stability, regardless of algorithm
640 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
644 checkOptree(note => q{},
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
652 # 5 <1> rv2av[t9] lK/1
656 # 9 <1> rv2av[t2] lKRM*/1
657 # a <2> aassign[t14] KS
658 # b <1> leavesub[1 ref] K/REFC,1
660 # 1 <;> nextstate(main 578 (eval 15):1) v
664 # 5 <1> rv2av[t5] lK/1
668 # 9 <1> rv2av[t1] lKRM*/1
669 # a <2> aassign[t6] KS
670 # b <1> leavesub[1 ref] K/REFC,1
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;
682 checkOptree(note => q{},
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
690 # 5 <1> rv2av[t9] lK/1
694 # 9 <1> rv2av[t2] lKRM*/1
695 # a <2> aassign[t14] KS
696 # b <1> leavesub[1 ref] K/REFC,1
698 # 1 <;> nextstate(main 578 (eval 15):1) v
702 # 5 <1> rv2av[t5] lK/1
706 # 9 <1> rv2av[t1] lKRM*/1
707 # a <2> aassign[t6] KS
708 # b <1> leavesub[1 ref] K/REFC,1
714 # chunk: # you should have a good reason to do this!
715 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
719 checkOptree(note => q{},
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
727 # 5 <1> rv2av[t7] lK/1
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
735 # 1 <;> nextstate(main 546 (eval 15):1) v
739 # 5 <1> rv2av[t3] lK/1
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
752 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
756 checkOptree(note => q{},
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
765 # 6 <1> rv2av[t9] lKM/1
766 # 7 <@> grepstart lK*
767 # 8 <|> grepwhile(other->9)[t10] lK
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
780 # 1 <;> nextstate(main 547 (eval 15):1) v
785 # 6 <1> rv2av[t3] lKM/1
786 # 7 <@> grepstart lK*
787 # 8 <|> grepwhile(other->9)[t4] lK
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
804 # chunk: # void return context sort
805 sort { $a <=> $b } @input;
809 checkOptree(note => q{},
811 code => q{sort { $a <=> $b } @input; },
812 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
813 # 1 <;> nextstate(main 678 (eval 48):1) v
816 # 4 <1> rv2av[t5] lK/1
818 # 6 <1> leavesub[1 ref] K/REFC,1
820 # 1 <;> nextstate(main 546 (eval 15):1) v
823 # 4 <1> rv2av[t2] lK/1
825 # 6 <1> leavesub[1 ref] K/REFC,1
831 # chunk: # more void context, propagating ?
832 sort { $a <=> $b } grep { $_ == $_ } @input;
836 checkOptree(note => q{},
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
844 # 5 <1> rv2av[t7] lKM/1
845 # 6 <@> grepstart lK*
846 # 7 <|> grepwhile(other->8)[t8] lK
853 # c <1> leavesub[1 ref] K/REFC,1
855 # 1 <;> nextstate(main 547 (eval 15):1) v
859 # 5 <1> rv2av[t2] lKM/1
860 # 6 <@> grepstart lK*
861 # 7 <|> grepwhile(other->8)[t3] lK
868 # c <1> leavesub[1 ref] K/REFC,1
874 # chunk: # scalar return context sort
875 $s = sort { $a <=> $b } @input;
879 checkOptree(note => q{},
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
886 # 4 <1> rv2av[t6] lK/1
889 # 7 <2> sassign sKS/2
890 # 8 <1> leavesub[1 ref] K/REFC,1
892 # 1 <;> nextstate(main 546 (eval 15):1) v
895 # 4 <1> rv2av[t2] lK/1
898 # 7 <2> sassign sKS/2
899 # 8 <1> leavesub[1 ref] K/REFC,1
905 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
909 checkOptree(note => q{},
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
917 # 5 <1> rv2av[t8] lKM/1
918 # 6 <@> grepstart lK*
919 # 7 <|> grepwhile(other->8)[t9] lK
927 # d <2> sassign sKS/2
928 # e <1> leavesub[1 ref] K/REFC,1
930 # 1 <;> nextstate(main 547 (eval 15):1) v
934 # 5 <1> rv2av[t2] lKM/1
935 # 6 <@> grepstart lK*
936 # 7 <|> grepwhile(other->8)[t3] lK
944 # d <2> sassign sKS/2
945 # e <1> leavesub[1 ref] K/REFC,1