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