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