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