ext/B/t/f_sort.t

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