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