ext/B/t/f_sort.t

   1 #!perl
   2
   3 BEGIN {
   4     unshift @INC, 't';
   5     require Config;
   6     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
   7         print "1..0 # Skip -- Perl configured without B module\n";
   8         exit 0;
   9     }
  10     if (!$Config::Config{useperlio}) {
  11         print "1..0 # Skip -- need perlio to walk the optree\n";
  12         exit 0;
  13     }
  14 }
  15 use OptreeCheck;
  16 plan tests => 40;
  17
  18 =head1 f_sort.t
  19
  20 Code test snippets here are adapted from `perldoc -f map`
  21
  22 Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
  23 (map|grep)(start|while) opcodes have different flags in 5.9, their
  24 private flags /1, /2 are gone in blead (for the cases covered)
  25
  26 When the optree stuff was integrated into 5.8.6, these tests failed,
  27 and were todo'd.  They're now done, by version-specific tweaking in
  28 mkCheckRex(), therefore the skip is removed too.
  29
  30 =head1 Test Notes
  31
  32 # chunk: #!perl
  33 #examples poached from perldoc -f sort
  34
  35 NOTE: name is no longer a required arg for checkOptree, as label is
  36 synthesized out of others.  HOWEVER, if the test-code has newlines in
  37 it, the label must be overridden by an explicit name.
  38
  39 This is because t/TEST is quite particular about the test output it
  40 processes, and multi-line labels violate its 1-line-per-test
  41 expectations.
  42
  43 =for gentest
  44
  45 # chunk: # sort lexically
  46 @articles = sort @files;
  47
  48 =cut
  49
  50 checkOptree(note   => q{},
  51             bcopts => q{-exec},
  52             code   => q{@articles = sort @files; },
  53             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  54 # 1  <;> nextstate(main 545 (eval 15):1) v
  55 # 2  <0> pushmark s
  56 # 3  <0> pushmark s
  57 # 4  <#> gv[*files] s
  58 # 5  <1> rv2av[t4] lK/1
  59 # 6  <@> sort lK
  60 # 7  <0> pushmark s
  61 # 8  <#> gv[*articles] s
  62 # 9  <1> rv2av[t2] lKRM*/1
  63 # a  <2> aassign[t5] KS/COM_AGG
  64 # b  <1> leavesub[1 ref] K/REFC,1
  65 EOT_EOT
  66 # 1  <;> nextstate(main 545 (eval 15):1) v
  67 # 2  <0> pushmark s
  68 # 3  <0> pushmark s
  69 # 4  <$> gv(*files) s
  70 # 5  <1> rv2av[t2] lK/1
  71 # 6  <@> sort lK
  72 # 7  <0> pushmark s
  73 # 8  <$> gv(*articles) s
  74 # 9  <1> rv2av[t1] lKRM*/1
  75 # a  <2> aassign[t3] KS/COM_AGG
  76 # b  <1> leavesub[1 ref] K/REFC,1
  77 EONT_EONT
  78
  79
  80 =for gentest
  81
  82 # chunk: # same thing, but with explicit sort routine
  83 @articles = sort {$a cmp $b} @files;
  84
  85 =cut
  86
  87 checkOptree(note   => q{},
  88             bcopts => q{-exec},
  89             code   => q{@articles = sort {$a cmp $b} @files; },
  90             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  91 # 1  <;> nextstate(main 546 (eval 15):1) v
  92 # 2  <0> pushmark s
  93 # 3  <0> pushmark s
  94 # 4  <#> gv[*files] s
  95 # 5  <1> rv2av[t7] lK/1
  96 # 6  <@> sort lK
  97 # 7  <0> pushmark s
  98 # 8  <#> gv[*articles] s
  99 # 9  <1> rv2av[t2] lKRM*/1
 100 # a  <2> aassign[t3] KS/COM_AGG
 101 # b  <1> leavesub[1 ref] K/REFC,1
 102 EOT_EOT
 103 # 1  <;> nextstate(main 546 (eval 15):1) v
 104 # 2  <0> pushmark s
 105 # 3  <0> pushmark s
 106 # 4  <$> gv(*files) s
 107 # 5  <1> rv2av[t3] lK/1
 108 # 6  <@> sort lK
 109 # 7  <0> pushmark s
 110 # 8  <$> gv(*articles) s
 111 # 9  <1> rv2av[t1] lKRM*/1
 112 # a  <2> aassign[t2] KS/COM_AGG
 113 # b  <1> leavesub[1 ref] K/REFC,1
 114 EONT_EONT
 115
 116
 117 =for gentest
 118
 119 # chunk: # now case-insensitively
 120 @articles = sort {uc($a) cmp uc($b)} @files;
 121
 122 =cut
 123
 124 checkOptree(note   => q{},
 125             bcopts => q{-exec},
 126             code   => q{@articles = sort {uc($a) cmp uc($b)} @files; },
 127             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 128 # 1  <;> nextstate(main 546 (eval 15):1) v
 129 # 2  <0> pushmark s
 130 # 3  <0> pushmark s
 131 # 4  <#> gv[*files] s
 132 # 5  <1> rv2av[t9] 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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
 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/COM_AGG
 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
 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/COM_AGG
 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/COM_AGG
 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/COM_AGG
 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
 512 # 9  <|> mapwhile(other->a)[t20] lKM
 513 # a      <0> enter l
 514 # b      <;> nextstate(main 608 (eval 34):2) v:{
 515 # c      <0> pushmark s
 516 # d      <#> gvsv[*_] s
 517 # e      </> match(/"=(\\d+)"/) l
 518 # f      <#> gvsv[*_] s
 519 # g      <1> uc[t17] sK/1
 520 # h      <@> anonlist sK*/1
 521 # i      <@> leave lKP
 522 #            goto 9
 523 # j  <@> sort lKMS*
 524 # k  <@> mapstart lK
 525 # l  <|> mapwhile(other->m)[t26] lK
 526 # m      <+> multideref($_->[0]) sK
 527 #            goto l
 528 # n  <0> pushmark s
 529 # o  <#> gv[*new] s
 530 # p  <1> rv2av[t2] lKRM*/1
 531 # q  <2> aassign[t22] KS/COM_AGG
 532 # r  <1> leavesub[1 ref] K/REFC,1
 533 EOT_EOT
 534 # 1  <;> nextstate(main 609 (eval 34):3) v:{
 535 # 2  <0> pushmark s
 536 # 3  <0> pushmark s
 537 # 4  <0> pushmark s
 538 # 5  <0> pushmark s
 539 # 6  <$> gv(*old) s
 540 # 7  <1> rv2av[t10] lKM/1
 541 # 8  <@> mapstart lK
 542 # 9  <|> mapwhile(other->a)[t11] lKM
 543 # a      <0> enter l
 544 # b      <;> nextstate(main 608 (eval 34):2) v:{
 545 # c      <0> pushmark s
 546 # d      <$> gvsv(*_) s
 547 # e      </> match(/"=(\\d+)"/) l
 548 # f      <$> gvsv(*_) s
 549 # g      <1> uc[t9] sK/1
 550 # h      <@> anonlist sK*/1
 551 # i      <@> leave lKP
 552 #            goto 9
 553 # j  <@> sort lKMS*
 554 # k  <@> mapstart lK
 555 # l  <|> mapwhile(other->m)[t12] lK
 556 # m      <+> multideref($_->[0]) sK
 557 #            goto l
 558 # n  <0> pushmark s
 559 # o  <$> gv(*new) s
 560 # p  <1> rv2av[t1] lKRM*/1
 561 # q  <2> aassign[t13] KS/COM_AGG
 562 # r  <1> leavesub[1 ref] K/REFC,1
 563 EONT_EONT
 564
 565
 566 =for gentest
 567
 568 # chunk: # using a prototype allows you to use any comparison subroutine
 569 # as a sort subroutine (including other package's subroutines)
 570 package other;
 571 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
 572 package main;
 573 @new = sort other::backwards @old;
 574
 575 =cut
 576
 577 checkOptree(name   => q{sort other::sub LIST },
 578             bcopts => q{-exec},
 579             code   => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
 580                         package main; @new = sort other::backwards @old; },
 581             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 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[t4] lK/1 < 5.019002
 588 # 6  <1> rv2av[t4] lKM/1        >=5.019002
 589 # 7  <@> sort lKS
 590 # 8  <0> pushmark s
 591 # 9  <#> gv[*new] s
 592 # a  <1> rv2av[t2] lKRM*/1
 593 # b  <2> aassign[t5] KS/COM_AGG
 594 # c  <1> leavesub[1 ref] K/REFC,1
 595 EOT_EOT
 596 # 1  <;> nextstate(main 614 (eval 36):2) v:{
 597 # 2  <0> pushmark s
 598 # 3  <0> pushmark s
 599 # 4  <$> const(PV "other::backwards") s/BARE
 600 # 5  <$> gv(*old) s
 601 # 6  <1> rv2av[t2] lK/1         < 5.019002
 602 # 6  <1> rv2av[t2] lKM/1        >=5.019002
 603 # 7  <@> sort lKS
 604 # 8  <0> pushmark s
 605 # 9  <$> gv(*new) s
 606 # a  <1> rv2av[t1] lKRM*/1
 607 # b  <2> aassign[t3] KS/COM_AGG
 608 # c  <1> leavesub[1 ref] K/REFC,1
 609 EONT_EONT
 610
 611
 612 =for gentest
 613
 614 # chunk: # repeat, condensed. $main::a and $b are unaffected
 615 sub other::backwards ($$) { $_[1] cmp $_[0]; }
 616 @new = sort other::backwards @old;
 617
 618 =cut
 619
 620 checkOptree(note   => q{},
 621             bcopts => q{-exec},
 622             code   => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
 623             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 624 # 1  <;> nextstate(main 619 (eval 38):1) v
 625 # 2  <0> pushmark s
 626 # 3  <0> pushmark s
 627 # 4  <$> const[PV "other::backwards"] s/BARE
 628 # 5  <#> gv[*old] s
 629 # 6  <1> rv2av[t4] lK/1         < 5.019002
 630 # 6  <1> rv2av[t4] lKM/1        >=5.019002
 631 # 7  <@> sort lKS
 632 # 8  <0> pushmark s
 633 # 9  <#> gv[*new] s
 634 # a  <1> rv2av[t2] lKRM*/1
 635 # b  <2> aassign[t5] KS/COM_AGG
 636 # c  <1> leavesub[1 ref] K/REFC,1
 637 EOT_EOT
 638 # 1  <;> nextstate(main 546 (eval 15):1) v
 639 # 2  <0> pushmark s
 640 # 3  <0> pushmark s
 641 # 4  <$> const(PV "other::backwards") s/BARE
 642 # 5  <$> gv(*old) s
 643 # 6  <1> rv2av[t2] lK/1         < 5.019002
 644 # 6  <1> rv2av[t2] lKM/1        >=5.019002
 645 # 7  <@> sort lKS
 646 # 8  <0> pushmark s
 647 # 9  <$> gv(*new) s
 648 # a  <1> rv2av[t1] lKRM*/1
 649 # b  <2> aassign[t3] KS/COM_AGG
 650 # c  <1> leavesub[1 ref] K/REFC,1
 651 EONT_EONT
 652
 653
 654 =for gentest
 655
 656 # chunk: # guarantee stability, regardless of algorithm
 657 use sort 'stable';
 658 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 659
 660 =cut
 661
 662 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
 663 # 1  <;> nextstate(main 656 (eval 40):1) v:%,{
 664 # 2  <0> pushmark s
 665 # 3  <0> pushmark s
 666 # 4  <#> gv[*old] s
 667 # 5  <1> rv2av[t9] lK/1         < 5.019002
 668 # 5  <1> rv2av[t9] lKM/1        >=5.019002
 669 # 6  <@> sort lKS*/STABLE
 670 # 7  <0> pushmark s
 671 # 8  <#> gv[*new] s
 672 # 9  <1> rv2av[t2] lKRM*/1
 673 # a  <2> aassign[t14] KS/COM_AGG
 674 # b  <1> leavesub[1 ref] K/REFC,1
 675 EOT_EOT
 676 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 677 # 2  <0> pushmark s
 678 # 3  <0> pushmark s
 679 # 4  <$> gv(*old) s
 680 # 5  <1> rv2av[t5] lK/1         < 5.019002
 681 # 5  <1> rv2av[t5] lKM/1        >=5.019002
 682 # 6  <@> sort lKS*/STABLE
 683 # 7  <0> pushmark s
 684 # 8  <$> gv(*new) s
 685 # 9  <1> rv2av[t1] lKRM*/1
 686 # a  <2> aassign[t6] KS/COM_AGG
 687 # b  <1> leavesub[1 ref] K/REFC,1
 688 EONT_EONT
 689
 690
 691 checkOptree(note   => q{},
 692             bcopts => q{-exec},
 693             code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 694             expect => $expect, expect_nt => $expect_nt);
 695
 696 =for gentest
 697
 698 # chunk: # force use of mergesort (not portable outside Perl 5.8)
 699 use sort '_mergesort';
 700 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 701
 702 =cut
 703
 704 checkOptree(note   => q{},
 705             bcopts => q{-exec},
 706             code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
 707             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 708 # 1  <;> nextstate(main 662 (eval 42):1) v:%,{
 709 # 2  <0> pushmark s
 710 # 3  <0> pushmark s
 711 # 4  <#> gv[*old] s
 712 # 5  <1> rv2av[t9] lK/1         < 5.019002
 713 # 5  <1> rv2av[t9] lKM/1        >=5.019002
 714 # 6  <@> sort lKS*
 715 # 7  <0> pushmark s
 716 # 8  <#> gv[*new] s
 717 # 9  <1> rv2av[t2] lKRM*/1
 718 # a  <2> aassign[t14] KS/COM_AGG
 719 # b  <1> leavesub[1 ref] K/REFC,1
 720 EOT_EOT
 721 # 1  <;> nextstate(main 578 (eval 15):1) v:%,{
 722 # 2  <0> pushmark s
 723 # 3  <0> pushmark s
 724 # 4  <$> gv(*old) s
 725 # 5  <1> rv2av[t5] lK/1         < 5.019002
 726 # 5  <1> rv2av[t5] lKM/1        >=5.019002
 727 # 6  <@> sort lKS*
 728 # 7  <0> pushmark s
 729 # 8  <$> gv(*new) s
 730 # 9  <1> rv2av[t1] lKRM*/1
 731 # a  <2> aassign[t6] KS/COM_AGG
 732 # b  <1> leavesub[1 ref] K/REFC,1
 733 EONT_EONT
 734
 735
 736 =for gentest
 737
 738 # chunk: # you should have a good reason to do this!
 739 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 740
 741 =cut
 742
 743 checkOptree(note   => q{},
 744             bcopts => q{-exec},
 745             code   => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
 746             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 747 # 1  <;> nextstate(main 667 (eval 44):1) v
 748 # 2  <0> pushmark s
 749 # 3  <0> pushmark s
 750 # 4  <#> gv[*files] s
 751 # 5  <1> rv2av[t7] lK/1         < 5.019002
 752 # 5  <1> rv2av[t7] lKM/1        >=5.019002
 753 # 6  <@> sort lKS*
 754 # 7  <0> pushmark s
 755 # 8  <#> gv[*articles] s
 756 # 9  <1> rv2av[t2] lKRM*/1
 757 # a  <2> aassign[t8] KS/COM_AGG
 758 # b  <1> leavesub[1 ref] K/REFC,1
 759 EOT_EOT
 760 # 1  <;> nextstate(main 546 (eval 15):1) v
 761 # 2  <0> pushmark s
 762 # 3  <0> pushmark s
 763 # 4  <$> gv(*files) s
 764 # 5  <1> rv2av[t3] lK/1         < 5.019002
 765 # 5  <1> rv2av[t3] lKM/1        >=5.019002
 766 # 6  <@> sort lKS*
 767 # 7  <0> pushmark s
 768 # 8  <$> gv(*articles) s
 769 # 9  <1> rv2av[t1] lKRM*/1
 770 # a  <2> aassign[t4] KS/COM_AGG
 771 # b  <1> leavesub[1 ref] K/REFC,1
 772 EONT_EONT
 773
 774
 775 =for gentest
 776
 777 # chunk: # fancy
 778 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
 779
 780 =cut
 781
 782 checkOptree(note   => q{},
 783             bcopts => q{-exec},
 784             code   => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
 785             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 786 # 1  <;> nextstate(main 673 (eval 46):1) v
 787 # 2  <0> pushmark s
 788 # 3  <0> pushmark s
 789 # 4  <0> pushmark s
 790 # 5  <#> gv[*input] s
 791 # 6  <1> rv2av[t9] lKM/1
 792 # 7  <@> grepstart lK*              < 5.017002
 793 # 7  <@> grepstart lK               >=5.017002
 794 # 8  <|> grepwhile(other->9)[t10] lK
 795 # 9      <#> gvsv[*_] s
 796 # a      <#> gvsv[*_] s
 797 # b      <2> eq sK/2
 798 # -      <@> scope sK              < 5.017002
 799 #            goto 8
 800 # c  <@> sort lK/NUM
 801 # d  <0> pushmark s
 802 # e  <#> gv[*result] s
 803 # f  <1> rv2av[t2] lKRM*/1
 804 # g  <2> aassign[t3] KS/COM_AGG
 805 # h  <1> leavesub[1 ref] K/REFC,1
 806 EOT_EOT
 807 # 1  <;> nextstate(main 547 (eval 15):1) v
 808 # 2  <0> pushmark s
 809 # 3  <0> pushmark s
 810 # 4  <0> pushmark s
 811 # 5  <$> gv(*input) s
 812 # 6  <1> rv2av[t3] lKM/1
 813 # 7  <@> grepstart lK*              < 5.017002
 814 # 7  <@> grepstart lK               >=5.017002
 815 # 8  <|> grepwhile(other->9)[t4] lK
 816 # 9      <$> gvsv(*_) s
 817 # a      <$> gvsv(*_) s
 818 # b      <2> eq sK/2
 819 # -      <@> scope sK              < 5.017002
 820 #            goto 8
 821 # c  <@> sort lK/NUM
 822 # d  <0> pushmark s
 823 # e  <$> gv(*result) s
 824 # f  <1> rv2av[t1] lKRM*/1
 825 # g  <2> aassign[t2] KS/COM_AGG
 826 # h  <1> leavesub[1 ref] K/REFC,1
 827 EONT_EONT
 828
 829
 830 =for gentest
 831
 832 # chunk: # void return context sort
 833 sort { $a <=> $b } @input;
 834
 835 =cut
 836
 837 checkOptree(note   => q{},
 838             bcopts => q{-exec},
 839             code   => q{sort { $a <=> $b } @input; },
 840             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 841 # 1  <;> nextstate(main 678 (eval 48):1) v
 842 # 2  <0> pushmark s
 843 # 3  <#> gv[*input] s
 844 # 4  <1> rv2av[t5] lK/1
 845 # 5  <@> sort K/NUM
 846 # 6  <1> leavesub[1 ref] K/REFC,1
 847 EOT_EOT
 848 # 1  <;> nextstate(main 546 (eval 15):1) v
 849 # 2  <0> pushmark s
 850 # 3  <$> gv(*input) s
 851 # 4  <1> rv2av[t2] lK/1
 852 # 5  <@> sort K/NUM
 853 # 6  <1> leavesub[1 ref] K/REFC,1
 854 EONT_EONT
 855
 856
 857 =for gentest
 858
 859 # chunk: # more void context, propagating ?
 860 sort { $a <=> $b } grep { $_ == $_ } @input;
 861
 862 =cut
 863
 864 checkOptree(note   => q{},
 865             bcopts => q{-exec},
 866             code   => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
 867             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 868 # 1  <;> nextstate(main 684 (eval 50):1) v
 869 # 2  <0> pushmark s
 870 # 3  <0> pushmark s
 871 # 4  <#> gv[*input] s
 872 # 5  <1> rv2av[t7] lKM/1
 873 # 6  <@> grepstart lK*              < 5.017002
 874 # 6  <@> grepstart lK               >=5.017002
 875 # 7  <|> grepwhile(other->8)[t8] lK
 876 # 8      <#> gvsv[*_] s
 877 # 9      <#> gvsv[*_] s
 878 # a      <2> eq sK/2
 879 # -      <@> scope sK              < 5.017002
 880 #            goto 7
 881 # b  <@> sort K/NUM
 882 # c  <1> leavesub[1 ref] K/REFC,1
 883 EOT_EOT
 884 # 1  <;> nextstate(main 547 (eval 15):1) v
 885 # 2  <0> pushmark s
 886 # 3  <0> pushmark s
 887 # 4  <$> gv(*input) s
 888 # 5  <1> rv2av[t2] lKM/1
 889 # 6  <@> grepstart lK*              < 5.017002
 890 # 6  <@> grepstart lK               >=5.017002
 891 # 7  <|> grepwhile(other->8)[t3] 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 EONT_EONT
 900
 901
 902 =for gentest
 903
 904 # chunk: # scalar return context sort
 905 $s = sort { $a <=> $b } @input;
 906
 907 =cut
 908
 909 checkOptree(note   => q{},
 910             bcopts => q{-exec},
 911             code   => q{$s = sort { $a <=> $b } @input; },
 912             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 913 # 1  <;> nextstate(main 689 (eval 52):1) v:{
 914 # 2  <0> pushmark s
 915 # 3  <#> gv[*input] s
 916 # 4  <1> rv2av[t6] lK/1
 917 # 5  <@> sort sK/NUM
 918 # 6  <#> gvsv[*s] s
 919 # 7  <2> sassign sKS/2
 920 # 8  <1> leavesub[1 ref] K/REFC,1
 921 EOT_EOT
 922 # 1  <;> nextstate(main 546 (eval 15):1) v:{
 923 # 2  <0> pushmark s
 924 # 3  <$> gv(*input) s
 925 # 4  <1> rv2av[t2] lK/1
 926 # 5  <@> sort sK/NUM
 927 # 6  <$> gvsv(*s) s
 928 # 7  <2> sassign sKS/2
 929 # 8  <1> leavesub[1 ref] K/REFC,1
 930 EONT_EONT
 931
 932
 933 =for gentest
 934
 935 # chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
 936
 937 =cut
 938
 939 checkOptree(note   => q{},
 940             bcopts => q{-exec},
 941             code   => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
 942             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 943 # 1  <;> nextstate(main 695 (eval 54):1) v:{
 944 # 2  <0> pushmark s
 945 # 3  <0> pushmark s
 946 # 4  <#> gv[*input] s
 947 # 5  <1> rv2av[t8] lKM/1
 948 # 6  <@> grepstart lK*              < 5.017002
 949 # 6  <@> grepstart lK               >=5.017002
 950 # 7  <|> grepwhile(other->8)[t9] lK
 951 # 8      <#> gvsv[*_] s
 952 # 9      <#> gvsv[*_] s
 953 # a      <2> eq sK/2
 954 # -      <@> scope sK              < 5.017002
 955 #            goto 7
 956 # b  <@> sort sK/NUM
 957 # c  <#> gvsv[*s] s
 958 # d  <2> sassign sKS/2
 959 # e  <1> leavesub[1 ref] K/REFC,1
 960 EOT_EOT
 961 # 1  <;> nextstate(main 547 (eval 15):1) v:{
 962 # 2  <0> pushmark s
 963 # 3  <0> pushmark s
 964 # 4  <$> gv(*input) s
 965 # 5  <1> rv2av[t2] lKM/1
 966 # 6  <@> grepstart lK*              < 5.017002
 967 # 6  <@> grepstart lK               >=5.017002
 968 # 7  <|> grepwhile(other->8)[t3] 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 EONT_EONT
 979