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         < 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/COMMON
 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/COMMON
 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/COMMON
 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/COMMON
 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/COMMON
 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/COMMON
 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/COMMON
 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/COMMON
 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/1       < 5.019006
 284 # 5  <1> rv2hv lKRM/1           >=5.019006
 285 # 6  <1> keys[t10] lK/1         < 5.019002
 286 # 6  <1> keys[t10] lKM/1        >=5.019002
 287 # 7  <@> sort lKS*
 288 # 8  <0> pushmark s
 289 # 9  <#> gv[*eldest] s
 290 # a  <1> rv2av[t2] lKRM*/1
 291 # b  <2> aassign[t11] KS/COMMON
 292 # c  <1> leavesub[1 ref] K/REFC,1
 293 EOT_EOT
 294 # 1  <;> nextstate(main 546 (eval 15):1) v
 295 # 2  <0> pushmark s
 296 # 3  <0> pushmark s
 297 # 4  <$> gv(*age) s
 298 # 5  <1> rv2hv[t3] lKRM/1       < 5.019006
 299 # 5  <1> rv2hv lKRM/1           >=5.019006
 300 # 6  <1> keys[t4] lK/1          < 5.019002
 301 # 6  <1> keys[t4] lKM/1         >=5.019002
 302 # 7  <@> sort lKS*
 303 # 8  <0> pushmark s
 304 # 9  <$> gv(*eldest) s
 305 # a  <1> rv2av[t1] lKRM*/1
 306 # b  <2> aassign[t5] KS/COMMON
 307 # c  <1> leavesub[1 ref] K/REFC,1
 308 EONT_EONT
 309
 310
 311 =for gentest
 312
 313 # chunk: # sort using explicit subroutine name
 314 sub byage {
 315     $age{$a} <=> $age{$b};  # presuming numeric
 316 }
 317 @sortedclass = sort byage @class;
 318
 319 =cut
 320
 321 checkOptree(note   => q{},
 322             bcopts => q{-exec},
 323             code   => q{sub byage { $age{$a} <=> $age{$b}; } @sortedclass = sort byage @class; },
 324             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 325 # 1  <;> nextstate(main 597 (eval 30):1) v
 326 # 2  <0> pushmark s
 327 # 3  <0> pushmark s
 328 # 4  <$> const[PV "byage"] s/BARE
 329 # 5  <#> gv[*class] s
 330 # 6  <1> rv2av[t4] lK/1         < 5.019002
 331 # 6  <1> rv2av[t4] lKM/1        >=5.019002
 332 # 7  <@> sort lKS
 333 # 8  <0> pushmark s
 334 # 9  <#> gv[*sortedclass] s
 335 # a  <1> rv2av[t2] lKRM*/1
 336 # b  <2> aassign[t5] KS/COMMON
 337 # c  <1> leavesub[1 ref] K/REFC,1
 338 EOT_EOT
 339 # 1  <;> nextstate(main 546 (eval 15):1) v
 340 # 2  <0> pushmark s
 341 # 3  <0> pushmark s
 342 # 4  <$> const(PV "byage") s/BARE
 343 # 5  <$> gv(*class) s
 344 # 6  <1> rv2av[t2] lK/1         < 5.019002
 345 # 6  <1> rv2av[t2] lKM/1        >=5.019002
 346 # 7  <@> sort lKS
 347 # 8  <0> pushmark s
 348 # 9  <$> gv(*sortedclass) s
 349 # a  <1> rv2av[t1] lKRM*/1
 350 # b  <2> aassign[t3] KS/COMMON
 351 # c  <1> leavesub[1 ref] K/REFC,1
 352 EONT_EONT
 353
 354
 355 =for gentest
 356
 357 # chunk: sub backwards { $b cmp $a }
 358 @harry  = qw(dog cat x Cain Abel);
 359 @george = qw(gone chased yz Punished Axed);
 360 print sort @harry;
 361 # prints AbelCaincatdogx
 362 print sort backwards @harry;
 363 # prints xdogcatCainAbel
 364 print sort @george, 'to', @harry;
 365 # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
 366
 367 =cut
 368
 369 checkOptree(name   => q{sort USERSUB LIST },
 370             bcopts => q{-exec},
 371             code   => q{sub backwards { $b cmp $a }
 372                         @harry = qw(dog cat x Cain Abel);
 373                         @george = qw(gone chased yz Punished Axed);
 374                         print sort @harry; print sort backwards @harry;
 375                         print sort @george, 'to', @harry; },
 376             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 377 # 1  <;> nextstate(main 602 (eval 32):2) v
 378 # 2  <0> pushmark s
 379 # 3  <$> const[PV "dog"] s
 380 # 4  <$> const[PV "cat"] s
 381 # 5  <$> const[PV "x"] s
 382 # 6  <$> const[PV "Cain"] s
 383 # 7  <$> const[PV "Abel"] s
 384 # 8  <0> pushmark s
 385 # 9  <#> gv[*harry] s
 386 # a  <1> rv2av[t2] lKRM*/1
 387 # b  <2> aassign[t3] vKS
 388 # c  <;> nextstate(main 602 (eval 32):3) v
 389 # d  <0> pushmark s
 390 # e  <$> const[PV "gone"] s
 391 # f  <$> const[PV "chased"] s
 392 # g  <$> const[PV "yz"] s
 393 # h  <$> const[PV "Punished"] s
 394 # i  <$> const[PV "Axed"] s
 395 # j  <0> pushmark s
 396 # k  <#> gv[*george] s
 397 # l  <1> rv2av[t5] lKRM*/1
 398 # m  <2> aassign[t6] vKS
 399 # n  <;> nextstate(main 602 (eval 32):4) v:{
 400 # o  <0> pushmark s
 401 # p  <0> pushmark s
 402 # q  <#> gv[*harry] s
 403 # r  <1> rv2av[t8] lK/1
 404 # s  <@> sort lK
 405 # t  <@> print vK
 406 # u  <;> nextstate(main 602 (eval 32):4) v:{
 407 # v  <0> pushmark s
 408 # w  <0> pushmark s
 409 # x  <$> const[PV "backwards"] s/BARE
 410 # y  <#> gv[*harry] s
 411 # z  <1> rv2av[t10] lK/1        < 5.019002
 412 # z  <1> rv2av[t10] lKM/1       >=5.019002
 413 # 10 <@> sort lKS
 414 # 11 <@> print vK
 415 # 12 <;> nextstate(main 602 (eval 32):5) v:{
 416 # 13 <0> pushmark s
 417 # 14 <0> pushmark s
 418 # 15 <#> gv[*george] s
 419 # 16 <1> rv2av[t12] lK/1
 420 # 17 <$> const[PV "to"] s
 421 # 18 <#> gv[*harry] s
 422 # 19 <1> rv2av[t14] lK/1
 423 # 1a <@> sort lK
 424 # 1b <@> print sK
 425 # 1c <1> leavesub[1 ref] K/REFC,1
 426 EOT_EOT
 427 # 1  <;> nextstate(main 602 (eval 32):2) v
 428 # 2  <0> pushmark s
 429 # 3  <$> const(PV "dog") s
 430 # 4  <$> const(PV "cat") s
 431 # 5  <$> const(PV "x") s
 432 # 6  <$> const(PV "Cain") s
 433 # 7  <$> const(PV "Abel") s
 434 # 8  <0> pushmark s
 435 # 9  <$> gv(*harry) s
 436 # a  <1> rv2av[t1] lKRM*/1
 437 # b  <2> aassign[t2] vKS
 438 # c  <;> nextstate(main 602 (eval 32):3) v
 439 # d  <0> pushmark s
 440 # e  <$> const(PV "gone") s
 441 # f  <$> const(PV "chased") s
 442 # g  <$> const(PV "yz") s
 443 # h  <$> const(PV "Punished") s
 444 # i  <$> const(PV "Axed") s
 445 # j  <0> pushmark s
 446 # k  <$> gv(*george) s
 447 # l  <1> rv2av[t3] lKRM*/1
 448 # m  <2> aassign[t4] vKS
 449 # n  <;> nextstate(main 602 (eval 32):4) v:{
 450 # o  <0> pushmark s
 451 # p  <0> pushmark s
 452 # q  <$> gv(*harry) s
 453 # r  <1> rv2av[t5] lK/1
 454 # s  <@> sort lK
 455 # t  <@> print vK
 456 # u  <;> nextstate(main 602 (eval 32):4) v:{
 457 # v  <0> pushmark s
 458 # w  <0> pushmark s
 459 # x  <$> const(PV "backwards") s/BARE
 460 # y  <$> gv(*harry) s
 461 # z  <1> rv2av[t6] lK/1         < 5.019002
 462 # z  <1> rv2av[t6] lKM/1        >=5.019002
 463 # 10 <@> sort lKS
 464 # 11 <@> print vK
 465 # 12 <;> nextstate(main 602 (eval 32):5) v:{
 466 # 13 <0> pushmark s
 467 # 14 <0> pushmark s
 468 # 15 <$> gv(*george) s
 469 # 16 <1> rv2av[t7] lK/1
 470 # 17 <$> const(PV "to") s
 471 # 18 <$> gv(*harry) s
 472 # 19 <1> rv2av[t8] lK/1
 473 # 1a <@> sort lK
 474 # 1b <@> print sK
 475 # 1c <1> leavesub[1 ref] K/REFC,1
 476 EONT_EONT
 477
 478
 479 =for gentest
 480
 481 # chunk: # inefficiently sort by descending numeric compare using
 482 # the first integer after the first = sign, or the
 483 # whole record case-insensitively otherwise
 484 @new = @old[ sort {
 485     $nums[$b] <=> $nums[$a]
 486         || $caps[$a] cmp $caps[$b]
 487         } 0..$#old  ];
 488
 489 =cut
 490 =for gentest
 491
 492 # chunk: # same thing, but without any temps
 493 @new = map { $_->[0] }
 494 sort { $b->[1] <=> $a->[1]
 495            || $a->[2] cmp $b->[2]
 496            } map { [$_, /=(\d+)/, uc($_)] } @old;
 497
 498 =cut
 499
 500 checkOptree(name   => q{Compound sort/map Expression },
 501             bcopts => q{-exec},
 502             code   => q{ @new = map { $_->[0] }
 503                          sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
 504                          map { [$_, /=(\d+)/, uc($_)] } @old; },
 505             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 506 # 1  <;> nextstate(main 609 (eval 34):3) v:{
 507 # 2  <0> pushmark s
 508 # 3  <0> pushmark s
 509 # 4  <0> pushmark s
 510 # 5  <0> pushmark s
 511 # 6  <#> gv[*old] s
 512 # 7  <1> rv2av[t19] lKM/1
 513 # 8  <@> mapstart lK*              < 5.017002
 514 # 8  <@> mapstart lK               >=5.017002
 515 # 9  <|> mapwhile(other->a)[t20] lK     < 5.019002
 516 # 9  <|> mapwhile(other->a)[t20] lKM    >=5.019002
 517 # a      <0> enter l
 518 # b      <;> nextstate(main 608 (eval 34):2) v:{
 519 # c      <0> pushmark s
 520 # d      <#> gvsv[*_] s
 521 # e      </> match(/"=(\\d+)"/) l/RTIME
 522 # f      <#> gvsv[*_] s
 523 # g      <1> uc[t17] sK/1
 524 # h      <@> anonlist sK*/1
 525 # i      <@> leave lKP
 526 #            goto 9
 527 # j  <@> sort lKMS*
 528 # k  <@> mapstart lK*              < 5.017002
 529 # k  <@> mapstart lK               >=5.017002
 530 # l  <|> mapwhile(other->m)[t26] lK
 531 # m      <#> gv[*_] s
 532 # n      <1> rv2sv sKM/DREFAV,1
 533 # o      <1> rv2av[t4] sKR/1
 534 # p      <$> const[IV 0] s
 535 # q      <2> aelem sK/2
 536 # -      <@> scope lK              < 5.017002
 537 #            goto l
 538 # r  <0> pushmark s
 539 # s  <#> gv[*new] s
 540 # t  <1> rv2av[t2] lKRM*/1
 541 # u  <2> aassign[t27] KS/COMMON
 542 # v  <1> leavesub[1 ref] K/REFC,1
 543 EOT_EOT
 544 # 1  <;> nextstate(main 609 (eval 34):3) v:{
 545 # 2  <0> pushmark s
 546 # 3  <0> pushmark s
 547 # 4  <0> pushmark s
 548 # 5  <0> pushmark s
 549 # 6  <$> gv(*old) s
 550 # 7  <1> rv2av[t10] lKM/1
 551 # 8  <@> mapstart lK*              < 5.017002
 552 # 8  <@> mapstart lK               >=5.017002
 553 # 9  <|> mapwhile(other->a)[t11] lK     < 5.019002
 554 # 9  <|> mapwhile(other->a)[t11] lKM    >=5.019002
 555 # a      <0> enter l
 556 # b      <;> nextstate(main 608 (eval 34):2) v:{
 557 # c      <0> pushmark s
 558 # d      <$> gvsv(*_) s
 559 # e      </> match(/"=(\\d+)"/) l/RTIME
 560 # f      <$> gvsv(*_) s
 561 # g      <1> uc[t9] sK/1
 562 # h      <@> anonlist sK*/1
 563 # i      <@> leave lKP
 564 #            goto 9
 565 # j  <@> sort lKMS*
 566 # k  <@> mapstart lK*              < 5.017002
 567 # k  <@> mapstart lK               >=5.017002
 568 # l  <|> mapwhile(other->m)[t12] lK
 569 # m      <$> gv(*_) s
 570 # n      <1> rv2sv sKM/DREFAV,1
 571 # o      <1> rv2av[t2] sKR/1
 572 # p      <$> const(IV 0) s
 573 # q      <2> aelem sK/2
 574 # -      <@> scope lK              < 5.017002
 575 #            goto l
 576 # r  <0> pushmark s
 577 # s  <$> gv(*new) s
 578 # t  <1> rv2av[t1] lKRM*/1
 579 # u  <2> aassign[t13] KS/COMMON
 580 # v  <1> leavesub[1 ref] K/REFC,1
 581 EONT_EONT
 582
 583
 584 =for gentest
 585
 586 # chunk: # using a prototype allows you to use any comparison subroutine
 587 # as a sort subroutine (including other package's subroutines)
 588 package other;
 589 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
 590 package main;
 591 @new = sort other::backwards @old;
 592
 593 =cut
 594
 595 checkOptree(name   => q{sort other::sub LIST },
 596             bcopts => q{-exec},
 597             code   => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
 598                         package main; @new = sort other::backwards @old; },
 599             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 600 # 1  <;> nextstate(main 614 (eval 36):2) v:{
 601 # 2  <0> pushmark s
 602 # 3  <0> pushmark s
 603 # 4  <$> const[PV "other::backwards"] s/BARE
 604 # 5  <#> gv[*old] s
 605 # 6  <1> rv2av[t4] lK/1 < 5.019002
 606 # 6  <1> rv2av[t4] lKM/1        >=5.019002
 607 # 7  <@> sort lKS
 608 # 8  <0> pushmark s
 609 # 9  <#> gv[*new] s
 610 # a  <1> rv2av[t2] lKRM*/1
 611 # b  <2> aassign[t5] KS/COMMON
 612 # c  <1> leavesub[1 ref] K/REFC,1
 613 EOT_EOT
 614 # 1  <;> nextstate(main 614 (eval 36):2) 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[t2] lK/1         < 5.019002
 620 # 6  <1> rv2av[t2] lKM/1        >=5.019002
 621 # 7  <@> sort lKS
 622 # 8  <0> pushmark s
 623 # 9  <$> gv(*new) s
 624 # a  <1> rv2av[t1] lKRM*/1
 625 # b  <2> aassign[t3] KS/COMMON
 626 # c  <1> leavesub[1 ref] K/REFC,1
 627 EONT_EONT
 628
 629
 630 =for gentest
 631
 632 # chunk: # repeat, condensed. $main::a and $b are unaffected
 633 sub other::backwards ($$) { $_[1] cmp $_[0]; }
 634 @new = sort other::backwards @old;
 635
 636 =cut
 637
 638 checkOptree(note   => q{},
 639             bcopts => q{-exec},
 640             code   => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
 641             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 642 # 1  <;> nextstate(main 619 (eval 38):1) v
 643 # 2  <0> pushmark s
 644 # 3  <0> pushmark s
 645 # 4  <$> const[PV "other::backwards"] s/BARE
 646 # 5  <#> gv[*old] s
 647 # 6  <1> rv2av[t4] lK/1         < 5.019002
 648 # 6  <1> rv2av[t4] lKM/1        >=5.019002
 649 # 7  <@> sort lKS
 650 # 8  <0> pushmark s
 651 # 9  <#> gv[*new] s
 652 # a  <1> rv2av[t2] lKRM*/1
 653 # b  <2> aassign[t5] KS/COMMON
 654 # c  <1> leavesub[1 ref] K/REFC,1
 655 EOT_EOT
 656 # 1  <;> nextstate(main 546 (eval 15):1) v
 657 # 2  <0> pushmark s
 658 # 3  <0> pushmark s
 659 # 4  <$> const(PV "other::backwards") s/BARE
 660 # 5  <$> gv(*old) s
 661 # 6  <1> rv2av[t2] lK/1         < 5.019002
 662 # 6  <1> rv2av[t2] lKM/1        >=5.019002
 663 # 7  <@> sort lKS
 664 # 8  <0> pushmark s
 665 # 9  <$> gv(*new) s
 666 # a  <1> rv2av[t1] lKRM*/1
 667 # b  <2> aassign[t3] KS/COMMON
 668 # c  <1> leavesub[1 ref] K/REFC,1
 669 EONT_EONT
 670
 671
 672 =for gentest
 673
 674 # chunk: # guarantee stability, regardless of algorithm
 675 use sort 'stable';
 676 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 677
 678 =cut
 679
 680 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
 681 # 1  <;> nextstate(main 656 (eval 40):1) v:%,{
 682 # 2  <0> pushmark s
 683 # 3  <0> pushmark s
 684 # 4  <#> gv[*old] s
 685 # 5  <1> rv2av[t9] lK/1         < 5.019002
 686 # 5  <1> rv2av[t9] lKM/1        >=5.019002
 687 # 6  <@> sort lKS*/STABLE
 688 # 7  <0> pushmark s
 689 # 8  <#> gv[*new] s
 690 # 9  <1> rv2av[t2] lKRM*/1
 691 # a  <2> aassign[t14] KS/COMMON
 692 # b  <1> leavesub[1 ref] K/REFC,1
 693 EOT_EOT
 694 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 695 # 2  <0> pushmark s
 696 # 3  <0> pushmark s
 697 # 4  <$> gv(*old) s
 698 # 5  <1> rv2av[t5] lK/1         < 5.019002
 699 # 5  <1> rv2av[t5] lKM/1        >=5.019002
 700 # 6  <@> sort lKS*/STABLE
 701 # 7  <0> pushmark s
 702 # 8  <$> gv(*new) s
 703 # 9  <1> rv2av[t1] lKRM*/1
 704 # a  <2> aassign[t6] KS/COMMON
 705 # b  <1> leavesub[1 ref] K/REFC,1
 706 EONT_EONT
 707
 708
 709 checkOptree(note   => q{},
 710             bcopts => q{-exec},
 711             code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 712             expect => $expect, expect_nt => $expect_nt);
 713
 714 =for gentest
 715
 716 # chunk: # force use of mergesort (not portable outside Perl 5.8)
 717 use sort '_mergesort';
 718 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 719
 720 =cut
 721
 722 checkOptree(note   => q{},
 723             bcopts => q{-exec},
 724             code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 725             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 726 # 1  <;> nextstate(main 662 (eval 42):1) v:%,{
 727 # 2  <0> pushmark s
 728 # 3  <0> pushmark s
 729 # 4  <#> gv[*old] s
 730 # 5  <1> rv2av[t9] lK/1         < 5.019002
 731 # 5  <1> rv2av[t9] lKM/1        >=5.019002
 732 # 6  <@> sort lKS*
 733 # 7  <0> pushmark s
 734 # 8  <#> gv[*new] s
 735 # 9  <1> rv2av[t2] lKRM*/1
 736 # a  <2> aassign[t14] KS/COMMON
 737 # b  <1> leavesub[1 ref] K/REFC,1
 738 EOT_EOT
 739 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 740 # 2  <0> pushmark s
 741 # 3  <0> pushmark s
 742 # 4  <$> gv(*old) s
 743 # 5  <1> rv2av[t5] lK/1         < 5.019002
 744 # 5  <1> rv2av[t5] lKM/1        >=5.019002
 745 # 6  <@> sort lKS*
 746 # 7  <0> pushmark s
 747 # 8  <$> gv(*new) s
 748 # 9  <1> rv2av[t1] lKRM*/1
 749 # a  <2> aassign[t6] KS/COMMON
 750 # b  <1> leavesub[1 ref] K/REFC,1
 751 EONT_EONT
 752
 753
 754 =for gentest
 755
 756 # chunk: # you should have a good reason to do this!
 757 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 758
 759 =cut
 760
 761 checkOptree(note   => q{},
 762             bcopts => q{-exec},
 763             code   => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
 764             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 765 # 1  <;> nextstate(main 667 (eval 44):1) v
 766 # 2  <0> pushmark s
 767 # 3  <0> pushmark s
 768 # 4  <#> gv[*files] s
 769 # 5  <1> rv2av[t7] lK/1         < 5.019002
 770 # 5  <1> rv2av[t7] lKM/1        >=5.019002
 771 # 6  <@> sort lKS*
 772 # 7  <0> pushmark s
 773 # 8  <#> gv[*articles] s
 774 # 9  <1> rv2av[t2] lKRM*/1
 775 # a  <2> aassign[t8] KS/COMMON
 776 # b  <1> leavesub[1 ref] K/REFC,1
 777 EOT_EOT
 778 # 1  <;> nextstate(main 546 (eval 15):1) v
 779 # 2  <0> pushmark s
 780 # 3  <0> pushmark s
 781 # 4  <$> gv(*files) s
 782 # 5  <1> rv2av[t3] lK/1         < 5.019002
 783 # 5  <1> rv2av[t3] lKM/1        >=5.019002
 784 # 6  <@> sort lKS*
 785 # 7  <0> pushmark s
 786 # 8  <$> gv(*articles) s
 787 # 9  <1> rv2av[t1] lKRM*/1
 788 # a  <2> aassign[t4] KS/COMMON
 789 # b  <1> leavesub[1 ref] K/REFC,1
 790 EONT_EONT
 791
 792
 793 =for gentest
 794
 795 # chunk: # fancy
 796 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
 797
 798 =cut
 799
 800 checkOptree(note   => q{},
 801             bcopts => q{-exec},
 802             code   => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
 803             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 804 # 1  <;> nextstate(main 673 (eval 46):1) v
 805 # 2  <0> pushmark s
 806 # 3  <0> pushmark s
 807 # 4  <0> pushmark s
 808 # 5  <#> gv[*input] s
 809 # 6  <1> rv2av[t9] lKM/1
 810 # 7  <@> grepstart lK*              < 5.017002
 811 # 7  <@> grepstart lK               >=5.017002
 812 # 8  <|> grepwhile(other->9)[t10] lK
 813 # 9      <#> gvsv[*_] s
 814 # a      <#> gvsv[*_] s
 815 # b      <2> eq sK/2
 816 # -      <@> scope sK              < 5.017002
 817 #            goto 8
 818 # c  <@> sort lK/NUM
 819 # d  <0> pushmark s
 820 # e  <#> gv[*result] s
 821 # f  <1> rv2av[t2] lKRM*/1
 822 # g  <2> aassign[t3] KS/COMMON
 823 # h  <1> leavesub[1 ref] K/REFC,1
 824 EOT_EOT
 825 # 1  <;> nextstate(main 547 (eval 15):1) v
 826 # 2  <0> pushmark s
 827 # 3  <0> pushmark s
 828 # 4  <0> pushmark s
 829 # 5  <$> gv(*input) s
 830 # 6  <1> rv2av[t3] lKM/1
 831 # 7  <@> grepstart lK*              < 5.017002
 832 # 7  <@> grepstart lK               >=5.017002
 833 # 8  <|> grepwhile(other->9)[t4] lK
 834 # 9      <$> gvsv(*_) s
 835 # a      <$> gvsv(*_) s
 836 # b      <2> eq sK/2
 837 # -      <@> scope sK              < 5.017002
 838 #            goto 8
 839 # c  <@> sort lK/NUM
 840 # d  <0> pushmark s
 841 # e  <$> gv(*result) s
 842 # f  <1> rv2av[t1] lKRM*/1
 843 # g  <2> aassign[t2] KS/COMMON
 844 # h  <1> leavesub[1 ref] K/REFC,1
 845 EONT_EONT
 846
 847
 848 =for gentest
 849
 850 # chunk: # void return context sort
 851 sort { $a <=> $b } @input;
 852
 853 =cut
 854
 855 checkOptree(note   => q{},
 856             bcopts => q{-exec},
 857             code   => q{sort { $a <=> $b } @input; },
 858             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 859 # 1  <;> nextstate(main 678 (eval 48):1) v
 860 # 2  <0> pushmark s
 861 # 3  <#> gv[*input] s
 862 # 4  <1> rv2av[t5] lK/1
 863 # 5  <@> sort K/NUM
 864 # 6  <1> leavesub[1 ref] K/REFC,1
 865 EOT_EOT
 866 # 1  <;> nextstate(main 546 (eval 15):1) v
 867 # 2  <0> pushmark s
 868 # 3  <$> gv(*input) s
 869 # 4  <1> rv2av[t2] lK/1
 870 # 5  <@> sort K/NUM
 871 # 6  <1> leavesub[1 ref] K/REFC,1
 872 EONT_EONT
 873
 874
 875 =for gentest
 876
 877 # chunk: # more void context, propagating ?
 878 sort { $a <=> $b } grep { $_ == $_ } @input;
 879
 880 =cut
 881
 882 checkOptree(note   => q{},
 883             bcopts => q{-exec},
 884             code   => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
 885             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 886 # 1  <;> nextstate(main 684 (eval 50):1) v
 887 # 2  <0> pushmark s
 888 # 3  <0> pushmark s
 889 # 4  <#> gv[*input] s
 890 # 5  <1> rv2av[t7] lKM/1
 891 # 6  <@> grepstart lK*              < 5.017002
 892 # 6  <@> grepstart lK               >=5.017002
 893 # 7  <|> grepwhile(other->8)[t8] lK
 894 # 8      <#> gvsv[*_] s
 895 # 9      <#> gvsv[*_] s
 896 # a      <2> eq sK/2
 897 # -      <@> scope sK              < 5.017002
 898 #            goto 7
 899 # b  <@> sort K/NUM
 900 # c  <1> leavesub[1 ref] K/REFC,1
 901 EOT_EOT
 902 # 1  <;> nextstate(main 547 (eval 15):1) v
 903 # 2  <0> pushmark s
 904 # 3  <0> pushmark s
 905 # 4  <$> gv(*input) s
 906 # 5  <1> rv2av[t2] lKM/1
 907 # 6  <@> grepstart lK*              < 5.017002
 908 # 6  <@> grepstart lK               >=5.017002
 909 # 7  <|> grepwhile(other->8)[t3] lK
 910 # 8      <$> gvsv(*_) s
 911 # 9      <$> gvsv(*_) s
 912 # a      <2> eq sK/2
 913 # -      <@> scope sK              < 5.017002
 914 #            goto 7
 915 # b  <@> sort K/NUM
 916 # c  <1> leavesub[1 ref] K/REFC,1
 917 EONT_EONT
 918
 919
 920 =for gentest
 921
 922 # chunk: # scalar return context sort
 923 $s = sort { $a <=> $b } @input;
 924
 925 =cut
 926
 927 checkOptree(note   => q{},
 928             bcopts => q{-exec},
 929             code   => q{$s = sort { $a <=> $b } @input; },
 930             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 931 # 1  <;> nextstate(main 689 (eval 52):1) v:{
 932 # 2  <0> pushmark s
 933 # 3  <#> gv[*input] s
 934 # 4  <1> rv2av[t6] lK/1
 935 # 5  <@> sort sK/NUM
 936 # 6  <#> gvsv[*s] s
 937 # 7  <2> sassign sKS/2
 938 # 8  <1> leavesub[1 ref] K/REFC,1
 939 EOT_EOT
 940 # 1  <;> nextstate(main 546 (eval 15):1) v:{
 941 # 2  <0> pushmark s
 942 # 3  <$> gv(*input) s
 943 # 4  <1> rv2av[t2] lK/1
 944 # 5  <@> sort sK/NUM
 945 # 6  <$> gvsv(*s) s
 946 # 7  <2> sassign sKS/2
 947 # 8  <1> leavesub[1 ref] K/REFC,1
 948 EONT_EONT
 949
 950
 951 =for gentest
 952
 953 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
 954
 955 =cut
 956
 957 checkOptree(note   => q{},
 958             bcopts => q{-exec},
 959             code   => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
 960             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 961 # 1  <;> nextstate(main 695 (eval 54):1) v:{
 962 # 2  <0> pushmark s
 963 # 3  <0> pushmark s
 964 # 4  <#> gv[*input] s
 965 # 5  <1> rv2av[t8] lKM/1
 966 # 6  <@> grepstart lK*              < 5.017002
 967 # 6  <@> grepstart lK               >=5.017002
 968 # 7  <|> grepwhile(other->8)[t9] 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 EOT_EOT
 979 # 1  <;> nextstate(main 547 (eval 15):1) v:{
 980 # 2  <0> pushmark s
 981 # 3  <0> pushmark s
 982 # 4  <$> gv(*input) s
 983 # 5  <1> rv2av[t2] lKM/1
 984 # 6  <@> grepstart lK*              < 5.017002
 985 # 6  <@> grepstart lK               >=5.017002
 986 # 7  <|> grepwhile(other->8)[t3] lK
 987 # 8      <$> gvsv(*_) s
 988 # 9      <$> gvsv(*_) s
 989 # a      <2> eq sK/2
 990 # -      <@> scope sK              < 5.017002
 991 #            goto 7
 992 # b  <@> sort sK/NUM
 993 # c  <$> gvsv(*s) s
 994 # d  <2> sassign sKS/2
 995 # e  <1> leavesub[1 ref] K/REFC,1
 996 EONT_EONT
 997