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