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