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