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