This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move all the xxxpvs() macros to handy.h.
[perl5.git] / ext / B / t / f_sort.t
CommitLineData
cc02ea56
JC
1#!perl
2
3BEGIN {
5638aaac
SM
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
NC
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
NC
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
JC
21}
22use OptreeCheck;
23plan tests => 20;
24
19e169bf
JC
25=head1 f_sort.t
26
27Code test snippets here are adapted from `perldoc -f map`
28
29Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
30(map|grep)(start|while) opcodes have different flags in 5.9, their
31private flags /1, /2 are gone in blead (for the cases covered)
32
33When the optree stuff was integrated into 5.8.6, these tests failed,
34and were todo'd. Theyre now done, by version-specific tweaking in
35mkCheckRex(), therefore the skip is removed too.
cc02ea56 36
7ce9b5fb 37=head1 Test Notes
cc02ea56
JC
38
39# chunk: #!perl
40#examples poached from perldoc -f sort
41
7ce9b5fb
JC
42NOTE: name is no longer a required arg for checkOptree, as label is
43synthesized out of others. HOWEVER, if the test-code has newlines in
44it, the label must be overridden by an explicit name.
45
46This is because t/TEST is quite particular about the test output it
47processes, and multi-line labels violate its 1-line-per-test
48expectations.
49
cc02ea56
JC
50=for gentest
51
52# chunk: # sort lexically
53@articles = sort @files;
54
55=cut
56
57checkOptree(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
JC
71# b <1> leavesub[1 ref] K/REFC,1
72EOT_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
JC
83# b <1> leavesub[1 ref] K/REFC,1
84EONT_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
94checkOptree(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
JC
108# b <1> leavesub[1 ref] K/REFC,1
109EOT_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
JC
120# b <1> leavesub[1 ref] K/REFC,1
121EONT_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
131checkOptree(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
JC
145# b <1> leavesub[1 ref] K/REFC,1
146EOT_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
JC
157# b <1> leavesub[1 ref] K/REFC,1
158EONT_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
168checkOptree(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
JC
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
JC
182# b <1> leavesub[1 ref] K/REFC,1
183EOT_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
JC
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
JC
194# b <1> leavesub[1 ref] K/REFC,1
195EONT_EONT
196
197
198=for gentest
199
200# chunk: # sort numerically ascending
201@articles = sort {$a <=> $b} @files;
202
203=cut
204
205checkOptree(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
JC
219# b <1> leavesub[1 ref] K/REFC,1
220EOT_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
JC
231# b <1> leavesub[1 ref] K/REFC,1
232EONT_EONT
233
234
235=for gentest
236
237# chunk: # sort numerically descending
238@articles = sort {$b <=> $a} @files;
239
240=cut
241
242checkOptree(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
JC
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
JC
256# b <1> leavesub[1 ref] K/REFC,1
257EOT_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
JC
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
JC
268# b <1> leavesub[1 ref] K/REFC,1
269EONT_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
280checkOptree(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
JC
295# c <1> leavesub[1 ref] K/REFC,1
296EOT_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
JC
308# c <1> leavesub[1 ref] K/REFC,1
309EONT_EONT
310
311
312=for gentest
313
314# chunk: # sort using explicit subroutine name
315sub byage {
316 $age{$a} <=> $age{$b}; # presuming numeric
317}
318@sortedclass = sort byage @class;
319
320=cut
321
322checkOptree(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
JC
337# c <1> leavesub[1 ref] K/REFC,1
338EOT_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
JC
350# c <1> leavesub[1 ref] K/REFC,1
351EONT_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);
359print sort @harry;
360# prints AbelCaincatdogx
361print sort backwards @harry;
362# prints xdogcatCainAbel
363print sort @george, 'to', @harry;
364# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
365
366=cut
367
7ce9b5fb 368checkOptree(name => q{sort USERSUB LIST },
cc02ea56 369 bcopts => q{-exec},
cc02ea56
JC
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
398# n <;> nextstate(main 602 (eval 32):4) v
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
405# u <;> nextstate(main 602 (eval 32):4) v
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
413# 12 <;> nextstate(main 602 (eval 32):5) v
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
424EOT_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
447# n <;> nextstate(main 602 (eval 32):4) v
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
454# u <;> nextstate(main 602 (eval 32):4) v
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
462# 12 <;> nextstate(main 602 (eval 32):5) v
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
473EONT_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] }
491sort { $b->[1] <=> $a->[1]
492 || $a->[2] cmp $b->[2]
493 } map { [$_, /=(\d+)/, uc($_)] } @old;
494
495=cut
496
7ce9b5fb 497checkOptree(name => q{Compound sort/map Expression },
cc02ea56
JC
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');
503# 1 <;> nextstate(main 609 (eval 34):3) v
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
513# b <;> nextstate(main 608 (eval 34):2) v
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
519# h <@> anonlist sKRM/1
520# i <1> srefgen sK/1
521# j <@> leave lKP
522# goto 9
523# k <@> sort lKMS*
524# l <@> mapstart lK*
525# m <|> mapwhile(other->n)[t26] lK
526# n <#> gv[*_] s
527# o <1> rv2sv sKM/DREFAV,1
528# p <1> rv2av[t4] sKR/1
529# q <$> const[IV 0] s
530# r <2> aelem sK/2
531# - <@> scope lK
532# goto m
533# s <0> pushmark s
534# t <#> gv[*new] s
535# u <1> rv2av[t2] lKRM*/1
536# v <2> aassign[t27] KS/COMMON
537# w <1> leavesub[1 ref] K/REFC,1
538EOT_EOT
539# 1 <;> nextstate(main 609 (eval 34):3) v
540# 2 <0> pushmark s
541# 3 <0> pushmark s
542# 4 <0> pushmark s
543# 5 <0> pushmark s
544# 6 <$> gv(*old) s
545# 7 <1> rv2av[t10] lKM/1
546# 8 <@> mapstart lK*
547# 9 <|> mapwhile(other->a)[t11] lK
548# a <0> enter l
549# b <;> nextstate(main 608 (eval 34):2) v
550# c <0> pushmark s
551# d <$> gvsv(*_) s
552# e </> match(/"=(\\d+)"/) l/RTIME
553# f <$> gvsv(*_) s
554# g <1> uc[t9] sK/1
555# h <@> anonlist sKRM/1
556# i <1> srefgen sK/1
557# j <@> leave lKP
558# goto 9
559# k <@> sort lKMS*
560# l <@> mapstart lK*
561# m <|> mapwhile(other->n)[t12] lK
562# n <$> gv(*_) s
563# o <1> rv2sv sKM/DREFAV,1
564# p <1> rv2av[t2] sKR/1
565# q <$> const(IV 0) s
566# r <2> aelem sK/2
567# - <@> scope lK
568# goto m
569# s <0> pushmark s
570# t <$> gv(*new) s
571# u <1> rv2av[t1] lKRM*/1
572# v <2> aassign[t13] KS/COMMON
573# w <1> leavesub[1 ref] K/REFC,1
574EONT_EONT
575
576
577=for gentest
578
579# chunk: # using a prototype allows you to use any comparison subroutine
580# as a sort subroutine (including other package's subroutines)
581package other;
582sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
583package main;
584@new = sort other::backwards @old;
585
586=cut
587
7ce9b5fb 588checkOptree(name => q{sort other::sub LIST },
cc02ea56
JC
589 bcopts => q{-exec},
590 code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
591 package main; @new = sort other::backwards @old; },
592 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
593# 1 <;> nextstate(main 614 (eval 36):2) v
594# 2 <0> pushmark s
595# 3 <0> pushmark s
596# 4 <$> const[PV "other::backwards"] s/BARE
597# 5 <#> gv[*old] s
598# 6 <1> rv2av[t4] lK/1
599# 7 <@> sort lKS
600# 8 <0> pushmark s
601# 9 <#> gv[*new] s
602# a <1> rv2av[t2] lKRM*/1
9e84f099 603# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
604# c <1> leavesub[1 ref] K/REFC,1
605EOT_EOT
606# 1 <;> nextstate(main 614 (eval 36):2) v
607# 2 <0> pushmark s
608# 3 <0> pushmark s
609# 4 <$> const(PV "other::backwards") s/BARE
610# 5 <$> gv(*old) s
611# 6 <1> rv2av[t2] lK/1
612# 7 <@> sort lKS
613# 8 <0> pushmark s
614# 9 <$> gv(*new) s
615# a <1> rv2av[t1] lKRM*/1
9e84f099 616# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
617# c <1> leavesub[1 ref] K/REFC,1
618EONT_EONT
619
620
621=for gentest
622
623# chunk: # repeat, condensed. $main::a and $b are unaffected
624sub other::backwards ($$) { $_[1] cmp $_[0]; }
625@new = sort other::backwards @old;
626
627=cut
628
629checkOptree(note => q{},
630 bcopts => q{-exec},
631 code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
632 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
633# 1 <;> nextstate(main 619 (eval 38):1) v
634# 2 <0> pushmark s
635# 3 <0> pushmark s
636# 4 <$> const[PV "other::backwards"] s/BARE
637# 5 <#> gv[*old] s
638# 6 <1> rv2av[t4] lK/1
639# 7 <@> sort lKS
640# 8 <0> pushmark s
641# 9 <#> gv[*new] s
642# a <1> rv2av[t2] lKRM*/1
9e84f099 643# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
644# c <1> leavesub[1 ref] K/REFC,1
645EOT_EOT
646# 1 <;> nextstate(main 546 (eval 15):1) v
647# 2 <0> pushmark s
648# 3 <0> pushmark s
649# 4 <$> const(PV "other::backwards") s/BARE
650# 5 <$> gv(*old) s
651# 6 <1> rv2av[t2] lK/1
652# 7 <@> sort lKS
653# 8 <0> pushmark s
654# 9 <$> gv(*new) s
655# a <1> rv2av[t1] lKRM*/1
9e84f099 656# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
657# c <1> leavesub[1 ref] K/REFC,1
658EONT_EONT
659
660
661=for gentest
662
663# chunk: # guarantee stability, regardless of algorithm
664use sort 'stable';
665@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
666
667=cut
668
669checkOptree(note => q{},
670 bcopts => q{-exec},
671 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
672 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
673# 1 <;> nextstate(main 656 (eval 40):1) v
674# 2 <0> pushmark s
675# 3 <0> pushmark s
676# 4 <#> gv[*old] s
677# 5 <1> rv2av[t9] lK/1
7b9ef140 678# 6 <@> sort lKS*/STABLE
cc02ea56
JC
679# 7 <0> pushmark s
680# 8 <#> gv[*new] s
681# 9 <1> rv2av[t2] lKRM*/1
9e84f099 682# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
683# b <1> leavesub[1 ref] K/REFC,1
684EOT_EOT
685# 1 <;> nextstate(main 578 (eval 15):1) v
686# 2 <0> pushmark s
687# 3 <0> pushmark s
688# 4 <$> gv(*old) s
689# 5 <1> rv2av[t5] lK/1
7b9ef140 690# 6 <@> sort lKS*/STABLE
cc02ea56
JC
691# 7 <0> pushmark s
692# 8 <$> gv(*new) s
693# 9 <1> rv2av[t1] lKRM*/1
9e84f099 694# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
695# b <1> leavesub[1 ref] K/REFC,1
696EONT_EONT
697
698
699=for gentest
700
701# chunk: # force use of mergesort (not portable outside Perl 5.8)
702use sort '_mergesort';
703@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
704
705=cut
706
707checkOptree(note => q{},
708 bcopts => q{-exec},
709 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
710 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
711# 1 <;> nextstate(main 662 (eval 42):1) v
712# 2 <0> pushmark s
713# 3 <0> pushmark s
714# 4 <#> gv[*old] s
715# 5 <1> rv2av[t9] lK/1
716# 6 <@> sort lKS*
717# 7 <0> pushmark s
718# 8 <#> gv[*new] s
719# 9 <1> rv2av[t2] lKRM*/1
9e84f099 720# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
721# b <1> leavesub[1 ref] K/REFC,1
722EOT_EOT
723# 1 <;> nextstate(main 578 (eval 15):1) v
724# 2 <0> pushmark s
725# 3 <0> pushmark s
726# 4 <$> gv(*old) s
727# 5 <1> rv2av[t5] lK/1
728# 6 <@> sort lKS*
729# 7 <0> pushmark s
730# 8 <$> gv(*new) s
731# 9 <1> rv2av[t1] lKRM*/1
9e84f099 732# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
733# b <1> leavesub[1 ref] K/REFC,1
734EONT_EONT
735
736
737=for gentest
738
739# chunk: # you should have a good reason to do this!
740@articles = sort {$FooPack::b <=> $FooPack::a} @files;
741
742=cut
743
744checkOptree(note => q{},
745 bcopts => q{-exec},
746 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
747 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
748# 1 <;> nextstate(main 667 (eval 44):1) v
749# 2 <0> pushmark s
750# 3 <0> pushmark s
751# 4 <#> gv[*files] s
752# 5 <1> rv2av[t7] lK/1
753# 6 <@> sort lKS*
754# 7 <0> pushmark s
755# 8 <#> gv[*articles] s
756# 9 <1> rv2av[t2] lKRM*/1
9e84f099 757# a <2> aassign[t8] KS/COMMON
cc02ea56
JC
758# b <1> leavesub[1 ref] K/REFC,1
759EOT_EOT
760# 1 <;> nextstate(main 546 (eval 15):1) v
761# 2 <0> pushmark s
762# 3 <0> pushmark s
763# 4 <$> gv(*files) s
764# 5 <1> rv2av[t3] lK/1
765# 6 <@> sort lKS*
766# 7 <0> pushmark s
767# 8 <$> gv(*articles) s
768# 9 <1> rv2av[t1] lKRM*/1
9e84f099 769# a <2> aassign[t4] KS/COMMON
cc02ea56
JC
770# b <1> leavesub[1 ref] K/REFC,1
771EONT_EONT
772
773
774=for gentest
775
776# chunk: # fancy
777@result = sort { $a <=> $b } grep { $_ == $_ } @input;
778
779=cut
780
781checkOptree(note => q{},
782 bcopts => q{-exec},
783 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
784 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
785# 1 <;> nextstate(main 673 (eval 46):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[t9] lKM/1
791# 7 <@> grepstart lK*
792# 8 <|> grepwhile(other->9)[t10] 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[t2] lKRM*/1
9ad9869c 802# g <2> aassign[t3] KS/COMMON
cc02ea56
JC
803# h <1> leavesub[1 ref] K/REFC,1
804EOT_EOT
805# 1 <;> nextstate(main 547 (eval 15):1) v
806# 2 <0> pushmark s
807# 3 <0> pushmark s
808# 4 <0> pushmark s
809# 5 <$> gv(*input) s
810# 6 <1> rv2av[t3] lKM/1
811# 7 <@> grepstart lK*
812# 8 <|> grepwhile(other->9)[t4] lK
813# 9 <$> gvsv(*_) s
814# a <$> gvsv(*_) s
815# b <2> eq sK/2
816# - <@> scope sK
817# goto 8
818# c <@> sort lK/NUM
819# d <0> pushmark s
820# e <$> gv(*result) s
821# f <1> rv2av[t1] lKRM*/1
822# g <2> aassign[t2] KS/COMMON
823# h <1> leavesub[1 ref] K/REFC,1
824EONT_EONT
825
826
827=for gentest
828
829# chunk: # void return context sort
830sort { $a <=> $b } @input;
831
832=cut
833
834checkOptree(note => q{},
835 bcopts => q{-exec},
836 code => q{sort { $a <=> $b } @input; },
837 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
838# 1 <;> nextstate(main 678 (eval 48):1) v
839# 2 <0> pushmark s
840# 3 <#> gv[*input] s
841# 4 <1> rv2av[t5] lK/1
842# 5 <@> sort K/NUM
843# 6 <1> leavesub[1 ref] K/REFC,1
844EOT_EOT
845# 1 <;> nextstate(main 546 (eval 15):1) v
846# 2 <0> pushmark s
847# 3 <$> gv(*input) s
848# 4 <1> rv2av[t2] lK/1
849# 5 <@> sort K/NUM
850# 6 <1> leavesub[1 ref] K/REFC,1
851EONT_EONT
852
853
854=for gentest
855
856# chunk: # more void context, propagating ?
857sort { $a <=> $b } grep { $_ == $_ } @input;
858
859=cut
860
861checkOptree(note => q{},
862 bcopts => q{-exec},
863 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
864 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
865# 1 <;> nextstate(main 684 (eval 50):1) v
866# 2 <0> pushmark s
867# 3 <0> pushmark s
868# 4 <#> gv[*input] s
869# 5 <1> rv2av[t7] lKM/1
870# 6 <@> grepstart lK*
871# 7 <|> grepwhile(other->8)[t8] lK
872# 8 <#> gvsv[*_] s
873# 9 <#> gvsv[*_] s
874# a <2> eq sK/2
875# - <@> scope sK
876# goto 7
877# b <@> sort K/NUM
878# c <1> leavesub[1 ref] K/REFC,1
879EOT_EOT
880# 1 <;> nextstate(main 547 (eval 15):1) v
881# 2 <0> pushmark s
882# 3 <0> pushmark s
883# 4 <$> gv(*input) s
884# 5 <1> rv2av[t2] lKM/1
885# 6 <@> grepstart lK*
886# 7 <|> grepwhile(other->8)[t3] lK
887# 8 <$> gvsv(*_) s
888# 9 <$> gvsv(*_) s
889# a <2> eq sK/2
890# - <@> scope sK
891# goto 7
892# b <@> sort K/NUM
893# c <1> leavesub[1 ref] K/REFC,1
894EONT_EONT
895
896
897=for gentest
898
899# chunk: # scalar return context sort
900$s = sort { $a <=> $b } @input;
901
902=cut
903
904checkOptree(note => q{},
905 bcopts => q{-exec},
906 code => q{$s = sort { $a <=> $b } @input; },
907 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
908# 1 <;> nextstate(main 689 (eval 52):1) v
909# 2 <0> pushmark s
910# 3 <#> gv[*input] s
911# 4 <1> rv2av[t6] lK/1
912# 5 <@> sort sK/NUM
913# 6 <#> gvsv[*s] s
914# 7 <2> sassign sKS/2
915# 8 <1> leavesub[1 ref] K/REFC,1
916EOT_EOT
917# 1 <;> nextstate(main 546 (eval 15):1) v
918# 2 <0> pushmark s
919# 3 <$> gv(*input) s
920# 4 <1> rv2av[t2] lK/1
921# 5 <@> sort sK/NUM
922# 6 <$> gvsv(*s) s
923# 7 <2> sassign sKS/2
924# 8 <1> leavesub[1 ref] K/REFC,1
925EONT_EONT
926
927
928=for gentest
929
930# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
931
932=cut
933
934checkOptree(note => q{},
935 bcopts => q{-exec},
936 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
937 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
938# 1 <;> nextstate(main 695 (eval 54):1) v
939# 2 <0> pushmark s
940# 3 <0> pushmark s
941# 4 <#> gv[*input] s
942# 5 <1> rv2av[t8] lKM/1
943# 6 <@> grepstart lK*
944# 7 <|> grepwhile(other->8)[t9] lK
945# 8 <#> gvsv[*_] s
946# 9 <#> gvsv[*_] s
947# a <2> eq sK/2
948# - <@> scope sK
949# goto 7
950# b <@> sort sK/NUM
951# c <#> gvsv[*s] s
952# d <2> sassign sKS/2
953# e <1> leavesub[1 ref] K/REFC,1
954EOT_EOT
955# 1 <;> nextstate(main 547 (eval 15):1) v
956# 2 <0> pushmark s
957# 3 <0> pushmark s
958# 4 <$> gv(*input) s
959# 5 <1> rv2av[t2] lKM/1
960# 6 <@> grepstart lK*
961# 7 <|> grepwhile(other->8)[t3] lK
962# 8 <$> gvsv(*_) s
963# 9 <$> gvsv(*_) s
964# a <2> eq sK/2
965# - <@> scope sK
966# goto 7
967# b <@> sort sK/NUM
968# c <$> gvsv(*s) s
969# d <2> sassign sKS/2
970# e <1> leavesub[1 ref] K/REFC,1
971EONT_EONT
972