ext/B/t/f_sort.t

   1 #!perl
   2
   3 BEGIN {
   4     chdir q(t);
   5     @INC = qw(../lib ../ext/B/t);
   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     }
  11     if (!$Config::Config{useperlio}) {
  12         print "1..0 # Skip -- need perlio to walk the optree\n";
  13         exit 0;
  14     }
  15     if ($Config::Config{'extensions'} !~ /\bData\/Dumper\b/) {
  16         print
  17             "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
  18         exit 0;
  19     }
  20     if ($] < 5.009) {
  21         print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
  22         exit 0;
  23     }
  24     require q(./test.pl);
  25 }
  26 use OptreeCheck;
  27 plan tests => 20;
  28
  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
  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
  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[t5] KS
 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
 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
 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
 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[t5] KS
 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
 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[t5] KS
 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
 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[t5] KS
 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
 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
 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
 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
 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
 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 sKRM/1
 513 # i      <1> srefgen sK/1
 514 # j      <@> leave lKP
 515 #            goto 9
 516 # k  <@> sort lKMS*
 517 # l  <@> mapstart lK*
 518 # m  <|> mapwhile(other->n)[t26] lK
 519 # n      <#> gv[*_] s
 520 # o      <1> rv2sv sKM/DREFAV,1
 521 # p      <1> rv2av[t4] sKR/1
 522 # q      <$> const[IV 0] s
 523 # r      <2> aelem sK/2
 524 # -      <@> scope lK
 525 #            goto m
 526 # s  <0> pushmark s
 527 # t  <#> gv[*new] s
 528 # u  <1> rv2av[t2] lKRM*/1
 529 # v  <2> aassign[t27] KS/COMMON
 530 # w  <1> leavesub[1 ref] K/REFC,1
 531 EOT_EOT
 532 # 1  <;> nextstate(main 609 (eval 34):3) v
 533 # 2  <0> pushmark s
 534 # 3  <0> pushmark s
 535 # 4  <0> pushmark s
 536 # 5  <0> pushmark s
 537 # 6  <$> gv(*old) s
 538 # 7  <1> rv2av[t10] lKM/1
 539 # 8  <@> mapstart lK*
 540 # 9  <|> mapwhile(other->a)[t11] lK
 541 # a      <0> enter l
 542 # b      <;> nextstate(main 608 (eval 34):2) v
 543 # c      <0> pushmark s
 544 # d      <$> gvsv(*_) s
 545 # e      </> match(/"=(\\d+)"/) l/RTIME
 546 # f      <$> gvsv(*_) s
 547 # g      <1> uc[t9] sK/1
 548 # h      <@> anonlist sKRM/1
 549 # i      <1> srefgen sK/1
 550 # j      <@> leave lKP
 551 #            goto 9
 552 # k  <@> sort lKMS*
 553 # l  <@> mapstart lK*
 554 # m  <|> mapwhile(other->n)[t12] lK
 555 # n      <$> gv(*_) s
 556 # o      <1> rv2sv sKM/DREFAV,1
 557 # p      <1> rv2av[t2] sKR/1
 558 # q      <$> const(IV 0) s
 559 # r      <2> aelem sK/2
 560 # -      <@> scope lK
 561 #            goto m
 562 # s  <0> pushmark s
 563 # t  <$> gv(*new) s
 564 # u  <1> rv2av[t1] lKRM*/1
 565 # v  <2> aassign[t13] KS/COMMON
 566 # w  <1> leavesub[1 ref] K/REFC,1
 567 EONT_EONT
 568
 569
 570 =for gentest
 571
 572 # chunk: # using a prototype allows you to use any comparison subroutine
 573 # as a sort subroutine (including other package's subroutines)
 574 package other;
 575 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
 576 package main;
 577 @new = sort other::backwards @old;
 578
 579 =cut
 580
 581 checkOptree(name   => q{sort other::sub LIST },
 582             bcopts => q{-exec},
 583             code   => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
 584                         package main; @new = sort other::backwards @old; },
 585             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 586 # 1  <;> nextstate(main 614 (eval 36):2) v
 587 # 2  <0> pushmark s
 588 # 3  <0> pushmark s
 589 # 4  <$> const[PV "other::backwards"] s/BARE
 590 # 5  <#> gv[*old] s
 591 # 6  <1> rv2av[t4] lK/1
 592 # 7  <@> sort lKS
 593 # 8  <0> pushmark s
 594 # 9  <#> gv[*new] s
 595 # a  <1> rv2av[t2] lKRM*/1
 596 # b  <2> aassign[t5] KS
 597 # c  <1> leavesub[1 ref] K/REFC,1
 598 EOT_EOT
 599 # 1  <;> nextstate(main 614 (eval 36):2) v
 600 # 2  <0> pushmark s
 601 # 3  <0> pushmark s
 602 # 4  <$> const(PV "other::backwards") s/BARE
 603 # 5  <$> gv(*old) s
 604 # 6  <1> rv2av[t2] lK/1
 605 # 7  <@> sort lKS
 606 # 8  <0> pushmark s
 607 # 9  <$> gv(*new) s
 608 # a  <1> rv2av[t1] lKRM*/1
 609 # b  <2> aassign[t3] KS
 610 # c  <1> leavesub[1 ref] K/REFC,1
 611 EONT_EONT
 612
 613
 614 =for gentest
 615
 616 # chunk: # repeat, condensed. $main::a and $b are unaffected
 617 sub other::backwards ($$) { $_[1] cmp $_[0]; }
 618 @new = sort other::backwards @old;
 619
 620 =cut
 621
 622 checkOptree(note   => q{},
 623             bcopts => q{-exec},
 624             code   => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
 625             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 626 # 1  <;> nextstate(main 619 (eval 38):1) v
 627 # 2  <0> pushmark s
 628 # 3  <0> pushmark s
 629 # 4  <$> const[PV "other::backwards"] s/BARE
 630 # 5  <#> gv[*old] s
 631 # 6  <1> rv2av[t4] lK/1
 632 # 7  <@> sort lKS
 633 # 8  <0> pushmark s
 634 # 9  <#> gv[*new] s
 635 # a  <1> rv2av[t2] lKRM*/1
 636 # b  <2> aassign[t5] KS
 637 # c  <1> leavesub[1 ref] K/REFC,1
 638 EOT_EOT
 639 # 1  <;> nextstate(main 546 (eval 15):1) v
 640 # 2  <0> pushmark s
 641 # 3  <0> pushmark s
 642 # 4  <$> const(PV "other::backwards") s/BARE
 643 # 5  <$> gv(*old) s
 644 # 6  <1> rv2av[t2] lK/1
 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
 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 checkOptree(note   => q{},
 663             bcopts => q{-exec},
 664             code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 665             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 666 # 1  <;> nextstate(main 656 (eval 40):1) v
 667 # 2  <0> pushmark s
 668 # 3  <0> pushmark s
 669 # 4  <#> gv[*old] s
 670 # 5  <1> rv2av[t9] lK/1
 671 # 6  <@> sort lKS*
 672 # 7  <0> pushmark s
 673 # 8  <#> gv[*new] s
 674 # 9  <1> rv2av[t2] lKRM*/1
 675 # a  <2> aassign[t14] KS
 676 # b  <1> leavesub[1 ref] K/REFC,1
 677 EOT_EOT
 678 # 1  <;> nextstate(main 578 (eval 15):1) v
 679 # 2  <0> pushmark s
 680 # 3  <0> pushmark s
 681 # 4  <$> gv(*old) s
 682 # 5  <1> rv2av[t5] lK/1
 683 # 6  <@> sort lKS*
 684 # 7  <0> pushmark s
 685 # 8  <$> gv(*new) s
 686 # 9  <1> rv2av[t1] lKRM*/1
 687 # a  <2> aassign[t6] KS
 688 # b  <1> leavesub[1 ref] K/REFC,1
 689 EONT_EONT
 690
 691
 692 =for gentest
 693
 694 # chunk: # force use of mergesort (not portable outside Perl 5.8)
 695 use sort '_mergesort';
 696 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 697
 698 =cut
 699
 700 checkOptree(note   => q{},
 701             bcopts => q{-exec},
 702             code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 703             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 704 # 1  <;> nextstate(main 662 (eval 42):1) v
 705 # 2  <0> pushmark s
 706 # 3  <0> pushmark s
 707 # 4  <#> gv[*old] s
 708 # 5  <1> rv2av[t9] lK/1
 709 # 6  <@> sort lKS*
 710 # 7  <0> pushmark s
 711 # 8  <#> gv[*new] s
 712 # 9  <1> rv2av[t2] lKRM*/1
 713 # a  <2> aassign[t14] KS
 714 # b  <1> leavesub[1 ref] K/REFC,1
 715 EOT_EOT
 716 # 1  <;> nextstate(main 578 (eval 15):1) v
 717 # 2  <0> pushmark s
 718 # 3  <0> pushmark s
 719 # 4  <$> gv(*old) s
 720 # 5  <1> rv2av[t5] lK/1
 721 # 6  <@> sort lKS*
 722 # 7  <0> pushmark s
 723 # 8  <$> gv(*new) s
 724 # 9  <1> rv2av[t1] lKRM*/1
 725 # a  <2> aassign[t6] KS
 726 # b  <1> leavesub[1 ref] K/REFC,1
 727 EONT_EONT
 728
 729
 730 =for gentest
 731
 732 # chunk: # you should have a good reason to do this!
 733 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 734
 735 =cut
 736
 737 checkOptree(note   => q{},
 738             bcopts => q{-exec},
 739             code   => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
 740             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 741 # 1  <;> nextstate(main 667 (eval 44):1) v
 742 # 2  <0> pushmark s
 743 # 3  <0> pushmark s
 744 # 4  <#> gv[*files] s
 745 # 5  <1> rv2av[t7] lK/1
 746 # 6  <@> sort lKS*
 747 # 7  <0> pushmark s
 748 # 8  <#> gv[*articles] s
 749 # 9  <1> rv2av[t2] lKRM*/1
 750 # a  <2> aassign[t8] KS
 751 # b  <1> leavesub[1 ref] K/REFC,1
 752 EOT_EOT
 753 # 1  <;> nextstate(main 546 (eval 15):1) v
 754 # 2  <0> pushmark s
 755 # 3  <0> pushmark s
 756 # 4  <$> gv(*files) s
 757 # 5  <1> rv2av[t3] lK/1
 758 # 6  <@> sort lKS*
 759 # 7  <0> pushmark s
 760 # 8  <$> gv(*articles) s
 761 # 9  <1> rv2av[t1] lKRM*/1
 762 # a  <2> aassign[t4] KS
 763 # b  <1> leavesub[1 ref] K/REFC,1
 764 EONT_EONT
 765
 766
 767 =for gentest
 768
 769 # chunk: # fancy
 770 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
 771
 772 =cut
 773
 774 checkOptree(note   => q{},
 775             bcopts => q{-exec},
 776             code   => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
 777             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 778 # 1  <;> nextstate(main 673 (eval 46):1) v
 779 # 2  <0> pushmark s
 780 # 3  <0> pushmark s
 781 # 4  <0> pushmark s
 782 # 5  <#> gv[*input] s
 783 # 6  <1> rv2av[t9] lKM/1
 784 # 7  <@> grepstart lK*
 785 # 8  <|> grepwhile(other->9)[t10] lK
 786 # 9      <#> gvsv[*_] s
 787 # a      <#> gvsv[*_] s
 788 # b      <2> eq sK/2
 789 # -      <@> scope sK
 790 #            goto 8
 791 # c  <@> sort lK/NUM
 792 # d  <0> pushmark s
 793 # e  <#> gv[*result] s
 794 # f  <1> rv2av[t2] lKRM*/1
 795 # g  <2> aassign[t5] KS/COMMON
 796 # h  <1> leavesub[1 ref] K/REFC,1
 797 EOT_EOT
 798 # 1  <;> nextstate(main 547 (eval 15):1) v
 799 # 2  <0> pushmark s
 800 # 3  <0> pushmark s
 801 # 4  <0> pushmark s
 802 # 5  <$> gv(*input) s
 803 # 6  <1> rv2av[t3] lKM/1
 804 # 7  <@> grepstart lK*
 805 # 8  <|> grepwhile(other->9)[t4] lK
 806 # 9      <$> gvsv(*_) s
 807 # a      <$> gvsv(*_) s
 808 # b      <2> eq sK/2
 809 # -      <@> scope sK
 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 # -      <@> scope sK
 869 #            goto 7
 870 # b  <@> sort K/NUM
 871 # c  <1> leavesub[1 ref] K/REFC,1
 872 EOT_EOT
 873 # 1  <;> nextstate(main 547 (eval 15):1) v
 874 # 2  <0> pushmark s
 875 # 3  <0> pushmark s
 876 # 4  <$> gv(*input) s
 877 # 5  <1> rv2av[t2] lKM/1
 878 # 6  <@> grepstart lK*
 879 # 7  <|> grepwhile(other->8)[t3] lK
 880 # 8      <$> gvsv(*_) s
 881 # 9      <$> gvsv(*_) s
 882 # a      <2> eq sK/2
 883 # -      <@> scope sK
 884 #            goto 7
 885 # b  <@> sort K/NUM
 886 # c  <1> leavesub[1 ref] K/REFC,1
 887 EONT_EONT
 888
 889
 890 =for gentest
 891
 892 # chunk: # scalar return context sort
 893 $s = sort { $a <=> $b } @input;
 894
 895 =cut
 896
 897 checkOptree(note   => q{},
 898             bcopts => q{-exec},
 899             code   => q{$s = sort { $a <=> $b } @input; },
 900             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 901 # 1  <;> nextstate(main 689 (eval 52):1) v
 902 # 2  <0> pushmark s
 903 # 3  <#> gv[*input] s
 904 # 4  <1> rv2av[t6] 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
 909 EOT_EOT
 910 # 1  <;> nextstate(main 546 (eval 15):1) v
 911 # 2  <0> pushmark s
 912 # 3  <$> gv(*input) s
 913 # 4  <1> rv2av[t2] lK/1
 914 # 5  <@> sort sK/NUM
 915 # 6  <$> gvsv(*s) s
 916 # 7  <2> sassign sKS/2
 917 # 8  <1> leavesub[1 ref] K/REFC,1
 918 EONT_EONT
 919
 920
 921 =for gentest
 922
 923 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
 924
 925 =cut
 926
 927 checkOptree(note   => q{},
 928             bcopts => q{-exec},
 929             code   => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
 930             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 931 # 1  <;> nextstate(main 695 (eval 54):1) v
 932 # 2  <0> pushmark s
 933 # 3  <0> pushmark s
 934 # 4  <#> gv[*input] s
 935 # 5  <1> rv2av[t8] lKM/1
 936 # 6  <@> grepstart lK*
 937 # 7  <|> grepwhile(other->8)[t9] lK
 938 # 8      <#> gvsv[*_] s
 939 # 9      <#> gvsv[*_] s
 940 # a      <2> eq sK/2
 941 # -      <@> scope sK
 942 #            goto 7
 943 # b  <@> sort sK/NUM
 944 # c  <#> gvsv[*s] s
 945 # d  <2> sassign sKS/2
 946 # e  <1> leavesub[1 ref] K/REFC,1
 947 EOT_EOT
 948 # 1  <;> nextstate(main 547 (eval 15):1) v
 949 # 2  <0> pushmark s
 950 # 3  <0> pushmark s
 951 # 4  <$> gv(*input) s
 952 # 5  <1> rv2av[t2] lKM/1
 953 # 6  <@> grepstart lK*
 954 # 7  <|> grepwhile(other->8)[t3] lK
 955 # 8      <$> gvsv(*_) s
 956 # 9      <$> gvsv(*_) s
 957 # a      <2> eq sK/2
 958 # -      <@> scope sK
 959 #            goto 7
 960 # b  <@> sort sK/NUM
 961 # c  <$> gvsv(*s) s
 962 # d  <2> sassign sKS/2
 963 # e  <1> leavesub[1 ref] K/REFC,1
 964 EONT_EONT
 965