This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make ext/B work with 5.16.x
[perl5.git] / ext / B / t / f_sort.t
CommitLineData
cc02ea56
JC
1#!perl
2
3BEGIN {
74517a3a 4 unshift @INC, 't';
9cd8f857
NC
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 }
7f046282
NC
10 if (!$Config::Config{useperlio}) {
11 print "1..0 # Skip -- need perlio to walk the optree\n";
12 exit 0;
13 }
cc02ea56
JC
14}
15use OptreeCheck;
3857d07c 16plan tests => 40;
cc02ea56 17
19e169bf
JC
18=head1 f_sort.t
19
20Code test snippets here are adapted from `perldoc -f map`
21
22Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
23(map|grep)(start|while) opcodes have different flags in 5.9, their
24private flags /1, /2 are gone in blead (for the cases covered)
25
26When the optree stuff was integrated into 5.8.6, these tests failed,
1c2e8cca 27and were todo'd. They're now done, by version-specific tweaking in
19e169bf 28mkCheckRex(), therefore the skip is removed too.
cc02ea56 29
7ce9b5fb 30=head1 Test Notes
cc02ea56
JC
31
32# chunk: #!perl
33#examples poached from perldoc -f sort
34
7ce9b5fb
JC
35NOTE: name is no longer a required arg for checkOptree, as label is
36synthesized out of others. HOWEVER, if the test-code has newlines in
37it, the label must be overridden by an explicit name.
38
39This is because t/TEST is quite particular about the test output it
40processes, and multi-line labels violate its 1-line-per-test
41expectations.
42
cc02ea56
JC
43=for gentest
44
45# chunk: # sort lexically
46@articles = sort @files;
47
48=cut
49
50checkOptree(note => q{},
51 bcopts => q{-exec},
52 code => q{@articles = sort @files; },
53 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 54# 1 <;> nextstate(main 545 (eval 15):1) v
cc02ea56
JC
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
9e84f099 63# a <2> aassign[t5] KS/COMMON
cc02ea56
JC
64# b <1> leavesub[1 ref] K/REFC,1
65EOT_EOT
d1718a7c 66# 1 <;> nextstate(main 545 (eval 15):1) v
cc02ea56
JC
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
9e84f099 75# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
76# b <1> leavesub[1 ref] K/REFC,1
77EONT_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
87checkOptree(note => q{},
88 bcopts => q{-exec},
89 code => q{@articles = sort {$a cmp $b} @files; },
90 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 91# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 100# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
101# b <1> leavesub[1 ref] K/REFC,1
102EOT_EOT
d1718a7c 103# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 112# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
113# b <1> leavesub[1 ref] K/REFC,1
114EONT_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
124checkOptree(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');
d1718a7c 128# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 137# a <2> aassign[t10] KS/COMMON
cc02ea56
JC
138# b <1> leavesub[1 ref] K/REFC,1
139EOT_EOT
d1718a7c 140# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 149# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
150# b <1> leavesub[1 ref] K/REFC,1
151EONT_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
161checkOptree(note => q{},
162 bcopts => q{-exec},
163 code => q{@articles = sort {$b cmp $a} @files; },
164 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 165# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
166# 2 <0> pushmark s
167# 3 <0> pushmark s
168# 4 <#> gv[*files] s
169# 5 <1> rv2av[t7] lK/1
6c3fb703 170# 6 <@> sort lK/DESC
cc02ea56
JC
171# 7 <0> pushmark s
172# 8 <#> gv[*articles] s
173# 9 <1> rv2av[t2] lKRM*/1
9e84f099 174# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
175# b <1> leavesub[1 ref] K/REFC,1
176EOT_EOT
d1718a7c 177# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
178# 2 <0> pushmark s
179# 3 <0> pushmark s
180# 4 <$> gv(*files) s
181# 5 <1> rv2av[t3] lK/1
6c3fb703 182# 6 <@> sort lK/DESC
cc02ea56
JC
183# 7 <0> pushmark s
184# 8 <$> gv(*articles) s
185# 9 <1> rv2av[t1] lKRM*/1
9e84f099 186# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
187# b <1> leavesub[1 ref] K/REFC,1
188EONT_EONT
189
190
191=for gentest
192
193# chunk: # sort numerically ascending
194@articles = sort {$a <=> $b} @files;
195
196=cut
197
198checkOptree(note => q{},
199 bcopts => q{-exec},
200 code => q{@articles = sort {$a <=> $b} @files; },
201 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 202# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 211# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
212# b <1> leavesub[1 ref] K/REFC,1
213EOT_EOT
d1718a7c 214# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 223# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
224# b <1> leavesub[1 ref] K/REFC,1
225EONT_EONT
226
227
228=for gentest
229
230# chunk: # sort numerically descending
231@articles = sort {$b <=> $a} @files;
232
233=cut
234
235checkOptree(note => q{},
236 bcopts => q{-exec},
237 code => q{@articles = sort {$b <=> $a} @files; },
238 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 239# 1 <;> nextstate(main 587 (eval 26):1) v
cc02ea56
JC
240# 2 <0> pushmark s
241# 3 <0> pushmark s
242# 4 <#> gv[*files] s
243# 5 <1> rv2av[t7] lK/1
6c3fb703 244# 6 <@> sort lK/DESC,NUM
cc02ea56
JC
245# 7 <0> pushmark s
246# 8 <#> gv[*articles] s
247# 9 <1> rv2av[t2] lKRM*/1
9e84f099 248# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
249# b <1> leavesub[1 ref] K/REFC,1
250EOT_EOT
d1718a7c 251# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
252# 2 <0> pushmark s
253# 3 <0> pushmark s
254# 4 <$> gv(*files) s
255# 5 <1> rv2av[t3] lK/1
6c3fb703 256# 6 <@> sort lK/DESC,NUM
cc02ea56
JC
257# 7 <0> pushmark s
258# 8 <$> gv(*articles) s
259# 9 <1> rv2av[t1] lKRM*/1
9e84f099 260# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
261# b <1> leavesub[1 ref] K/REFC,1
262EONT_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
273checkOptree(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');
d1718a7c 277# 1 <;> nextstate(main 592 (eval 28):1) v
cc02ea56
JC
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
9e84f099 287# b <2> aassign[t11] KS/COMMON
cc02ea56
JC
288# c <1> leavesub[1 ref] K/REFC,1
289EOT_EOT
d1718a7c 290# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 300# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
301# c <1> leavesub[1 ref] K/REFC,1
302EONT_EONT
303
304
305=for gentest
306
307# chunk: # sort using explicit subroutine name
308sub byage {
309 $age{$a} <=> $age{$b}; # presuming numeric
310}
311@sortedclass = sort byage @class;
312
313=cut
314
315checkOptree(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');
d1718a7c 319# 1 <;> nextstate(main 597 (eval 30):1) v
cc02ea56
JC
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
9e84f099 329# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
330# c <1> leavesub[1 ref] K/REFC,1
331EOT_EOT
d1718a7c 332# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
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
9e84f099 342# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
343# c <1> leavesub[1 ref] K/REFC,1
344EONT_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);
352print sort @harry;
353# prints AbelCaincatdogx
354print sort backwards @harry;
355# prints xdogcatCainAbel
356print sort @george, 'to', @harry;
357# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
358
359=cut
360
7ce9b5fb 361checkOptree(name => q{sort USERSUB LIST },
cc02ea56 362 bcopts => q{-exec},
cc02ea56
JC
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');
d1718a7c 369# 1 <;> nextstate(main 602 (eval 32):2) v
cc02ea56
JC
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
d1718a7c 380# c <;> nextstate(main 602 (eval 32):3) v
cc02ea56
JC
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
d1718a7c 391# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
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
d1718a7c 398# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
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
d1718a7c 406# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56
JC
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
417EOT_EOT
d1718a7c 418# 1 <;> nextstate(main 602 (eval 32):2) v
cc02ea56
JC
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
d1718a7c 429# c <;> nextstate(main 602 (eval 32):3) v
cc02ea56
JC
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
d1718a7c 440# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
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
d1718a7c 447# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
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
d1718a7c 455# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56
JC
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
466EONT_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] }
484sort { $b->[1] <=> $a->[1]
485 || $a->[2] cmp $b->[2]
486 } map { [$_, /=(\d+)/, uc($_)] } @old;
487
488=cut
489
7ce9b5fb 490checkOptree(name => q{Compound sort/map Expression },
cc02ea56
JC
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');
d1718a7c 496# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56
JC
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
82aeefe1
DM
503# 8 <@> mapstart lK* < 5.017002
504# 8 <@> mapstart lK >=5.017002
cc02ea56
JC
505# 9 <|> mapwhile(other->a)[t20] lK
506# a <0> enter l
d1718a7c 507# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56
JC
508# c <0> pushmark s
509# d <#> gvsv[*_] s
510# e </> match(/"=(\\d+)"/) l/RTIME
511# f <#> gvsv[*_] s
512# g <1> uc[t17] sK/1
78c72037
NC
513# h <@> anonlist sK*/1
514# i <@> leave lKP
cc02ea56 515# goto 9
78c72037 516# j <@> sort lKMS*
82aeefe1
DM
517# k <@> mapstart lK* < 5.017002
518# k <@> mapstart lK >=5.017002
78c72037
NC
519# l <|> mapwhile(other->m)[t26] lK
520# m <#> gv[*_] s
521# n <1> rv2sv sKM/DREFAV,1
9026059d 522# o <1> rv2av[t4] sKR/1
78c72037
NC
523# p <$> const[IV 0] s
524# q <2> aelem sK/2
82aeefe1 525# - <@> scope lK < 5.017002
78c72037
NC
526# goto l
527# r <0> pushmark s
528# s <#> gv[*new] s
529# t <1> rv2av[t2] lKRM*/1
530# u <2> aassign[t27] KS/COMMON
531# v <1> leavesub[1 ref] K/REFC,1
cc02ea56 532EOT_EOT
d1718a7c 533# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56
JC
534# 2 <0> pushmark s
535# 3 <0> pushmark s
536# 4 <0> pushmark s
537# 5 <0> pushmark s
538# 6 <$> gv(*old) s
539# 7 <1> rv2av[t10] lKM/1
82aeefe1
DM
540# 8 <@> mapstart lK* < 5.017002
541# 8 <@> mapstart lK >=5.017002
cc02ea56
JC
542# 9 <|> mapwhile(other->a)[t11] lK
543# a <0> enter l
d1718a7c 544# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56
JC
545# c <0> pushmark s
546# d <$> gvsv(*_) s
547# e </> match(/"=(\\d+)"/) l/RTIME
548# f <$> gvsv(*_) s
549# g <1> uc[t9] sK/1
78c72037
NC
550# h <@> anonlist sK*/1
551# i <@> leave lKP
cc02ea56 552# goto 9
78c72037 553# j <@> sort lKMS*
82aeefe1
DM
554# k <@> mapstart lK* < 5.017002
555# k <@> mapstart lK >=5.017002
78c72037
NC
556# l <|> mapwhile(other->m)[t12] lK
557# m <$> gv(*_) s
558# n <1> rv2sv sKM/DREFAV,1
9026059d 559# o <1> rv2av[t2] sKR/1
78c72037
NC
560# p <$> const(IV 0) s
561# q <2> aelem sK/2
82aeefe1 562# - <@> scope lK < 5.017002
78c72037
NC
563# goto l
564# r <0> pushmark s
565# s <$> gv(*new) s
566# t <1> rv2av[t1] lKRM*/1
567# u <2> aassign[t13] KS/COMMON
568# v <1> leavesub[1 ref] K/REFC,1
cc02ea56
JC
569EONT_EONT
570
571
572=for gentest
573
574# chunk: # using a prototype allows you to use any comparison subroutine
575# as a sort subroutine (including other package's subroutines)
576package other;
577sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
578package main;
579@new = sort other::backwards @old;
580
581=cut
582
7ce9b5fb 583checkOptree(name => q{sort other::sub LIST },
cc02ea56
JC
584 bcopts => q{-exec},
585 code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
586 package main; @new = sort other::backwards @old; },
587 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 588# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56
JC
589# 2 <0> pushmark s
590# 3 <0> pushmark s
591# 4 <$> const[PV "other::backwards"] s/BARE
592# 5 <#> gv[*old] s
593# 6 <1> rv2av[t4] lK/1
594# 7 <@> sort lKS
595# 8 <0> pushmark s
596# 9 <#> gv[*new] s
597# a <1> rv2av[t2] lKRM*/1
9e84f099 598# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
599# c <1> leavesub[1 ref] K/REFC,1
600EOT_EOT
d1718a7c 601# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56
JC
602# 2 <0> pushmark s
603# 3 <0> pushmark s
604# 4 <$> const(PV "other::backwards") s/BARE
605# 5 <$> gv(*old) s
606# 6 <1> rv2av[t2] lK/1
607# 7 <@> sort lKS
608# 8 <0> pushmark s
609# 9 <$> gv(*new) s
610# a <1> rv2av[t1] lKRM*/1
9e84f099 611# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
612# c <1> leavesub[1 ref] K/REFC,1
613EONT_EONT
614
615
616=for gentest
617
618# chunk: # repeat, condensed. $main::a and $b are unaffected
619sub other::backwards ($$) { $_[1] cmp $_[0]; }
620@new = sort other::backwards @old;
621
622=cut
623
624checkOptree(note => q{},
625 bcopts => q{-exec},
626 code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
627 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 628# 1 <;> nextstate(main 619 (eval 38):1) v
cc02ea56
JC
629# 2 <0> pushmark s
630# 3 <0> pushmark s
631# 4 <$> const[PV "other::backwards"] s/BARE
632# 5 <#> gv[*old] s
633# 6 <1> rv2av[t4] lK/1
634# 7 <@> sort lKS
635# 8 <0> pushmark s
636# 9 <#> gv[*new] s
637# a <1> rv2av[t2] lKRM*/1
9e84f099 638# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
639# c <1> leavesub[1 ref] K/REFC,1
640EOT_EOT
d1718a7c 641# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
642# 2 <0> pushmark s
643# 3 <0> pushmark s
644# 4 <$> const(PV "other::backwards") s/BARE
645# 5 <$> gv(*old) s
646# 6 <1> rv2av[t2] lK/1
647# 7 <@> sort lKS
648# 8 <0> pushmark s
649# 9 <$> gv(*new) s
650# a <1> rv2av[t1] lKRM*/1
9e84f099 651# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
652# c <1> leavesub[1 ref] K/REFC,1
653EONT_EONT
654
655
656=for gentest
657
658# chunk: # guarantee stability, regardless of algorithm
659use sort 'stable';
660@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
661
662=cut
663
e412117e 664my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d5ec2987 665# 1 <;> nextstate(main 656 (eval 40):1) v:%,{
cc02ea56
JC
666# 2 <0> pushmark s
667# 3 <0> pushmark s
668# 4 <#> gv[*old] s
669# 5 <1> rv2av[t9] lK/1
7b9ef140 670# 6 <@> sort lKS*/STABLE
cc02ea56
JC
671# 7 <0> pushmark s
672# 8 <#> gv[*new] s
673# 9 <1> rv2av[t2] lKRM*/1
9e84f099 674# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
675# b <1> leavesub[1 ref] K/REFC,1
676EOT_EOT
d5ec2987 677# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56
JC
678# 2 <0> pushmark s
679# 3 <0> pushmark s
680# 4 <$> gv(*old) s
681# 5 <1> rv2av[t5] lK/1
7b9ef140 682# 6 <@> sort lKS*/STABLE
cc02ea56
JC
683# 7 <0> pushmark s
684# 8 <$> gv(*new) s
685# 9 <1> rv2av[t1] lKRM*/1
9e84f099 686# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
687# b <1> leavesub[1 ref] K/REFC,1
688EONT_EONT
e412117e
NC
689
690if($] < 5.009) {
691 # 5.8.x doesn't show the /STABLE flag, so massage the golden results.
692 s!/STABLE!!s foreach ($expect, $expect_nt);
693}
694
695checkOptree(note => q{},
696 bcopts => q{-exec},
697 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
698 expect => $expect, expect_nt => $expect_nt);
cc02ea56
JC
699
700=for gentest
701
702# chunk: # force use of mergesort (not portable outside Perl 5.8)
703use sort '_mergesort';
704@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
705
706=cut
707
708checkOptree(note => q{},
709 bcopts => q{-exec},
710 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
711 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 712# 1 <;> nextstate(main 662 (eval 42):1) v:%,{
cc02ea56
JC
713# 2 <0> pushmark s
714# 3 <0> pushmark s
715# 4 <#> gv[*old] s
716# 5 <1> rv2av[t9] lK/1
717# 6 <@> sort lKS*
718# 7 <0> pushmark s
719# 8 <#> gv[*new] s
720# 9 <1> rv2av[t2] lKRM*/1
9e84f099 721# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
722# b <1> leavesub[1 ref] K/REFC,1
723EOT_EOT
d5ec2987 724# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56
JC
725# 2 <0> pushmark s
726# 3 <0> pushmark s
727# 4 <$> gv(*old) s
728# 5 <1> rv2av[t5] lK/1
729# 6 <@> sort lKS*
730# 7 <0> pushmark s
731# 8 <$> gv(*new) s
732# 9 <1> rv2av[t1] lKRM*/1
9e84f099 733# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
734# b <1> leavesub[1 ref] K/REFC,1
735EONT_EONT
736
737
738=for gentest
739
740# chunk: # you should have a good reason to do this!
741@articles = sort {$FooPack::b <=> $FooPack::a} @files;
742
743=cut
744
745checkOptree(note => q{},
746 bcopts => q{-exec},
747 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
748 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 749# 1 <;> nextstate(main 667 (eval 44):1) v
cc02ea56
JC
750# 2 <0> pushmark s
751# 3 <0> pushmark s
752# 4 <#> gv[*files] s
753# 5 <1> rv2av[t7] lK/1
754# 6 <@> sort lKS*
755# 7 <0> pushmark s
756# 8 <#> gv[*articles] s
757# 9 <1> rv2av[t2] lKRM*/1
9e84f099 758# a <2> aassign[t8] KS/COMMON
cc02ea56
JC
759# b <1> leavesub[1 ref] K/REFC,1
760EOT_EOT
d1718a7c 761# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
762# 2 <0> pushmark s
763# 3 <0> pushmark s
764# 4 <$> gv(*files) s
765# 5 <1> rv2av[t3] lK/1
766# 6 <@> sort lKS*
767# 7 <0> pushmark s
768# 8 <$> gv(*articles) s
769# 9 <1> rv2av[t1] lKRM*/1
9e84f099 770# a <2> aassign[t4] KS/COMMON
cc02ea56
JC
771# b <1> leavesub[1 ref] K/REFC,1
772EONT_EONT
773
774
775=for gentest
776
777# chunk: # fancy
778@result = sort { $a <=> $b } grep { $_ == $_ } @input;
779
780=cut
781
782checkOptree(note => q{},
783 bcopts => q{-exec},
784 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
785 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 786# 1 <;> nextstate(main 673 (eval 46):1) v
cc02ea56
JC
787# 2 <0> pushmark s
788# 3 <0> pushmark s
789# 4 <0> pushmark s
790# 5 <#> gv[*input] s
791# 6 <1> rv2av[t9] lKM/1
82aeefe1
DM
792# 7 <@> grepstart lK* < 5.017002
793# 7 <@> grepstart lK >=5.017002
cc02ea56
JC
794# 8 <|> grepwhile(other->9)[t10] lK
795# 9 <#> gvsv[*_] s
796# a <#> gvsv[*_] s
797# b <2> eq sK/2
82aeefe1 798# - <@> scope sK < 5.017002
cc02ea56
JC
799# goto 8
800# c <@> sort lK/NUM
801# d <0> pushmark s
802# e <#> gv[*result] s
803# f <1> rv2av[t2] lKRM*/1
9ad9869c 804# g <2> aassign[t3] KS/COMMON
cc02ea56
JC
805# h <1> leavesub[1 ref] K/REFC,1
806EOT_EOT
d1718a7c 807# 1 <;> nextstate(main 547 (eval 15):1) v
cc02ea56
JC
808# 2 <0> pushmark s
809# 3 <0> pushmark s
810# 4 <0> pushmark s
811# 5 <$> gv(*input) s
812# 6 <1> rv2av[t3] lKM/1
82aeefe1
DM
813# 7 <@> grepstart lK* < 5.017002
814# 7 <@> grepstart lK >=5.017002
cc02ea56
JC
815# 8 <|> grepwhile(other->9)[t4] lK
816# 9 <$> gvsv(*_) s
817# a <$> gvsv(*_) s
818# b <2> eq sK/2
82aeefe1 819# - <@> scope sK < 5.017002
cc02ea56
JC
820# goto 8
821# c <@> sort lK/NUM
822# d <0> pushmark s
823# e <$> gv(*result) s
824# f <1> rv2av[t1] lKRM*/1
825# g <2> aassign[t2] KS/COMMON
826# h <1> leavesub[1 ref] K/REFC,1
827EONT_EONT
828
829
830=for gentest
831
832# chunk: # void return context sort
833sort { $a <=> $b } @input;
834
835=cut
836
837checkOptree(note => q{},
838 bcopts => q{-exec},
839 code => q{sort { $a <=> $b } @input; },
840 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 841# 1 <;> nextstate(main 678 (eval 48):1) v
cc02ea56
JC
842# 2 <0> pushmark s
843# 3 <#> gv[*input] s
844# 4 <1> rv2av[t5] lK/1
845# 5 <@> sort K/NUM
846# 6 <1> leavesub[1 ref] K/REFC,1
847EOT_EOT
d1718a7c 848# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
849# 2 <0> pushmark s
850# 3 <$> gv(*input) s
851# 4 <1> rv2av[t2] lK/1
852# 5 <@> sort K/NUM
853# 6 <1> leavesub[1 ref] K/REFC,1
854EONT_EONT
855
856
857=for gentest
858
859# chunk: # more void context, propagating ?
860sort { $a <=> $b } grep { $_ == $_ } @input;
861
862=cut
863
864checkOptree(note => q{},
865 bcopts => q{-exec},
866 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
867 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 868# 1 <;> nextstate(main 684 (eval 50):1) v
cc02ea56
JC
869# 2 <0> pushmark s
870# 3 <0> pushmark s
871# 4 <#> gv[*input] s
872# 5 <1> rv2av[t7] lKM/1
82aeefe1
DM
873# 6 <@> grepstart lK* < 5.017002
874# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
875# 7 <|> grepwhile(other->8)[t8] lK
876# 8 <#> gvsv[*_] s
877# 9 <#> gvsv[*_] s
878# a <2> eq sK/2
82aeefe1 879# - <@> scope sK < 5.017002
cc02ea56
JC
880# goto 7
881# b <@> sort K/NUM
882# c <1> leavesub[1 ref] K/REFC,1
883EOT_EOT
d1718a7c 884# 1 <;> nextstate(main 547 (eval 15):1) v
cc02ea56
JC
885# 2 <0> pushmark s
886# 3 <0> pushmark s
887# 4 <$> gv(*input) s
888# 5 <1> rv2av[t2] lKM/1
82aeefe1
DM
889# 6 <@> grepstart lK* < 5.017002
890# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
891# 7 <|> grepwhile(other->8)[t3] lK
892# 8 <$> gvsv(*_) s
893# 9 <$> gvsv(*_) s
894# a <2> eq sK/2
82aeefe1 895# - <@> scope sK < 5.017002
cc02ea56
JC
896# goto 7
897# b <@> sort K/NUM
898# c <1> leavesub[1 ref] K/REFC,1
899EONT_EONT
900
901
902=for gentest
903
904# chunk: # scalar return context sort
905$s = sort { $a <=> $b } @input;
906
907=cut
908
909checkOptree(note => q{},
910 bcopts => q{-exec},
911 code => q{$s = sort { $a <=> $b } @input; },
912 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 913# 1 <;> nextstate(main 689 (eval 52):1) v:{
cc02ea56
JC
914# 2 <0> pushmark s
915# 3 <#> gv[*input] s
916# 4 <1> rv2av[t6] lK/1
917# 5 <@> sort sK/NUM
918# 6 <#> gvsv[*s] s
919# 7 <2> sassign sKS/2
920# 8 <1> leavesub[1 ref] K/REFC,1
921EOT_EOT
d1718a7c 922# 1 <;> nextstate(main 546 (eval 15):1) v:{
cc02ea56
JC
923# 2 <0> pushmark s
924# 3 <$> gv(*input) s
925# 4 <1> rv2av[t2] lK/1
926# 5 <@> sort sK/NUM
927# 6 <$> gvsv(*s) s
928# 7 <2> sassign sKS/2
929# 8 <1> leavesub[1 ref] K/REFC,1
930EONT_EONT
931
932
933=for gentest
934
935# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
936
937=cut
938
939checkOptree(note => q{},
940 bcopts => q{-exec},
941 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
942 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 943# 1 <;> nextstate(main 695 (eval 54):1) v:{
cc02ea56
JC
944# 2 <0> pushmark s
945# 3 <0> pushmark s
946# 4 <#> gv[*input] s
947# 5 <1> rv2av[t8] lKM/1
82aeefe1
DM
948# 6 <@> grepstart lK* < 5.017002
949# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
950# 7 <|> grepwhile(other->8)[t9] lK
951# 8 <#> gvsv[*_] s
952# 9 <#> gvsv[*_] s
953# a <2> eq sK/2
82aeefe1 954# - <@> scope sK < 5.017002
cc02ea56
JC
955# goto 7
956# b <@> sort sK/NUM
957# c <#> gvsv[*s] s
958# d <2> sassign sKS/2
959# e <1> leavesub[1 ref] K/REFC,1
960EOT_EOT
d1718a7c 961# 1 <;> nextstate(main 547 (eval 15):1) v:{
cc02ea56
JC
962# 2 <0> pushmark s
963# 3 <0> pushmark s
964# 4 <$> gv(*input) s
965# 5 <1> rv2av[t2] lKM/1
82aeefe1
DM
966# 6 <@> grepstart lK* < 5.017002
967# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
968# 7 <|> grepwhile(other->8)[t3] lK
969# 8 <$> gvsv(*_) s
970# 9 <$> gvsv(*_) s
971# a <2> eq sK/2
82aeefe1 972# - <@> scope sK < 5.017002
cc02ea56
JC
973# goto 7
974# b <@> sort sK/NUM
975# c <$> gvsv(*s) s
976# d <2> sassign sKS/2
977# e <1> leavesub[1 ref] K/REFC,1
978EONT_EONT
979