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] lKM/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/COM_AGG
 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] lKM/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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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
 282 # 6  <1> keys[t10] lKM/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/COM_AGG
 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
 295 # 6  <1> keys[t4] lKM/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/COM_AGG
 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] lKM/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/COM_AGG
 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] lKM/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/COM_AGG
 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] lKM/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] lKM/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] lKM
 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
 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      <+> multideref($_->[0]) sK
 519 #            goto l
 520 # n  <0> pushmark s
 521 # o  <#> gv[*new] s
 522 # p  <1> rv2av[t2] lKRM*/1
 523 # q  <2> aassign[t22] KS/COM_AGG
 524 # r  <1> leavesub[1 ref] K/REFC,1
 525 EOT_EOT
 526 # 1  <;> nextstate(main 609 (eval 34):3) v:{
 527 # 2  <0> pushmark s
 528 # 3  <0> pushmark s
 529 # 4  <0> pushmark s
 530 # 5  <0> pushmark s
 531 # 6  <$> gv(*old) s
 532 # 7  <1> rv2av[t10] lKM/1
 533 # 8  <@> mapstart lK
 534 # 9  <|> mapwhile(other->a)[t11] lKM
 535 # a      <0> enter l
 536 # b      <;> nextstate(main 608 (eval 34):2) v:{
 537 # c      <0> pushmark s
 538 # d      <$> gvsv(*_) s
 539 # e      </> match(/"=(\\d+)"/) l
 540 # f      <$> gvsv(*_) s
 541 # g      <1> uc[t9] sK/1
 542 # h      <@> anonlist sK*/1
 543 # i      <@> leave lKP
 544 #            goto 9
 545 # j  <@> sort lKMS*
 546 # k  <@> mapstart lK
 547 # l  <|> mapwhile(other->m)[t12] lK
 548 # m      <+> multideref($_->[0]) sK
 549 #            goto l
 550 # n  <0> pushmark s
 551 # o  <$> gv(*new) s
 552 # p  <1> rv2av[t1] lKRM*/1
 553 # q  <2> aassign[t13] KS/COM_AGG
 554 # r  <1> leavesub[1 ref] K/REFC,1
 555 EONT_EONT
 556
 557
 558 =for gentest
 559
 560 # chunk: # using a prototype allows you to use any comparison subroutine
 561 # as a sort subroutine (including other package's subroutines)
 562 package other;
 563 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
 564 package main;
 565 @new = sort other::backwards @old;
 566
 567 =cut
 568
 569 checkOptree(name   => q{sort other::sub LIST },
 570             bcopts => q{-exec},
 571             code   => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
 572                         package main; @new = sort other::backwards @old; },
 573             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 574 # 1  <;> nextstate(main 614 (eval 36):2) v:{
 575 # 2  <0> pushmark s
 576 # 3  <0> pushmark s
 577 # 4  <$> const[PV "other::backwards"] s/BARE
 578 # 5  <#> gv[*old] s
 579 # 6  <1> rv2av[t4] lKM/1
 580 # 7  <@> sort lKS
 581 # 8  <0> pushmark s
 582 # 9  <#> gv[*new] s
 583 # a  <1> rv2av[t2] lKRM*/1
 584 # b  <2> aassign[t5] KS/COM_AGG
 585 # c  <1> leavesub[1 ref] K/REFC,1
 586 EOT_EOT
 587 # 1  <;> nextstate(main 614 (eval 36):2) v:{
 588 # 2  <0> pushmark s
 589 # 3  <0> pushmark s
 590 # 4  <$> const(PV "other::backwards") s/BARE
 591 # 5  <$> gv(*old) s
 592 # 6  <1> rv2av[t2] lKM/1
 593 # 7  <@> sort lKS
 594 # 8  <0> pushmark s
 595 # 9  <$> gv(*new) s
 596 # a  <1> rv2av[t1] lKRM*/1
 597 # b  <2> aassign[t3] KS/COM_AGG
 598 # c  <1> leavesub[1 ref] K/REFC,1
 599 EONT_EONT
 600
 601
 602 =for gentest
 603
 604 # chunk: # repeat, condensed. $main::a and $b are unaffected
 605 sub other::backwards ($$) { $_[1] cmp $_[0]; }
 606 @new = sort other::backwards @old;
 607
 608 =cut
 609
 610 checkOptree(note   => q{},
 611             bcopts => q{-exec},
 612             code   => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
 613             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 614 # 1  <;> nextstate(main 619 (eval 38):1) v
 615 # 2  <0> pushmark s
 616 # 3  <0> pushmark s
 617 # 4  <$> const[PV "other::backwards"] s/BARE
 618 # 5  <#> gv[*old] s
 619 # 6  <1> rv2av[t4] lKM/1
 620 # 7  <@> sort lKS
 621 # 8  <0> pushmark s
 622 # 9  <#> gv[*new] s
 623 # a  <1> rv2av[t2] lKRM*/1
 624 # b  <2> aassign[t5] KS/COM_AGG
 625 # c  <1> leavesub[1 ref] K/REFC,1
 626 EOT_EOT
 627 # 1  <;> nextstate(main 546 (eval 15):1) v
 628 # 2  <0> pushmark s
 629 # 3  <0> pushmark s
 630 # 4  <$> const(PV "other::backwards") s/BARE
 631 # 5  <$> gv(*old) s
 632 # 6  <1> rv2av[t2] lKM/1
 633 # 7  <@> sort lKS
 634 # 8  <0> pushmark s
 635 # 9  <$> gv(*new) s
 636 # a  <1> rv2av[t1] lKRM*/1
 637 # b  <2> aassign[t3] KS/COM_AGG
 638 # c  <1> leavesub[1 ref] K/REFC,1
 639 EONT_EONT
 640
 641
 642 =for gentest
 643
 644 # chunk: # guarantee stability, regardless of algorithm
 645 use sort 'stable';
 646 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 647
 648 =cut
 649
 650 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
 651 # 1  <;> nextstate(main 656 (eval 40):1) v:%,{
 652 # 2  <0> pushmark s
 653 # 3  <0> pushmark s
 654 # 4  <#> gv[*old] s
 655 # 5  <1> rv2av[t9] lKM/1
 656 # 6  <@> sort lKS*/STABLE
 657 # 7  <0> pushmark s
 658 # 8  <#> gv[*new] s
 659 # 9  <1> rv2av[t2] lKRM*/1
 660 # a  <2> aassign[t14] KS/COM_AGG
 661 # b  <1> leavesub[1 ref] K/REFC,1
 662 EOT_EOT
 663 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 664 # 2  <0> pushmark s
 665 # 3  <0> pushmark s
 666 # 4  <$> gv(*old) s
 667 # 5  <1> rv2av[t5] lKM/1
 668 # 6  <@> sort lKS*/STABLE
 669 # 7  <0> pushmark s
 670 # 8  <$> gv(*new) s
 671 # 9  <1> rv2av[t1] lKRM*/1
 672 # a  <2> aassign[t6] KS/COM_AGG
 673 # b  <1> leavesub[1 ref] K/REFC,1
 674 EONT_EONT
 675
 676
 677 checkOptree(note   => q{},
 678             bcopts => q{-exec},
 679             code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 680             expect => $expect, expect_nt => $expect_nt);
 681
 682 =for gentest
 683
 684 # chunk: # force use of mergesort (not portable outside Perl 5.8)
 685 use sort '_mergesort';
 686 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 687
 688 =cut
 689
 690 checkOptree(note   => q{},
 691             bcopts => q{-exec},
 692             code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 693             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 694 # 1  <;> nextstate(main 662 (eval 42):1) v:%,{
 695 # 2  <0> pushmark s
 696 # 3  <0> pushmark s
 697 # 4  <#> gv[*old] s
 698 # 5  <1> rv2av[t9] lKM/1
 699 # 6  <@> sort lKS*
 700 # 7  <0> pushmark s
 701 # 8  <#> gv[*new] s
 702 # 9  <1> rv2av[t2] lKRM*/1
 703 # a  <2> aassign[t14] KS/COM_AGG
 704 # b  <1> leavesub[1 ref] K/REFC,1
 705 EOT_EOT
 706 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 707 # 2  <0> pushmark s
 708 # 3  <0> pushmark s
 709 # 4  <$> gv(*old) s
 710 # 5  <1> rv2av[t5] lKM/1
 711 # 6  <@> sort lKS*
 712 # 7  <0> pushmark s
 713 # 8  <$> gv(*new) s
 714 # 9  <1> rv2av[t1] lKRM*/1
 715 # a  <2> aassign[t6] KS/COM_AGG
 716 # b  <1> leavesub[1 ref] K/REFC,1
 717 EONT_EONT
 718
 719
 720 =for gentest
 721
 722 # chunk: # you should have a good reason to do this!
 723 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 724
 725 =cut
 726
 727 checkOptree(note   => q{},
 728             bcopts => q{-exec},
 729             code   => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
 730             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 731 # 1  <;> nextstate(main 667 (eval 44):1) v
 732 # 2  <0> pushmark s
 733 # 3  <0> pushmark s
 734 # 4  <#> gv[*files] s
 735 # 5  <1> rv2av[t7] lKM/1
 736 # 6  <@> sort lKS*
 737 # 7  <0> pushmark s
 738 # 8  <#> gv[*articles] s
 739 # 9  <1> rv2av[t2] lKRM*/1
 740 # a  <2> aassign[t8] KS/COM_AGG
 741 # b  <1> leavesub[1 ref] K/REFC,1
 742 EOT_EOT
 743 # 1  <;> nextstate(main 546 (eval 15):1) v
 744 # 2  <0> pushmark s
 745 # 3  <0> pushmark s
 746 # 4  <$> gv(*files) s
 747 # 5  <1> rv2av[t3] lKM/1
 748 # 6  <@> sort lKS*
 749 # 7  <0> pushmark s
 750 # 8  <$> gv(*articles) s
 751 # 9  <1> rv2av[t1] lKRM*/1
 752 # a  <2> aassign[t4] KS/COM_AGG
 753 # b  <1> leavesub[1 ref] K/REFC,1
 754 EONT_EONT
 755
 756
 757 =for gentest
 758
 759 # chunk: # fancy
 760 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
 761
 762 =cut
 763
 764 checkOptree(note   => q{},
 765             bcopts => q{-exec},
 766             code   => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
 767             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 768 # 1  <;> nextstate(main 673 (eval 46):1) v
 769 # 2  <0> pushmark s
 770 # 3  <0> pushmark s
 771 # 4  <0> pushmark s
 772 # 5  <#> gv[*input] s
 773 # 6  <1> rv2av[t9] lKM/1
 774 # 7  <@> grepstart lK
 775 # 8  <|> grepwhile(other->9)[t10] lK
 776 # 9      <#> gvsv[*_] s
 777 # a      <#> gvsv[*_] s
 778 # b      <2> eq sK/2
 779 #            goto 8
 780 # c  <@> sort lK/NUM
 781 # d  <0> pushmark s
 782 # e  <#> gv[*result] s
 783 # f  <1> rv2av[t2] lKRM*/1
 784 # g  <2> aassign[t3] KS/COM_AGG
 785 # h  <1> leavesub[1 ref] K/REFC,1
 786 EOT_EOT
 787 # 1  <;> nextstate(main 547 (eval 15):1) v
 788 # 2  <0> pushmark s
 789 # 3  <0> pushmark s
 790 # 4  <0> pushmark s
 791 # 5  <$> gv(*input) s
 792 # 6  <1> rv2av[t3] lKM/1
 793 # 7  <@> grepstart lK
 794 # 8  <|> grepwhile(other->9)[t4] lK
 795 # 9      <$> gvsv(*_) s
 796 # a      <$> gvsv(*_) s
 797 # b      <2> eq sK/2
 798 #            goto 8
 799 # c  <@> sort lK/NUM
 800 # d  <0> pushmark s
 801 # e  <$> gv(*result) s
 802 # f  <1> rv2av[t1] lKRM*/1
 803 # g  <2> aassign[t2] KS/COM_AGG
 804 # h  <1> leavesub[1 ref] K/REFC,1
 805 EONT_EONT
 806
 807
 808 =for gentest
 809
 810 # chunk: # void return context sort
 811 sort { $a <=> $b } @input;
 812
 813 =cut
 814
 815 checkOptree(note   => q{},
 816             bcopts => q{-exec},
 817             code   => q{sort { $a <=> $b } @input; },
 818             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 819 # 1  <;> nextstate(main 678 (eval 48):1) v
 820 # 2  <0> pushmark s
 821 # 3  <#> gv[*input] s
 822 # 4  <1> rv2av[t5] lK/1
 823 # 5  <@> sort K/NUM
 824 # 6  <1> leavesub[1 ref] K/REFC,1
 825 EOT_EOT
 826 # 1  <;> nextstate(main 546 (eval 15):1) v
 827 # 2  <0> pushmark s
 828 # 3  <$> gv(*input) s
 829 # 4  <1> rv2av[t2] lK/1
 830 # 5  <@> sort K/NUM
 831 # 6  <1> leavesub[1 ref] K/REFC,1
 832 EONT_EONT
 833
 834
 835 =for gentest
 836
 837 # chunk: # more void context, propagating ?
 838 sort { $a <=> $b } grep { $_ == $_ } @input;
 839
 840 =cut
 841
 842 checkOptree(note   => q{},
 843             bcopts => q{-exec},
 844             code   => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
 845             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 846 # 1  <;> nextstate(main 684 (eval 50):1) v
 847 # 2  <0> pushmark s
 848 # 3  <0> pushmark s
 849 # 4  <#> gv[*input] s
 850 # 5  <1> rv2av[t7] lKM/1
 851 # 6  <@> grepstart lK
 852 # 7  <|> grepwhile(other->8)[t8] lK
 853 # 8      <#> gvsv[*_] s
 854 # 9      <#> gvsv[*_] s
 855 # a      <2> eq sK/2
 856 #            goto 7
 857 # b  <@> sort K/NUM
 858 # c  <1> leavesub[1 ref] K/REFC,1
 859 EOT_EOT
 860 # 1  <;> nextstate(main 547 (eval 15):1) v
 861 # 2  <0> pushmark s
 862 # 3  <0> pushmark s
 863 # 4  <$> gv(*input) s
 864 # 5  <1> rv2av[t2] lKM/1
 865 # 6  <@> grepstart lK
 866 # 7  <|> grepwhile(other->8)[t3] lK
 867 # 8      <$> gvsv(*_) s
 868 # 9      <$> gvsv(*_) s
 869 # a      <2> eq sK/2
 870 #            goto 7
 871 # b  <@> sort K/NUM
 872 # c  <1> leavesub[1 ref] K/REFC,1
 873 EONT_EONT
 874
 875
 876 =for gentest
 877
 878 # chunk: # scalar return context sort
 879 $s = sort { $a <=> $b } @input;
 880
 881 =cut
 882
 883 checkOptree(note   => q{},
 884             bcopts => q{-exec},
 885             code   => q{$s = sort { $a <=> $b } @input; },
 886             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 887 # 1  <;> nextstate(main 689 (eval 52):1) v:{
 888 # 2  <0> pushmark s
 889 # 3  <#> gv[*input] s
 890 # 4  <1> rv2av[t6] lK/1
 891 # 5  <@> sort sK/NUM
 892 # 6  <#> gvsv[*s] s
 893 # 7  <2> sassign sKS/2
 894 # 8  <1> leavesub[1 ref] K/REFC,1
 895 EOT_EOT
 896 # 1  <;> nextstate(main 546 (eval 15):1) v:{
 897 # 2  <0> pushmark s
 898 # 3  <$> gv(*input) s
 899 # 4  <1> rv2av[t2] lK/1
 900 # 5  <@> sort sK/NUM
 901 # 6  <$> gvsv(*s) s
 902 # 7  <2> sassign sKS/2
 903 # 8  <1> leavesub[1 ref] K/REFC,1
 904 EONT_EONT
 905
 906
 907 =for gentest
 908
 909 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
 910
 911 =cut
 912
 913 checkOptree(note   => q{},
 914             bcopts => q{-exec},
 915             code   => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
 916             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 917 # 1  <;> nextstate(main 695 (eval 54):1) v:{
 918 # 2  <0> pushmark s
 919 # 3  <0> pushmark s
 920 # 4  <#> gv[*input] s
 921 # 5  <1> rv2av[t8] lKM/1
 922 # 6  <@> grepstart lK
 923 # 7  <|> grepwhile(other->8)[t9] lK
 924 # 8      <#> gvsv[*_] s
 925 # 9      <#> gvsv[*_] s
 926 # a      <2> eq sK/2
 927 #            goto 7
 928 # b  <@> sort sK/NUM
 929 # c  <#> gvsv[*s] s
 930 # d  <2> sassign sKS/2
 931 # e  <1> leavesub[1 ref] K/REFC,1
 932 EOT_EOT
 933 # 1  <;> nextstate(main 547 (eval 15):1) v:{
 934 # 2  <0> pushmark s
 935 # 3  <0> pushmark s
 936 # 4  <$> gv(*input) s
 937 # 5  <1> rv2av[t2] lKM/1
 938 # 6  <@> grepstart lK
 939 # 7  <|> grepwhile(other->8)[t3] lK
 940 # 8      <$> gvsv(*_) s
 941 # 9      <$> gvsv(*_) s
 942 # a      <2> eq sK/2
 943 #            goto 7
 944 # b  <@> sort sK/NUM
 945 # c  <$> gvsv(*s) s
 946 # d  <2> sassign sKS/2
 947 # e  <1> leavesub[1 ref] K/REFC,1
 948 EONT_EONT
 949