Assimilate I18N::LangTags 0.35
[p5sagit/p5-mst-13.2.git] / ext / B / t / f_sort.t
CommitLineData
cc02ea56 1#!perl
2
3BEGIN {
4 chdir q(t);
5 @INC = qw(../lib ../ext/B/t);
9cd8f857 6 require Config;
7 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
8 print "1..0 # Skip -- Perl configured without B module\n";
9 exit 0;
10 }
7f046282 11 if (!$Config::Config{useperlio}) {
12 print "1..0 # Skip -- need perlio to walk the optree\n";
13 exit 0;
14 }
2799c206 15 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
16 print
17 "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
18 exit 0;
19
20 }
7252851f 21 if ($] < 5.009) {
22 print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
23 exit 0;
24 }
cc02ea56 25 require q(./test.pl);
26}
27use OptreeCheck;
28plan tests => 20;
29
30
7ce9b5fb 31=head1 Test Notes
cc02ea56 32
33# chunk: #!perl
34#examples poached from perldoc -f sort
35
7ce9b5fb 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 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
64# a <2> aassign[t5] KS
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
76# a <2> aassign[t3] KS
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
101# a <2> aassign[t5] KS
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
113# a <2> aassign[t2] KS
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
138# a <2> aassign[t10] KS
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
150# a <2> aassign[t6] KS
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 172# 7 <0> pushmark s
173# 8 <#> gv[*articles] s
174# 9 <1> rv2av[t2] lKRM*/1
6c3fb703 175# a <2> aassign[t5] KS
cc02ea56 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 184# 7 <0> pushmark s
185# 8 <$> gv(*articles) s
186# 9 <1> rv2av[t1] lKRM*/1
6c3fb703 187# a <2> aassign[t2] KS
cc02ea56 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
212# a <2> aassign[t5] KS
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
224# a <2> aassign[t2] KS
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 246# 7 <0> pushmark s
247# 8 <#> gv[*articles] s
248# 9 <1> rv2av[t2] lKRM*/1
6c3fb703 249# a <2> aassign[t5] KS
cc02ea56 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 258# 7 <0> pushmark s
259# 8 <$> gv(*articles) s
260# 9 <1> rv2av[t1] lKRM*/1
6c3fb703 261# a <2> aassign[t2] KS
cc02ea56 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
288# b <2> aassign[t11] KS
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
301# b <2> aassign[t5] KS
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
330# b <2> aassign[t5] KS
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
343# b <2> aassign[t3] KS
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 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
392# n <;> nextstate(main 602 (eval 32):4) v
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
399# u <;> nextstate(main 602 (eval 32):4) v
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
407# 12 <;> nextstate(main 602 (eval 32):5) v
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
441# n <;> nextstate(main 602 (eval 32):4) v
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
448# u <;> nextstate(main 602 (eval 32):4) v
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
456# 12 <;> nextstate(main 602 (eval 32):5) v
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 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');
497# 1 <;> nextstate(main 609 (eval 34):3) v
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
507# b <;> nextstate(main 608 (eval 34):2) v
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
513# h <@> anonlist sKRM/1
514# i <1> srefgen sK/1
515# j <@> leave lKP
516# goto 9
517# k <@> sort lKMS*
518# l <@> mapstart lK*
519# m <|> mapwhile(other->n)[t26] lK
520# n <#> gv[*_] s
521# o <1> rv2sv sKM/DREFAV,1
522# p <1> rv2av[t4] sKR/1
523# q <$> const[IV 0] s
524# r <2> aelem sK/2
525# - <@> scope lK
526# goto m
527# s <0> pushmark s
528# t <#> gv[*new] s
529# u <1> rv2av[t2] lKRM*/1
530# v <2> aassign[t27] KS/COMMON
531# w <1> leavesub[1 ref] K/REFC,1
532EOT_EOT
533# 1 <;> nextstate(main 609 (eval 34):3) v
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
540# 8 <@> mapstart lK*
541# 9 <|> mapwhile(other->a)[t11] lK
542# a <0> enter l
543# b <;> nextstate(main 608 (eval 34):2) v
544# c <0> pushmark s
545# d <$> gvsv(*_) s
546# e </> match(/"=(\\d+)"/) l/RTIME
547# f <$> gvsv(*_) s
548# g <1> uc[t9] sK/1
549# h <@> anonlist sKRM/1
550# i <1> srefgen sK/1
551# j <@> leave lKP
552# goto 9
553# k <@> sort lKMS*
554# l <@> mapstart lK*
555# m <|> mapwhile(other->n)[t12] lK
556# n <$> gv(*_) s
557# o <1> rv2sv sKM/DREFAV,1
558# p <1> rv2av[t2] sKR/1
559# q <$> const(IV 0) s
560# r <2> aelem sK/2
561# - <@> scope lK
562# goto m
563# s <0> pushmark s
564# t <$> gv(*new) s
565# u <1> rv2av[t1] lKRM*/1
566# v <2> aassign[t13] KS/COMMON
567# w <1> leavesub[1 ref] K/REFC,1
568EONT_EONT
569
570
571=for gentest
572
573# chunk: # using a prototype allows you to use any comparison subroutine
574# as a sort subroutine (including other package's subroutines)
575package other;
576sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
577package main;
578@new = sort other::backwards @old;
579
580=cut
581
7ce9b5fb 582checkOptree(name => q{sort other::sub LIST },
cc02ea56 583 bcopts => q{-exec},
584 code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
585 package main; @new = sort other::backwards @old; },
586 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
587# 1 <;> nextstate(main 614 (eval 36):2) v
588# 2 <0> pushmark s
589# 3 <0> pushmark s
590# 4 <$> const[PV "other::backwards"] s/BARE
591# 5 <#> gv[*old] s
592# 6 <1> rv2av[t4] lK/1
593# 7 <@> sort lKS
594# 8 <0> pushmark s
595# 9 <#> gv[*new] s
596# a <1> rv2av[t2] lKRM*/1
597# b <2> aassign[t5] KS
598# c <1> leavesub[1 ref] K/REFC,1
599EOT_EOT
600# 1 <;> nextstate(main 614 (eval 36):2) v
601# 2 <0> pushmark s
602# 3 <0> pushmark s
603# 4 <$> const(PV "other::backwards") s/BARE
604# 5 <$> gv(*old) s
605# 6 <1> rv2av[t2] lK/1
606# 7 <@> sort lKS
607# 8 <0> pushmark s
608# 9 <$> gv(*new) s
609# a <1> rv2av[t1] lKRM*/1
610# b <2> aassign[t3] KS
611# c <1> leavesub[1 ref] K/REFC,1
612EONT_EONT
613
614
615=for gentest
616
617# chunk: # repeat, condensed. $main::a and $b are unaffected
618sub other::backwards ($$) { $_[1] cmp $_[0]; }
619@new = sort other::backwards @old;
620
621=cut
622
623checkOptree(note => q{},
624 bcopts => q{-exec},
625 code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
626 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
627# 1 <;> nextstate(main 619 (eval 38):1) v
628# 2 <0> pushmark s
629# 3 <0> pushmark s
630# 4 <$> const[PV "other::backwards"] s/BARE
631# 5 <#> gv[*old] s
632# 6 <1> rv2av[t4] lK/1
633# 7 <@> sort lKS
634# 8 <0> pushmark s
635# 9 <#> gv[*new] s
636# a <1> rv2av[t2] lKRM*/1
637# b <2> aassign[t5] KS
638# c <1> leavesub[1 ref] K/REFC,1
639EOT_EOT
640# 1 <;> nextstate(main 546 (eval 15):1) v
641# 2 <0> pushmark s
642# 3 <0> pushmark s
643# 4 <$> const(PV "other::backwards") s/BARE
644# 5 <$> gv(*old) s
645# 6 <1> rv2av[t2] lK/1
646# 7 <@> sort lKS
647# 8 <0> pushmark s
648# 9 <$> gv(*new) s
649# a <1> rv2av[t1] lKRM*/1
650# b <2> aassign[t3] KS
651# c <1> leavesub[1 ref] K/REFC,1
652EONT_EONT
653
654
655=for gentest
656
657# chunk: # guarantee stability, regardless of algorithm
658use sort 'stable';
659@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
660
661=cut
662
663checkOptree(note => q{},
664 bcopts => q{-exec},
665 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
666 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
667# 1 <;> nextstate(main 656 (eval 40):1) v
668# 2 <0> pushmark s
669# 3 <0> pushmark s
670# 4 <#> gv[*old] s
671# 5 <1> rv2av[t9] lK/1
672# 6 <@> sort lKS*
673# 7 <0> pushmark s
674# 8 <#> gv[*new] s
675# 9 <1> rv2av[t2] lKRM*/1
676# a <2> aassign[t14] KS
677# b <1> leavesub[1 ref] K/REFC,1
678EOT_EOT
679# 1 <;> nextstate(main 578 (eval 15):1) v
680# 2 <0> pushmark s
681# 3 <0> pushmark s
682# 4 <$> gv(*old) s
683# 5 <1> rv2av[t5] lK/1
684# 6 <@> sort lKS*
685# 7 <0> pushmark s
686# 8 <$> gv(*new) s
687# 9 <1> rv2av[t1] lKRM*/1
688# a <2> aassign[t6] KS
689# b <1> leavesub[1 ref] K/REFC,1
690EONT_EONT
691
692
693=for gentest
694
695# chunk: # force use of mergesort (not portable outside Perl 5.8)
696use sort '_mergesort';
697@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
698
699=cut
700
701checkOptree(note => q{},
702 bcopts => q{-exec},
703 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
704 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
705# 1 <;> nextstate(main 662 (eval 42):1) v
706# 2 <0> pushmark s
707# 3 <0> pushmark s
708# 4 <#> gv[*old] s
709# 5 <1> rv2av[t9] lK/1
710# 6 <@> sort lKS*
711# 7 <0> pushmark s
712# 8 <#> gv[*new] s
713# 9 <1> rv2av[t2] lKRM*/1
714# a <2> aassign[t14] KS
715# b <1> leavesub[1 ref] K/REFC,1
716EOT_EOT
717# 1 <;> nextstate(main 578 (eval 15):1) v
718# 2 <0> pushmark s
719# 3 <0> pushmark s
720# 4 <$> gv(*old) s
721# 5 <1> rv2av[t5] lK/1
722# 6 <@> sort lKS*
723# 7 <0> pushmark s
724# 8 <$> gv(*new) s
725# 9 <1> rv2av[t1] lKRM*/1
726# a <2> aassign[t6] KS
727# b <1> leavesub[1 ref] K/REFC,1
728EONT_EONT
729
730
731=for gentest
732
733# chunk: # you should have a good reason to do this!
734@articles = sort {$FooPack::b <=> $FooPack::a} @files;
735
736=cut
737
738checkOptree(note => q{},
739 bcopts => q{-exec},
740 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
741 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
742# 1 <;> nextstate(main 667 (eval 44):1) v
743# 2 <0> pushmark s
744# 3 <0> pushmark s
745# 4 <#> gv[*files] s
746# 5 <1> rv2av[t7] lK/1
747# 6 <@> sort lKS*
748# 7 <0> pushmark s
749# 8 <#> gv[*articles] s
750# 9 <1> rv2av[t2] lKRM*/1
751# a <2> aassign[t8] KS
752# b <1> leavesub[1 ref] K/REFC,1
753EOT_EOT
754# 1 <;> nextstate(main 546 (eval 15):1) v
755# 2 <0> pushmark s
756# 3 <0> pushmark s
757# 4 <$> gv(*files) s
758# 5 <1> rv2av[t3] lK/1
759# 6 <@> sort lKS*
760# 7 <0> pushmark s
761# 8 <$> gv(*articles) s
762# 9 <1> rv2av[t1] lKRM*/1
763# a <2> aassign[t4] KS
764# b <1> leavesub[1 ref] K/REFC,1
765EONT_EONT
766
767
768=for gentest
769
770# chunk: # fancy
771@result = sort { $a <=> $b } grep { $_ == $_ } @input;
772
773=cut
774
775checkOptree(note => q{},
776 bcopts => q{-exec},
777 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
778 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
779# 1 <;> nextstate(main 673 (eval 46):1) v
780# 2 <0> pushmark s
781# 3 <0> pushmark s
782# 4 <0> pushmark s
783# 5 <#> gv[*input] s
784# 6 <1> rv2av[t9] lKM/1
785# 7 <@> grepstart lK*
786# 8 <|> grepwhile(other->9)[t10] lK
787# 9 <#> gvsv[*_] s
788# a <#> gvsv[*_] s
789# b <2> eq sK/2
790# - <@> scope sK
791# goto 8
792# c <@> sort lK/NUM
793# d <0> pushmark s
794# e <#> gv[*result] s
795# f <1> rv2av[t2] lKRM*/1
796# g <2> aassign[t5] KS/COMMON
797# h <1> leavesub[1 ref] K/REFC,1
798EOT_EOT
799# 1 <;> nextstate(main 547 (eval 15):1) v
800# 2 <0> pushmark s
801# 3 <0> pushmark s
802# 4 <0> pushmark s
803# 5 <$> gv(*input) s
804# 6 <1> rv2av[t3] lKM/1
805# 7 <@> grepstart lK*
806# 8 <|> grepwhile(other->9)[t4] lK
807# 9 <$> gvsv(*_) s
808# a <$> gvsv(*_) s
809# b <2> eq sK/2
810# - <@> scope sK
811# goto 8
812# c <@> sort lK/NUM
813# d <0> pushmark s
814# e <$> gv(*result) s
815# f <1> rv2av[t1] lKRM*/1
816# g <2> aassign[t2] KS/COMMON
817# h <1> leavesub[1 ref] K/REFC,1
818EONT_EONT
819
820
821=for gentest
822
823# chunk: # void return context sort
824sort { $a <=> $b } @input;
825
826=cut
827
828checkOptree(note => q{},
829 bcopts => q{-exec},
830 code => q{sort { $a <=> $b } @input; },
831 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
832# 1 <;> nextstate(main 678 (eval 48):1) v
833# 2 <0> pushmark s
834# 3 <#> gv[*input] s
835# 4 <1> rv2av[t5] lK/1
836# 5 <@> sort K/NUM
837# 6 <1> leavesub[1 ref] K/REFC,1
838EOT_EOT
839# 1 <;> nextstate(main 546 (eval 15):1) v
840# 2 <0> pushmark s
841# 3 <$> gv(*input) s
842# 4 <1> rv2av[t2] lK/1
843# 5 <@> sort K/NUM
844# 6 <1> leavesub[1 ref] K/REFC,1
845EONT_EONT
846
847
848=for gentest
849
850# chunk: # more void context, propagating ?
851sort { $a <=> $b } grep { $_ == $_ } @input;
852
853=cut
854
855checkOptree(note => q{},
856 bcopts => q{-exec},
857 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
858 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
859# 1 <;> nextstate(main 684 (eval 50):1) v
860# 2 <0> pushmark s
861# 3 <0> pushmark s
862# 4 <#> gv[*input] s
863# 5 <1> rv2av[t7] lKM/1
864# 6 <@> grepstart lK*
865# 7 <|> grepwhile(other->8)[t8] lK
866# 8 <#> gvsv[*_] s
867# 9 <#> gvsv[*_] s
868# a <2> eq sK/2
869# - <@> scope sK
870# goto 7
871# b <@> sort K/NUM
872# c <1> leavesub[1 ref] K/REFC,1
873EOT_EOT
874# 1 <;> nextstate(main 547 (eval 15):1) v
875# 2 <0> pushmark s
876# 3 <0> pushmark s
877# 4 <$> gv(*input) s
878# 5 <1> rv2av[t2] lKM/1
879# 6 <@> grepstart lK*
880# 7 <|> grepwhile(other->8)[t3] lK
881# 8 <$> gvsv(*_) s
882# 9 <$> gvsv(*_) s
883# a <2> eq sK/2
884# - <@> scope sK
885# goto 7
886# b <@> sort K/NUM
887# c <1> leavesub[1 ref] K/REFC,1
888EONT_EONT
889
890
891=for gentest
892
893# chunk: # scalar return context sort
894$s = sort { $a <=> $b } @input;
895
896=cut
897
898checkOptree(note => q{},
899 bcopts => q{-exec},
900 code => q{$s = sort { $a <=> $b } @input; },
901 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
902# 1 <;> nextstate(main 689 (eval 52):1) v
903# 2 <0> pushmark s
904# 3 <#> gv[*input] s
905# 4 <1> rv2av[t6] lK/1
906# 5 <@> sort sK/NUM
907# 6 <#> gvsv[*s] s
908# 7 <2> sassign sKS/2
909# 8 <1> leavesub[1 ref] K/REFC,1
910EOT_EOT
911# 1 <;> nextstate(main 546 (eval 15):1) v
912# 2 <0> pushmark s
913# 3 <$> gv(*input) s
914# 4 <1> rv2av[t2] lK/1
915# 5 <@> sort sK/NUM
916# 6 <$> gvsv(*s) s
917# 7 <2> sassign sKS/2
918# 8 <1> leavesub[1 ref] K/REFC,1
919EONT_EONT
920
921
922=for gentest
923
924# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
925
926=cut
927
928checkOptree(note => q{},
929 bcopts => q{-exec},
930 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
931 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
932# 1 <;> nextstate(main 695 (eval 54):1) v
933# 2 <0> pushmark s
934# 3 <0> pushmark s
935# 4 <#> gv[*input] s
936# 5 <1> rv2av[t8] lKM/1
937# 6 <@> grepstart lK*
938# 7 <|> grepwhile(other->8)[t9] lK
939# 8 <#> gvsv[*_] s
940# 9 <#> gvsv[*_] s
941# a <2> eq sK/2
942# - <@> scope sK
943# goto 7
944# b <@> sort sK/NUM
945# c <#> gvsv[*s] s
946# d <2> sassign sKS/2
947# e <1> leavesub[1 ref] K/REFC,1
948EOT_EOT
949# 1 <;> nextstate(main 547 (eval 15):1) v
950# 2 <0> pushmark s
951# 3 <0> pushmark s
952# 4 <$> gv(*input) s
953# 5 <1> rv2av[t2] lKM/1
954# 6 <@> grepstart lK*
955# 7 <|> grepwhile(other->8)[t3] lK
956# 8 <$> gvsv(*_) s
957# 9 <$> gvsv(*_) s
958# a <2> eq sK/2
959# - <@> scope sK
960# goto 7
961# b <@> sort sK/NUM
962# c <$> gvsv(*s) s
963# d <2> sassign sKS/2
964# e <1> leavesub[1 ref] K/REFC,1
965EONT_EONT
966