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