This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Brendan Byrd is now a perl AUTHOR
[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
85117865
FC
132# 5 <1> rv2av[t9] lK/1 < 5.019002
133# 5 <1> rv2av[t9] lKM/1 >=5.019002
cc02ea56
JC
134# 6 <@> sort lKS*
135# 7 <0> pushmark s
136# 8 <#> gv[*articles] s
137# 9 <1> rv2av[t2] lKRM*/1
9e84f099 138# a <2> aassign[t10] KS/COMMON
cc02ea56
JC
139# b <1> leavesub[1 ref] K/REFC,1
140EOT_EOT
d1718a7c 141# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
142# 2 <0> pushmark s
143# 3 <0> pushmark s
144# 4 <$> gv(*files) s
85117865
FC
145# 5 <1> rv2av[t5] lK/1 < 5.019002
146# 5 <1> rv2av[t5] lKM/1 >=5.019002
cc02ea56
JC
147# 6 <@> sort lKS*
148# 7 <0> pushmark s
149# 8 <$> gv(*articles) s
150# 9 <1> rv2av[t1] lKRM*/1
9e84f099 151# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
152# b <1> leavesub[1 ref] K/REFC,1
153EONT_EONT
154
155
156=for gentest
157
158# chunk: # same thing in reversed order
159@articles = sort {$b cmp $a} @files;
160
161=cut
162
163checkOptree(note => q{},
164 bcopts => q{-exec},
165 code => q{@articles = sort {$b cmp $a} @files; },
166 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 167# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
168# 2 <0> pushmark s
169# 3 <0> pushmark s
170# 4 <#> gv[*files] s
171# 5 <1> rv2av[t7] lK/1
6c3fb703 172# 6 <@> sort lK/DESC
cc02ea56
JC
173# 7 <0> pushmark s
174# 8 <#> gv[*articles] s
175# 9 <1> rv2av[t2] lKRM*/1
9e84f099 176# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
177# b <1> leavesub[1 ref] K/REFC,1
178EOT_EOT
d1718a7c 179# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
180# 2 <0> pushmark s
181# 3 <0> pushmark s
182# 4 <$> gv(*files) s
183# 5 <1> rv2av[t3] lK/1
6c3fb703 184# 6 <@> sort lK/DESC
cc02ea56
JC
185# 7 <0> pushmark s
186# 8 <$> gv(*articles) s
187# 9 <1> rv2av[t1] lKRM*/1
9e84f099 188# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
189# b <1> leavesub[1 ref] K/REFC,1
190EONT_EONT
191
192
193=for gentest
194
195# chunk: # sort numerically ascending
196@articles = sort {$a <=> $b} @files;
197
198=cut
199
200checkOptree(note => q{},
201 bcopts => q{-exec},
202 code => q{@articles = sort {$a <=> $b} @files; },
203 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 204# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
205# 2 <0> pushmark s
206# 3 <0> pushmark s
207# 4 <#> gv[*files] s
208# 5 <1> rv2av[t7] lK/1
209# 6 <@> sort lK/NUM
210# 7 <0> pushmark s
211# 8 <#> gv[*articles] s
212# 9 <1> rv2av[t2] lKRM*/1
9e84f099 213# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
214# b <1> leavesub[1 ref] K/REFC,1
215EOT_EOT
d1718a7c 216# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
217# 2 <0> pushmark s
218# 3 <0> pushmark s
219# 4 <$> gv(*files) s
220# 5 <1> rv2av[t3] lK/1
221# 6 <@> sort lK/NUM
222# 7 <0> pushmark s
223# 8 <$> gv(*articles) s
224# 9 <1> rv2av[t1] lKRM*/1
9e84f099 225# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
226# b <1> leavesub[1 ref] K/REFC,1
227EONT_EONT
228
229
230=for gentest
231
232# chunk: # sort numerically descending
233@articles = sort {$b <=> $a} @files;
234
235=cut
236
237checkOptree(note => q{},
238 bcopts => q{-exec},
239 code => q{@articles = sort {$b <=> $a} @files; },
240 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 241# 1 <;> nextstate(main 587 (eval 26):1) v
cc02ea56
JC
242# 2 <0> pushmark s
243# 3 <0> pushmark s
244# 4 <#> gv[*files] s
245# 5 <1> rv2av[t7] lK/1
6c3fb703 246# 6 <@> sort lK/DESC,NUM
cc02ea56
JC
247# 7 <0> pushmark s
248# 8 <#> gv[*articles] s
249# 9 <1> rv2av[t2] lKRM*/1
9e84f099 250# a <2> aassign[t3] KS/COMMON
cc02ea56
JC
251# b <1> leavesub[1 ref] K/REFC,1
252EOT_EOT
d1718a7c 253# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
254# 2 <0> pushmark s
255# 3 <0> pushmark s
256# 4 <$> gv(*files) s
257# 5 <1> rv2av[t3] lK/1
6c3fb703 258# 6 <@> sort lK/DESC,NUM
cc02ea56
JC
259# 7 <0> pushmark s
260# 8 <$> gv(*articles) s
261# 9 <1> rv2av[t1] lKRM*/1
9e84f099 262# a <2> aassign[t2] KS/COMMON
cc02ea56
JC
263# b <1> leavesub[1 ref] K/REFC,1
264EONT_EONT
265
266
267=for gentest
268
269# chunk: # this sorts the %age hash by value instead of key
270# using an in-line function
271@eldest = sort { $age{$b} <=> $age{$a} } keys %age;
272
273=cut
274
275checkOptree(note => q{},
276 bcopts => q{-exec},
277 code => q{@eldest = sort { $age{$b} <=> $age{$a} } keys %age; },
278 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 279# 1 <;> nextstate(main 592 (eval 28):1) v
cc02ea56
JC
280# 2 <0> pushmark s
281# 3 <0> pushmark s
282# 4 <#> gv[*age] s
283# 5 <1> rv2hv[t9] lKRM/1
85117865
FC
284# 6 <1> keys[t10] lK/1 < 5.019002
285# 6 <1> keys[t10] lKM/1 >=5.019002
cc02ea56
JC
286# 7 <@> sort lKS*
287# 8 <0> pushmark s
288# 9 <#> gv[*eldest] s
289# a <1> rv2av[t2] lKRM*/1
9e84f099 290# b <2> aassign[t11] KS/COMMON
cc02ea56
JC
291# c <1> leavesub[1 ref] K/REFC,1
292EOT_EOT
d1718a7c 293# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
294# 2 <0> pushmark s
295# 3 <0> pushmark s
296# 4 <$> gv(*age) s
297# 5 <1> rv2hv[t3] lKRM/1
85117865
FC
298# 6 <1> keys[t4] lK/1 < 5.019002
299# 6 <1> keys[t4] lKM/1 >=5.019002
cc02ea56
JC
300# 7 <@> sort lKS*
301# 8 <0> pushmark s
302# 9 <$> gv(*eldest) s
303# a <1> rv2av[t1] lKRM*/1
9e84f099 304# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
305# c <1> leavesub[1 ref] K/REFC,1
306EONT_EONT
307
308
309=for gentest
310
311# chunk: # sort using explicit subroutine name
312sub byage {
313 $age{$a} <=> $age{$b}; # presuming numeric
314}
315@sortedclass = sort byage @class;
316
317=cut
318
319checkOptree(note => q{},
320 bcopts => q{-exec},
321 code => q{sub byage { $age{$a} <=> $age{$b}; } @sortedclass = sort byage @class; },
322 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 323# 1 <;> nextstate(main 597 (eval 30):1) v
cc02ea56
JC
324# 2 <0> pushmark s
325# 3 <0> pushmark s
326# 4 <$> const[PV "byage"] s/BARE
327# 5 <#> gv[*class] s
85117865
FC
328# 6 <1> rv2av[t4] lK/1 < 5.019002
329# 6 <1> rv2av[t4] lKM/1 >=5.019002
cc02ea56
JC
330# 7 <@> sort lKS
331# 8 <0> pushmark s
332# 9 <#> gv[*sortedclass] s
333# a <1> rv2av[t2] lKRM*/1
9e84f099 334# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
335# c <1> leavesub[1 ref] K/REFC,1
336EOT_EOT
d1718a7c 337# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
338# 2 <0> pushmark s
339# 3 <0> pushmark s
340# 4 <$> const(PV "byage") s/BARE
341# 5 <$> gv(*class) s
85117865
FC
342# 6 <1> rv2av[t2] lK/1 < 5.019002
343# 6 <1> rv2av[t2] lKM/1 >=5.019002
cc02ea56
JC
344# 7 <@> sort lKS
345# 8 <0> pushmark s
346# 9 <$> gv(*sortedclass) s
347# a <1> rv2av[t1] lKRM*/1
9e84f099 348# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
349# c <1> leavesub[1 ref] K/REFC,1
350EONT_EONT
351
352
353=for gentest
354
355# chunk: sub backwards { $b cmp $a }
356@harry = qw(dog cat x Cain Abel);
357@george = qw(gone chased yz Punished Axed);
358print sort @harry;
359# prints AbelCaincatdogx
360print sort backwards @harry;
361# prints xdogcatCainAbel
362print sort @george, 'to', @harry;
363# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
364
365=cut
366
7ce9b5fb 367checkOptree(name => q{sort USERSUB LIST },
cc02ea56 368 bcopts => q{-exec},
cc02ea56
JC
369 code => q{sub backwards { $b cmp $a }
370 @harry = qw(dog cat x Cain Abel);
371 @george = qw(gone chased yz Punished Axed);
372 print sort @harry; print sort backwards @harry;
373 print sort @george, 'to', @harry; },
374 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 375# 1 <;> nextstate(main 602 (eval 32):2) v
cc02ea56
JC
376# 2 <0> pushmark s
377# 3 <$> const[PV "dog"] s
378# 4 <$> const[PV "cat"] s
379# 5 <$> const[PV "x"] s
380# 6 <$> const[PV "Cain"] s
381# 7 <$> const[PV "Abel"] s
382# 8 <0> pushmark s
383# 9 <#> gv[*harry] s
384# a <1> rv2av[t2] lKRM*/1
385# b <2> aassign[t3] vKS
d1718a7c 386# c <;> nextstate(main 602 (eval 32):3) v
cc02ea56
JC
387# d <0> pushmark s
388# e <$> const[PV "gone"] s
389# f <$> const[PV "chased"] s
390# g <$> const[PV "yz"] s
391# h <$> const[PV "Punished"] s
392# i <$> const[PV "Axed"] s
393# j <0> pushmark s
394# k <#> gv[*george] s
395# l <1> rv2av[t5] lKRM*/1
396# m <2> aassign[t6] vKS
d1718a7c 397# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
398# o <0> pushmark s
399# p <0> pushmark s
400# q <#> gv[*harry] s
401# r <1> rv2av[t8] lK/1
402# s <@> sort lK
403# t <@> print vK
d1718a7c 404# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
405# v <0> pushmark s
406# w <0> pushmark s
407# x <$> const[PV "backwards"] s/BARE
408# y <#> gv[*harry] s
85117865
FC
409# z <1> rv2av[t10] lK/1 < 5.019002
410# z <1> rv2av[t10] lKM/1 >=5.019002
cc02ea56
JC
411# 10 <@> sort lKS
412# 11 <@> print vK
d1718a7c 413# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56
JC
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
d1718a7c 425# 1 <;> nextstate(main 602 (eval 32):2) v
cc02ea56
JC
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
d1718a7c 436# c <;> nextstate(main 602 (eval 32):3) v
cc02ea56
JC
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
d1718a7c 447# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
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
d1718a7c 454# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56
JC
455# v <0> pushmark s
456# w <0> pushmark s
457# x <$> const(PV "backwards") s/BARE
458# y <$> gv(*harry) s
85117865
FC
459# z <1> rv2av[t6] lK/1 < 5.019002
460# z <1> rv2av[t6] lKM/1 >=5.019002
cc02ea56
JC
461# 10 <@> sort lKS
462# 11 <@> print vK
d1718a7c 463# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56
JC
464# 13 <0> pushmark s
465# 14 <0> pushmark s
466# 15 <$> gv(*george) s
467# 16 <1> rv2av[t7] lK/1
468# 17 <$> const(PV "to") s
469# 18 <$> gv(*harry) s
470# 19 <1> rv2av[t8] lK/1
471# 1a <@> sort lK
472# 1b <@> print sK
473# 1c <1> leavesub[1 ref] K/REFC,1
474EONT_EONT
475
476
477=for gentest
478
479# chunk: # inefficiently sort by descending numeric compare using
480# the first integer after the first = sign, or the
481# whole record case-insensitively otherwise
482@new = @old[ sort {
483 $nums[$b] <=> $nums[$a]
484 || $caps[$a] cmp $caps[$b]
485 } 0..$#old ];
486
487=cut
488=for gentest
489
490# chunk: # same thing, but without any temps
491@new = map { $_->[0] }
492sort { $b->[1] <=> $a->[1]
493 || $a->[2] cmp $b->[2]
494 } map { [$_, /=(\d+)/, uc($_)] } @old;
495
496=cut
497
7ce9b5fb 498checkOptree(name => q{Compound sort/map Expression },
cc02ea56
JC
499 bcopts => q{-exec},
500 code => q{ @new = map { $_->[0] }
501 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
502 map { [$_, /=(\d+)/, uc($_)] } @old; },
503 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 504# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56
JC
505# 2 <0> pushmark s
506# 3 <0> pushmark s
507# 4 <0> pushmark s
508# 5 <0> pushmark s
509# 6 <#> gv[*old] s
510# 7 <1> rv2av[t19] lKM/1
82aeefe1
DM
511# 8 <@> mapstart lK* < 5.017002
512# 8 <@> mapstart lK >=5.017002
85117865
FC
513# 9 <|> mapwhile(other->a)[t20] lK < 5.019002
514# 9 <|> mapwhile(other->a)[t20] lKM >=5.019002
cc02ea56 515# a <0> enter l
d1718a7c 516# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56
JC
517# c <0> pushmark s
518# d <#> gvsv[*_] s
519# e </> match(/"=(\\d+)"/) l/RTIME
520# f <#> gvsv[*_] s
521# g <1> uc[t17] sK/1
78c72037
NC
522# h <@> anonlist sK*/1
523# i <@> leave lKP
cc02ea56 524# goto 9
78c72037 525# j <@> sort lKMS*
82aeefe1
DM
526# k <@> mapstart lK* < 5.017002
527# k <@> mapstart lK >=5.017002
78c72037
NC
528# l <|> mapwhile(other->m)[t26] lK
529# m <#> gv[*_] s
530# n <1> rv2sv sKM/DREFAV,1
9026059d 531# o <1> rv2av[t4] sKR/1
78c72037
NC
532# p <$> const[IV 0] s
533# q <2> aelem sK/2
82aeefe1 534# - <@> scope lK < 5.017002
78c72037
NC
535# goto l
536# r <0> pushmark s
537# s <#> gv[*new] s
538# t <1> rv2av[t2] lKRM*/1
539# u <2> aassign[t27] KS/COMMON
540# v <1> leavesub[1 ref] K/REFC,1
cc02ea56 541EOT_EOT
d1718a7c 542# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56
JC
543# 2 <0> pushmark s
544# 3 <0> pushmark s
545# 4 <0> pushmark s
546# 5 <0> pushmark s
547# 6 <$> gv(*old) s
548# 7 <1> rv2av[t10] lKM/1
82aeefe1
DM
549# 8 <@> mapstart lK* < 5.017002
550# 8 <@> mapstart lK >=5.017002
85117865
FC
551# 9 <|> mapwhile(other->a)[t11] lK < 5.019002
552# 9 <|> mapwhile(other->a)[t11] lKM >=5.019002
cc02ea56 553# a <0> enter l
d1718a7c 554# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56
JC
555# c <0> pushmark s
556# d <$> gvsv(*_) s
557# e </> match(/"=(\\d+)"/) l/RTIME
558# f <$> gvsv(*_) s
559# g <1> uc[t9] sK/1
78c72037
NC
560# h <@> anonlist sK*/1
561# i <@> leave lKP
cc02ea56 562# goto 9
78c72037 563# j <@> sort lKMS*
82aeefe1
DM
564# k <@> mapstart lK* < 5.017002
565# k <@> mapstart lK >=5.017002
78c72037
NC
566# l <|> mapwhile(other->m)[t12] lK
567# m <$> gv(*_) s
568# n <1> rv2sv sKM/DREFAV,1
9026059d 569# o <1> rv2av[t2] sKR/1
78c72037
NC
570# p <$> const(IV 0) s
571# q <2> aelem sK/2
82aeefe1 572# - <@> scope lK < 5.017002
78c72037
NC
573# goto l
574# r <0> pushmark s
575# s <$> gv(*new) s
576# t <1> rv2av[t1] lKRM*/1
577# u <2> aassign[t13] KS/COMMON
578# v <1> leavesub[1 ref] K/REFC,1
cc02ea56
JC
579EONT_EONT
580
581
582=for gentest
583
584# chunk: # using a prototype allows you to use any comparison subroutine
585# as a sort subroutine (including other package's subroutines)
586package other;
587sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
588package main;
589@new = sort other::backwards @old;
590
591=cut
592
7ce9b5fb 593checkOptree(name => q{sort other::sub LIST },
cc02ea56
JC
594 bcopts => q{-exec},
595 code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
596 package main; @new = sort other::backwards @old; },
597 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 598# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56
JC
599# 2 <0> pushmark s
600# 3 <0> pushmark s
601# 4 <$> const[PV "other::backwards"] s/BARE
602# 5 <#> gv[*old] s
85117865
FC
603# 6 <1> rv2av[t4] lK/1 < 5.019002
604# 6 <1> rv2av[t4] lKM/1 >=5.019002
cc02ea56
JC
605# 7 <@> sort lKS
606# 8 <0> pushmark s
607# 9 <#> gv[*new] s
608# a <1> rv2av[t2] lKRM*/1
9e84f099 609# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
610# c <1> leavesub[1 ref] K/REFC,1
611EOT_EOT
d1718a7c 612# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56
JC
613# 2 <0> pushmark s
614# 3 <0> pushmark s
615# 4 <$> const(PV "other::backwards") s/BARE
616# 5 <$> gv(*old) s
85117865
FC
617# 6 <1> rv2av[t2] lK/1 < 5.019002
618# 6 <1> rv2av[t2] lKM/1 >=5.019002
cc02ea56
JC
619# 7 <@> sort lKS
620# 8 <0> pushmark s
621# 9 <$> gv(*new) s
622# a <1> rv2av[t1] lKRM*/1
9e84f099 623# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
624# c <1> leavesub[1 ref] K/REFC,1
625EONT_EONT
626
627
628=for gentest
629
630# chunk: # repeat, condensed. $main::a and $b are unaffected
631sub other::backwards ($$) { $_[1] cmp $_[0]; }
632@new = sort other::backwards @old;
633
634=cut
635
636checkOptree(note => q{},
637 bcopts => q{-exec},
638 code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
639 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 640# 1 <;> nextstate(main 619 (eval 38):1) v
cc02ea56
JC
641# 2 <0> pushmark s
642# 3 <0> pushmark s
643# 4 <$> const[PV "other::backwards"] s/BARE
644# 5 <#> gv[*old] s
85117865
FC
645# 6 <1> rv2av[t4] lK/1 < 5.019002
646# 6 <1> rv2av[t4] lKM/1 >=5.019002
cc02ea56
JC
647# 7 <@> sort lKS
648# 8 <0> pushmark s
649# 9 <#> gv[*new] s
650# a <1> rv2av[t2] lKRM*/1
9e84f099 651# b <2> aassign[t5] KS/COMMON
cc02ea56
JC
652# c <1> leavesub[1 ref] K/REFC,1
653EOT_EOT
d1718a7c 654# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
655# 2 <0> pushmark s
656# 3 <0> pushmark s
657# 4 <$> const(PV "other::backwards") s/BARE
658# 5 <$> gv(*old) s
85117865
FC
659# 6 <1> rv2av[t2] lK/1 < 5.019002
660# 6 <1> rv2av[t2] lKM/1 >=5.019002
cc02ea56
JC
661# 7 <@> sort lKS
662# 8 <0> pushmark s
663# 9 <$> gv(*new) s
664# a <1> rv2av[t1] lKRM*/1
9e84f099 665# b <2> aassign[t3] KS/COMMON
cc02ea56
JC
666# c <1> leavesub[1 ref] K/REFC,1
667EONT_EONT
668
669
670=for gentest
671
672# chunk: # guarantee stability, regardless of algorithm
673use sort 'stable';
674@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
675
676=cut
677
e412117e 678my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d5ec2987 679# 1 <;> nextstate(main 656 (eval 40):1) v:%,{
cc02ea56
JC
680# 2 <0> pushmark s
681# 3 <0> pushmark s
682# 4 <#> gv[*old] s
85117865
FC
683# 5 <1> rv2av[t9] lK/1 < 5.019002
684# 5 <1> rv2av[t9] lKM/1 >=5.019002
7b9ef140 685# 6 <@> sort lKS*/STABLE
cc02ea56
JC
686# 7 <0> pushmark s
687# 8 <#> gv[*new] s
688# 9 <1> rv2av[t2] lKRM*/1
9e84f099 689# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
690# b <1> leavesub[1 ref] K/REFC,1
691EOT_EOT
d5ec2987 692# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56
JC
693# 2 <0> pushmark s
694# 3 <0> pushmark s
695# 4 <$> gv(*old) s
85117865
FC
696# 5 <1> rv2av[t5] lK/1 < 5.019002
697# 5 <1> rv2av[t5] lKM/1 >=5.019002
7b9ef140 698# 6 <@> sort lKS*/STABLE
cc02ea56
JC
699# 7 <0> pushmark s
700# 8 <$> gv(*new) s
701# 9 <1> rv2av[t1] lKRM*/1
9e84f099 702# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
703# b <1> leavesub[1 ref] K/REFC,1
704EONT_EONT
e412117e 705
e412117e
NC
706
707checkOptree(note => q{},
708 bcopts => q{-exec},
709 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
710 expect => $expect, expect_nt => $expect_nt);
cc02ea56
JC
711
712=for gentest
713
714# chunk: # force use of mergesort (not portable outside Perl 5.8)
715use sort '_mergesort';
716@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
717
718=cut
719
720checkOptree(note => q{},
721 bcopts => q{-exec},
722 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
723 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 724# 1 <;> nextstate(main 662 (eval 42):1) v:%,{
cc02ea56
JC
725# 2 <0> pushmark s
726# 3 <0> pushmark s
727# 4 <#> gv[*old] s
85117865
FC
728# 5 <1> rv2av[t9] lK/1 < 5.019002
729# 5 <1> rv2av[t9] lKM/1 >=5.019002
cc02ea56
JC
730# 6 <@> sort lKS*
731# 7 <0> pushmark s
732# 8 <#> gv[*new] s
733# 9 <1> rv2av[t2] lKRM*/1
9e84f099 734# a <2> aassign[t14] KS/COMMON
cc02ea56
JC
735# b <1> leavesub[1 ref] K/REFC,1
736EOT_EOT
d5ec2987 737# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56
JC
738# 2 <0> pushmark s
739# 3 <0> pushmark s
740# 4 <$> gv(*old) s
85117865
FC
741# 5 <1> rv2av[t5] lK/1 < 5.019002
742# 5 <1> rv2av[t5] lKM/1 >=5.019002
cc02ea56
JC
743# 6 <@> sort lKS*
744# 7 <0> pushmark s
745# 8 <$> gv(*new) s
746# 9 <1> rv2av[t1] lKRM*/1
9e84f099 747# a <2> aassign[t6] KS/COMMON
cc02ea56
JC
748# b <1> leavesub[1 ref] K/REFC,1
749EONT_EONT
750
751
752=for gentest
753
754# chunk: # you should have a good reason to do this!
755@articles = sort {$FooPack::b <=> $FooPack::a} @files;
756
757=cut
758
759checkOptree(note => q{},
760 bcopts => q{-exec},
761 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
762 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 763# 1 <;> nextstate(main 667 (eval 44):1) v
cc02ea56
JC
764# 2 <0> pushmark s
765# 3 <0> pushmark s
766# 4 <#> gv[*files] s
85117865
FC
767# 5 <1> rv2av[t7] lK/1 < 5.019002
768# 5 <1> rv2av[t7] lKM/1 >=5.019002
cc02ea56
JC
769# 6 <@> sort lKS*
770# 7 <0> pushmark s
771# 8 <#> gv[*articles] s
772# 9 <1> rv2av[t2] lKRM*/1
9e84f099 773# a <2> aassign[t8] KS/COMMON
cc02ea56
JC
774# b <1> leavesub[1 ref] K/REFC,1
775EOT_EOT
d1718a7c 776# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
777# 2 <0> pushmark s
778# 3 <0> pushmark s
779# 4 <$> gv(*files) s
85117865
FC
780# 5 <1> rv2av[t3] lK/1 < 5.019002
781# 5 <1> rv2av[t3] lKM/1 >=5.019002
cc02ea56
JC
782# 6 <@> sort lKS*
783# 7 <0> pushmark s
784# 8 <$> gv(*articles) s
785# 9 <1> rv2av[t1] lKRM*/1
9e84f099 786# a <2> aassign[t4] KS/COMMON
cc02ea56
JC
787# b <1> leavesub[1 ref] K/REFC,1
788EONT_EONT
789
790
791=for gentest
792
793# chunk: # fancy
794@result = sort { $a <=> $b } grep { $_ == $_ } @input;
795
796=cut
797
798checkOptree(note => q{},
799 bcopts => q{-exec},
800 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
801 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 802# 1 <;> nextstate(main 673 (eval 46):1) v
cc02ea56
JC
803# 2 <0> pushmark s
804# 3 <0> pushmark s
805# 4 <0> pushmark s
806# 5 <#> gv[*input] s
807# 6 <1> rv2av[t9] lKM/1
82aeefe1
DM
808# 7 <@> grepstart lK* < 5.017002
809# 7 <@> grepstart lK >=5.017002
cc02ea56
JC
810# 8 <|> grepwhile(other->9)[t10] lK
811# 9 <#> gvsv[*_] s
812# a <#> gvsv[*_] s
813# b <2> eq sK/2
82aeefe1 814# - <@> scope sK < 5.017002
cc02ea56
JC
815# goto 8
816# c <@> sort lK/NUM
817# d <0> pushmark s
818# e <#> gv[*result] s
819# f <1> rv2av[t2] lKRM*/1
9ad9869c 820# g <2> aassign[t3] KS/COMMON
cc02ea56
JC
821# h <1> leavesub[1 ref] K/REFC,1
822EOT_EOT
d1718a7c 823# 1 <;> nextstate(main 547 (eval 15):1) v
cc02ea56
JC
824# 2 <0> pushmark s
825# 3 <0> pushmark s
826# 4 <0> pushmark s
827# 5 <$> gv(*input) s
828# 6 <1> rv2av[t3] lKM/1
82aeefe1
DM
829# 7 <@> grepstart lK* < 5.017002
830# 7 <@> grepstart lK >=5.017002
cc02ea56
JC
831# 8 <|> grepwhile(other->9)[t4] lK
832# 9 <$> gvsv(*_) s
833# a <$> gvsv(*_) s
834# b <2> eq sK/2
82aeefe1 835# - <@> scope sK < 5.017002
cc02ea56
JC
836# goto 8
837# c <@> sort lK/NUM
838# d <0> pushmark s
839# e <$> gv(*result) s
840# f <1> rv2av[t1] lKRM*/1
841# g <2> aassign[t2] KS/COMMON
842# h <1> leavesub[1 ref] K/REFC,1
843EONT_EONT
844
845
846=for gentest
847
848# chunk: # void return context sort
849sort { $a <=> $b } @input;
850
851=cut
852
853checkOptree(note => q{},
854 bcopts => q{-exec},
855 code => q{sort { $a <=> $b } @input; },
856 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 857# 1 <;> nextstate(main 678 (eval 48):1) v
cc02ea56
JC
858# 2 <0> pushmark s
859# 3 <#> gv[*input] s
860# 4 <1> rv2av[t5] lK/1
861# 5 <@> sort K/NUM
862# 6 <1> leavesub[1 ref] K/REFC,1
863EOT_EOT
d1718a7c 864# 1 <;> nextstate(main 546 (eval 15):1) v
cc02ea56
JC
865# 2 <0> pushmark s
866# 3 <$> gv(*input) s
867# 4 <1> rv2av[t2] lK/1
868# 5 <@> sort K/NUM
869# 6 <1> leavesub[1 ref] K/REFC,1
870EONT_EONT
871
872
873=for gentest
874
875# chunk: # more void context, propagating ?
876sort { $a <=> $b } grep { $_ == $_ } @input;
877
878=cut
879
880checkOptree(note => q{},
881 bcopts => q{-exec},
882 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
883 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 884# 1 <;> nextstate(main 684 (eval 50):1) v
cc02ea56
JC
885# 2 <0> pushmark s
886# 3 <0> pushmark s
887# 4 <#> gv[*input] s
888# 5 <1> rv2av[t7] lKM/1
82aeefe1
DM
889# 6 <@> grepstart lK* < 5.017002
890# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
891# 7 <|> grepwhile(other->8)[t8] 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
899EOT_EOT
d1718a7c 900# 1 <;> nextstate(main 547 (eval 15):1) v
cc02ea56
JC
901# 2 <0> pushmark s
902# 3 <0> pushmark s
903# 4 <$> gv(*input) s
904# 5 <1> rv2av[t2] lKM/1
82aeefe1
DM
905# 6 <@> grepstart lK* < 5.017002
906# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
907# 7 <|> grepwhile(other->8)[t3] lK
908# 8 <$> gvsv(*_) s
909# 9 <$> gvsv(*_) s
910# a <2> eq sK/2
82aeefe1 911# - <@> scope sK < 5.017002
cc02ea56
JC
912# goto 7
913# b <@> sort K/NUM
914# c <1> leavesub[1 ref] K/REFC,1
915EONT_EONT
916
917
918=for gentest
919
920# chunk: # scalar return context sort
921$s = sort { $a <=> $b } @input;
922
923=cut
924
925checkOptree(note => q{},
926 bcopts => q{-exec},
927 code => q{$s = sort { $a <=> $b } @input; },
928 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 929# 1 <;> nextstate(main 689 (eval 52):1) v:{
cc02ea56
JC
930# 2 <0> pushmark s
931# 3 <#> gv[*input] s
932# 4 <1> rv2av[t6] lK/1
933# 5 <@> sort sK/NUM
934# 6 <#> gvsv[*s] s
935# 7 <2> sassign sKS/2
936# 8 <1> leavesub[1 ref] K/REFC,1
937EOT_EOT
d1718a7c 938# 1 <;> nextstate(main 546 (eval 15):1) v:{
cc02ea56
JC
939# 2 <0> pushmark s
940# 3 <$> gv(*input) s
941# 4 <1> rv2av[t2] lK/1
942# 5 <@> sort sK/NUM
943# 6 <$> gvsv(*s) s
944# 7 <2> sassign sKS/2
945# 8 <1> leavesub[1 ref] K/REFC,1
946EONT_EONT
947
948
949=for gentest
950
951# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
952
953=cut
954
955checkOptree(note => q{},
956 bcopts => q{-exec},
957 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
958 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d1718a7c 959# 1 <;> nextstate(main 695 (eval 54):1) v:{
cc02ea56
JC
960# 2 <0> pushmark s
961# 3 <0> pushmark s
962# 4 <#> gv[*input] s
963# 5 <1> rv2av[t8] lKM/1
82aeefe1
DM
964# 6 <@> grepstart lK* < 5.017002
965# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
966# 7 <|> grepwhile(other->8)[t9] lK
967# 8 <#> gvsv[*_] s
968# 9 <#> gvsv[*_] s
969# a <2> eq sK/2
82aeefe1 970# - <@> scope sK < 5.017002
cc02ea56
JC
971# goto 7
972# b <@> sort sK/NUM
973# c <#> gvsv[*s] s
974# d <2> sassign sKS/2
975# e <1> leavesub[1 ref] K/REFC,1
976EOT_EOT
d1718a7c 977# 1 <;> nextstate(main 547 (eval 15):1) v:{
cc02ea56
JC
978# 2 <0> pushmark s
979# 3 <0> pushmark s
980# 4 <$> gv(*input) s
981# 5 <1> rv2av[t2] lKM/1
82aeefe1
DM
982# 6 <@> grepstart lK* < 5.017002
983# 6 <@> grepstart lK >=5.017002
cc02ea56
JC
984# 7 <|> grepwhile(other->8)[t3] lK
985# 8 <$> gvsv(*_) s
986# 9 <$> gvsv(*_) s
987# a <2> eq sK/2
82aeefe1 988# - <@> scope sK < 5.017002
cc02ea56
JC
989# goto 7
990# b <@> sort sK/NUM
991# c <$> gvsv(*s) s
992# d <2> sassign sKS/2
993# e <1> leavesub[1 ref] K/REFC,1
994EONT_EONT
995