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