ext/B/t/f_map.t

   1 #!perl
   2
   3 BEGIN {
   4     if ($ENV{PERL_CORE}){
   5         chdir('t') if -d 't';
   6         @INC = ('.', '../lib', '../ext/B/t');
   7     } else {
   8         unshift @INC, 't';
   9         push @INC, "../../t";
  10     }
  11     require Config;
  12     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
  13         print "1..0 # Skip -- Perl configured without B module\n";
  14         exit 0;
  15     }
  16     if (!$Config::Config{useperlio}) {
  17         print "1..0 # Skip -- need perlio to walk the optree\n";
  18         exit 0;
  19     }
  20     # require q(test.pl); # now done by OptreeCheck
  21 }
  22 use OptreeCheck;
  23 plan tests => 9;
  24
  25
  26 =head1 f_map.t
  27
  28 Code test snippets here are adapted from `perldoc -f map`
  29
  30 Due to a bleadperl optimization (Dave Mitchell, circa may 04), the
  31 (map|grep)(start|while) opcodes have different flags in 5.9, their
  32 private flags /1, /2 are gone in blead (for the cases covered)
  33
  34 When the optree stuff was integrated into 5.8.6, these tests failed,
  35 and were todo'd.  Theyre now done, by version-specific tweaking in
  36 mkCheckRex(), therefore the skip is removed too.
  37
  38 =for gentest
  39
  40 # chunk: #!perl
  41 # examples shamelessly snatched from perldoc -f map
  42
  43 =cut
  44
  45 =for gentest
  46
  47 # chunk: # translates a list of numbers to the corresponding characters.
  48 @chars = map(chr, @nums);
  49
  50 =cut
  51
  52 checkOptree(note   => q{},
  53             bcopts => q{-exec},
  54             code   => q{@chars = map(chr, @nums); },
  55             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  56 # 1  <;> nextstate(main 475 (eval 10):1) v
  57 # 2  <0> pushmark s
  58 # 3  <0> pushmark s
  59 # 4  <#> gv[*nums] s
  60 # 5  <1> rv2av[t7] lKM/1
  61 # 6  <@> mapstart lK
  62 # 7  <|> mapwhile(other->8)[t8] lK
  63 # 8      <#> gvsv[*_] s
  64 # 9      <1> chr[t5] sK/1
  65 #            goto 7
  66 # a  <0> pushmark s
  67 # b  <#> gv[*chars] s
  68 # c  <1> rv2av[t2] lKRM*/1
  69 # d  <2> aassign[t9] KS/COMMON
  70 # e  <1> leavesub[1 ref] K/REFC,1
  71 EOT_EOT
  72 # 1  <;> nextstate(main 559 (eval 15):1) v
  73 # 2  <0> pushmark s
  74 # 3  <0> pushmark s
  75 # 4  <$> gv(*nums) s
  76 # 5  <1> rv2av[t4] lKM/1
  77 # 6  <@> mapstart lK
  78 # 7  <|> mapwhile(other->8)[t5] lK
  79 # 8      <$> gvsv(*_) s
  80 # 9      <1> chr[t3] sK/1
  81 #            goto 7
  82 # a  <0> pushmark s
  83 # b  <$> gv(*chars) s
  84 # c  <1> rv2av[t1] lKRM*/1
  85 # d  <2> aassign[t6] KS/COMMON
  86 # e  <1> leavesub[1 ref] K/REFC,1
  87 EONT_EONT
  88
  89
  90 =for gentest
  91
  92 # chunk: %hash = map { getkey($_) => $_ } @array;
  93
  94 =cut
  95
  96 checkOptree(note   => q{},
  97             bcopts => q{-exec},
  98             code   => q{%hash = map { getkey($_) => $_ } @array; },
  99             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 100 # 1  <;> nextstate(main 476 (eval 10):1) v
 101 # 2  <0> pushmark s
 102 # 3  <0> pushmark s
 103 # 4  <#> gv[*array] s
 104 # 5  <1> rv2av[t8] lKM/1
 105 # 6  <@> mapstart lK*
 106 # 7  <|> mapwhile(other->8)[t9] lK
 107 # 8      <0> enter l
 108 # 9      <;> nextstate(main 475 (eval 10):1) v
 109 # a      <0> pushmark s
 110 # b      <0> pushmark s
 111 # c      <#> gvsv[*_] s
 112 # d      <#> gv[*getkey] s/EARLYCV
 113 # e      <1> entersub[t5] lKS/TARG,1
 114 # f      <#> gvsv[*_] s
 115 # g      <@> list lK
 116 # h      <@> leave lKP
 117 #            goto 7
 118 # i  <0> pushmark s
 119 # j  <#> gv[*hash] s
 120 # k  <1> rv2hv[t2] lKRM*/1
 121 # l  <2> aassign[t10] KS/COMMON
 122 # m  <1> leavesub[1 ref] K/REFC,1
 123 EOT_EOT
 124 # 1  <;> nextstate(main 560 (eval 15):1) v
 125 # 2  <0> pushmark s
 126 # 3  <0> pushmark s
 127 # 4  <$> gv(*array) s
 128 # 5  <1> rv2av[t3] lKM/1
 129 # 6  <@> mapstart lK*
 130 # 7  <|> mapwhile(other->8)[t4] lK
 131 # 8      <0> enter l
 132 # 9      <;> nextstate(main 559 (eval 15):1) v
 133 # a      <0> pushmark s
 134 # b      <0> pushmark s
 135 # c      <$> gvsv(*_) s
 136 # d      <$> gv(*getkey) s/EARLYCV
 137 # e      <1> entersub[t2] lKS/TARG,1
 138 # f      <$> gvsv(*_) s
 139 # g      <@> list lK
 140 # h      <@> leave lKP
 141 #            goto 7
 142 # i  <0> pushmark s
 143 # j  <$> gv(*hash) s
 144 # k  <1> rv2hv[t1] lKRM*/1
 145 # l  <2> aassign[t5] KS/COMMON
 146 # m  <1> leavesub[1 ref] K/REFC,1
 147 EONT_EONT
 148
 149
 150 =for gentest
 151
 152 # chunk: {
 153     %hash = ();
 154     foreach $_ (@array) {
 155         $hash{getkey($_)} = $_;
 156     }
 157 }
 158
 159 =cut
 160
 161 checkOptree(note   => q{},
 162             bcopts => q{-exec},
 163             code   => q{{ %hash = (); foreach $_ (@array) { $hash{getkey($_)} = $_; } } },
 164             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 165 # 1  <;> nextstate(main 478 (eval 10):1) v
 166 # 2  <{> enterloop(next->u last->u redo->3)
 167 # 3  <;> nextstate(main 475 (eval 10):1) v
 168 # 4  <0> pushmark s
 169 # 5  <0> pushmark s
 170 # 6  <#> gv[*hash] s
 171 # 7  <1> rv2hv[t2] lKRM*/1
 172 # 8  <2> aassign[t3] vKS
 173 # 9  <;> nextstate(main 476 (eval 10):1) v
 174 # a  <0> pushmark sM
 175 # b  <#> gv[*array] s
 176 # c  <1> rv2av[t6] sKRM/1
 177 # d  <#> gv[*_] s
 178 # e  <1> rv2gv sKRM/1
 179 # f  <{> enteriter(next->q last->t redo->g) lKS/8
 180 # r  <0> iter s
 181 # s  <|> and(other->g) K/1
 182 # g      <;> nextstate(main 475 (eval 10):1) v
 183 # h      <#> gvsv[*_] s
 184 # i      <#> gv[*hash] s
 185 # j      <1> rv2hv sKR/1
 186 # k      <0> pushmark s
 187 # l      <#> gvsv[*_] s
 188 # m      <#> gv[*getkey] s/EARLYCV
 189 # n      <1> entersub[t10] sKS/TARG,1
 190 # o      <2> helem sKRM*/2
 191 # p      <2> sassign vKS/2
 192 # q      <0> unstack s
 193 #            goto r
 194 # t  <2> leaveloop K/2
 195 # u  <2> leaveloop K/2
 196 # v  <1> leavesub[1 ref] K/REFC,1
 197 EOT_EOT
 198 # 1  <;> nextstate(main 562 (eval 15):1) v
 199 # 2  <{> enterloop(next->u last->u redo->3)
 200 # 3  <;> nextstate(main 559 (eval 15):1) v
 201 # 4  <0> pushmark s
 202 # 5  <0> pushmark s
 203 # 6  <$> gv(*hash) s
 204 # 7  <1> rv2hv[t1] lKRM*/1
 205 # 8  <2> aassign[t2] vKS
 206 # 9  <;> nextstate(main 560 (eval 15):1) v
 207 # a  <0> pushmark sM
 208 # b  <$> gv(*array) s
 209 # c  <1> rv2av[t3] sKRM/1
 210 # d  <$> gv(*_) s
 211 # e  <1> rv2gv sKRM/1
 212 # f  <{> enteriter(next->q last->t redo->g) lKS/8
 213 # r  <0> iter s
 214 # s  <|> and(other->g) K/1
 215 # g      <;> nextstate(main 559 (eval 15):1) v
 216 # h      <$> gvsv(*_) s
 217 # i      <$> gv(*hash) s
 218 # j      <1> rv2hv sKR/1
 219 # k      <0> pushmark s
 220 # l      <$> gvsv(*_) s
 221 # m      <$> gv(*getkey) s/EARLYCV
 222 # n      <1> entersub[t4] sKS/TARG,1
 223 # o      <2> helem sKRM*/2
 224 # p      <2> sassign vKS/2
 225 # q      <0> unstack s
 226 #            goto r
 227 # t  <2> leaveloop K/2
 228 # u  <2> leaveloop K/2
 229 # v  <1> leavesub[1 ref] K/REFC,1
 230 EONT_EONT
 231
 232
 233 =for gentest
 234
 235 # chunk: #%hash = map {  "\L$_", 1  } @array;  # perl guesses EXPR.  wrong
 236 %hash = map { +"\L$_", 1  } @array;  # perl guesses BLOCK. right
 237
 238 =cut
 239
 240 checkOptree(note   => q{},
 241             bcopts => q{-exec},
 242             code   => q{%hash = map { +"\L$_", 1 } @array; },
 243             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 244 # 1  <;> nextstate(main 476 (eval 10):1) v
 245 # 2  <0> pushmark s
 246 # 3  <0> pushmark s
 247 # 4  <#> gv[*array] s
 248 # 5  <1> rv2av[t7] lKM/1
 249 # 6  <@> mapstart lK*
 250 # 7  <|> mapwhile(other->8)[t9] lK
 251 # 8      <0> pushmark s
 252 # 9      <#> gvsv[*_] s
 253 # a      <1> lc[t4] sK/1
 254 # b      <@> stringify[t5] sK/1
 255 # c      <$> const[IV 1] s
 256 # d      <@> list lK
 257 # -      <@> scope lK
 258 #            goto 7
 259 # e  <0> pushmark s
 260 # f  <#> gv[*hash] s
 261 # g  <1> rv2hv[t2] lKRM*/1
 262 # h  <2> aassign[t10] KS/COMMON
 263 # i  <1> leavesub[1 ref] K/REFC,1
 264 EOT_EOT
 265 # 1  <;> nextstate(main 560 (eval 15):1) v
 266 # 2  <0> pushmark s
 267 # 3  <0> pushmark s
 268 # 4  <$> gv(*array) s
 269 # 5  <1> rv2av[t4] lKM/1
 270 # 6  <@> mapstart lK*
 271 # 7  <|> mapwhile(other->8)[t5] lK
 272 # 8      <0> pushmark s
 273 # 9      <$> gvsv(*_) s
 274 # a      <1> lc[t2] sK/1
 275 # b      <@> stringify[t3] sK/1
 276 # c      <$> const(IV 1) s
 277 # d      <@> list lK
 278 # -      <@> scope lK
 279 #            goto 7
 280 # e  <0> pushmark s
 281 # f  <$> gv(*hash) s
 282 # g  <1> rv2hv[t1] lKRM*/1
 283 # h  <2> aassign[t6] KS/COMMON
 284 # i  <1> leavesub[1 ref] K/REFC,1
 285 EONT_EONT
 286
 287
 288 =for gentest
 289
 290 # chunk: %hash = map { ("\L$_", 1) } @array;  # this also works
 291
 292 =cut
 293
 294 checkOptree(note   => q{},
 295             bcopts => q{-exec},
 296             code   => q{%hash = map { ("\L$_", 1) } @array; },
 297             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 298 # 1  <;> nextstate(main 476 (eval 10):1) v
 299 # 2  <0> pushmark s
 300 # 3  <0> pushmark s
 301 # 4  <#> gv[*array] s
 302 # 5  <1> rv2av[t7] lKM/1
 303 # 6  <@> mapstart lK*
 304 # 7  <|> mapwhile(other->8)[t9] lK
 305 # 8      <0> pushmark s
 306 # 9      <#> gvsv[*_] s
 307 # a      <1> lc[t4] sK/1
 308 # b      <@> stringify[t5] sK/1
 309 # c      <$> const[IV 1] s
 310 # d      <@> list lKP
 311 # -      <@> scope lK
 312 #            goto 7
 313 # e  <0> pushmark s
 314 # f  <#> gv[*hash] s
 315 # g  <1> rv2hv[t2] lKRM*/1
 316 # h  <2> aassign[t10] KS/COMMON
 317 # i  <1> leavesub[1 ref] K/REFC,1
 318 EOT_EOT
 319 # 1  <;> nextstate(main 560 (eval 15):1) v
 320 # 2  <0> pushmark s
 321 # 3  <0> pushmark s
 322 # 4  <$> gv(*array) s
 323 # 5  <1> rv2av[t4] lKM/1
 324 # 6  <@> mapstart lK*
 325 # 7  <|> mapwhile(other->8)[t5] lK
 326 # 8      <0> pushmark s
 327 # 9      <$> gvsv(*_) s
 328 # a      <1> lc[t2] sK/1
 329 # b      <@> stringify[t3] sK/1
 330 # c      <$> const(IV 1) s
 331 # d      <@> list lKP
 332 # -      <@> scope lK
 333 #            goto 7
 334 # e  <0> pushmark s
 335 # f  <$> gv(*hash) s
 336 # g  <1> rv2hv[t1] lKRM*/1
 337 # h  <2> aassign[t6] KS/COMMON
 338 # i  <1> leavesub[1 ref] K/REFC,1
 339 EONT_EONT
 340
 341
 342 =for gentest
 343
 344 # chunk: %hash = map {  lc($_), 1  } @array;  # as does this.
 345
 346 =cut
 347
 348 checkOptree(note   => q{},
 349             bcopts => q{-exec},
 350             code   => q{%hash = map { lc($_), 1 } @array; },
 351             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 352 # 1  <;> nextstate(main 476 (eval 10):1) v
 353 # 2  <0> pushmark s
 354 # 3  <0> pushmark s
 355 # 4  <#> gv[*array] s
 356 # 5  <1> rv2av[t6] lKM/1
 357 # 6  <@> mapstart lK*
 358 # 7  <|> mapwhile(other->8)[t8] lK
 359 # 8      <0> pushmark s
 360 # 9      <#> gvsv[*_] s
 361 # a      <1> lc[t4] sK/1
 362 # b      <$> const[IV 1] s
 363 # c      <@> list lK
 364 # -      <@> scope lK
 365 #            goto 7
 366 # d  <0> pushmark s
 367 # e  <#> gv[*hash] s
 368 # f  <1> rv2hv[t2] lKRM*/1
 369 # g  <2> aassign[t9] KS/COMMON
 370 # h  <1> leavesub[1 ref] K/REFC,1
 371 EOT_EOT
 372 # 1  <;> nextstate(main 589 (eval 26):1) v
 373 # 2  <0> pushmark s
 374 # 3  <0> pushmark s
 375 # 4  <$> gv(*array) s
 376 # 5  <1> rv2av[t3] lKM/1
 377 # 6  <@> mapstart lK*
 378 # 7  <|> mapwhile(other->8)[t4] lK
 379 # 8      <0> pushmark s
 380 # 9      <$> gvsv(*_) s
 381 # a      <1> lc[t2] sK/1
 382 # b      <$> const(IV 1) s
 383 # c      <@> list lK
 384 # -      <@> scope lK
 385 #            goto 7
 386 # d  <0> pushmark s
 387 # e  <$> gv(*hash) s
 388 # f  <1> rv2hv[t1] lKRM*/1
 389 # g  <2> aassign[t5] KS/COMMON
 390 # h  <1> leavesub[1 ref] K/REFC,1
 391 EONT_EONT
 392
 393
 394 =for gentest
 395
 396 # chunk: %hash = map +( lc($_), 1 ), @array;  # this is EXPR and works!
 397
 398 =cut
 399
 400 checkOptree(note   => q{},
 401             bcopts => q{-exec},
 402             code   => q{%hash = map +( lc($_), 1 ), @array; },
 403             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 404 # 1  <;> nextstate(main 475 (eval 10):1) v
 405 # 2  <0> pushmark s
 406 # 3  <0> pushmark s
 407 # 4  <#> gv[*array] s
 408 # 5  <1> rv2av[t6] lKM/1
 409 # 6  <@> mapstart lK
 410 # 7  <|> mapwhile(other->8)[t7] lK
 411 # 8      <0> pushmark s
 412 # 9      <#> gvsv[*_] s
 413 # a      <1> lc[t4] sK/1
 414 # b      <$> const[IV 1] s
 415 # c      <@> list lKP
 416 #            goto 7
 417 # d  <0> pushmark s
 418 # e  <#> gv[*hash] s
 419 # f  <1> rv2hv[t2] lKRM*/1
 420 # g  <2> aassign[t8] KS/COMMON
 421 # h  <1> leavesub[1 ref] K/REFC,1
 422 EOT_EOT
 423 # 1  <;> nextstate(main 593 (eval 28):1) v
 424 # 2  <0> pushmark s
 425 # 3  <0> pushmark s
 426 # 4  <$> gv(*array) s
 427 # 5  <1> rv2av[t3] lKM/1
 428 # 6  <@> mapstart lK
 429 # 7  <|> mapwhile(other->8)[t4] lK
 430 # 8      <0> pushmark s
 431 # 9      <$> gvsv(*_) s
 432 # a      <1> lc[t2] sK/1
 433 # b      <$> const(IV 1) s
 434 # c      <@> list lKP
 435 #            goto 7
 436 # d  <0> pushmark s
 437 # e  <$> gv(*hash) s
 438 # f  <1> rv2hv[t1] lKRM*/1
 439 # g  <2> aassign[t5] KS/COMMON
 440 # h  <1> leavesub[1 ref] K/REFC,1
 441 EONT_EONT
 442
 443
 444 =for gentest
 445
 446 # chunk: %hash = map  ( lc($_), 1 ), @array;  # evaluates to (1, @array)
 447
 448 =cut
 449
 450 checkOptree(note   => q{},
 451             bcopts => q{-exec},
 452             code   => q{%hash = map ( lc($_), 1 ), @array; },
 453             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 454 # 1  <;> nextstate(main 475 (eval 10):1) v
 455 # 2  <0> pushmark s
 456 # 3  <0> pushmark s
 457 # 4  <0> pushmark s
 458 # 5  <$> const[IV 1] sM
 459 # 6  <@> mapstart lK
 460 # 7  <|> mapwhile(other->8)[t5] lK
 461 # 8      <#> gvsv[*_] s
 462 # 9      <1> lc[t4] sK/1
 463 #            goto 7
 464 # a  <0> pushmark s
 465 # b  <#> gv[*hash] s
 466 # c  <1> rv2hv[t2] lKRM*/1
 467 # d  <2> aassign[t6] KS/COMMON
 468 # e  <#> gv[*array] s
 469 # f  <1> rv2av[t8] K/1
 470 # g  <@> list K
 471 # h  <1> leavesub[1 ref] K/REFC,1
 472 EOT_EOT
 473 # 1  <;> nextstate(main 597 (eval 30):1) v
 474 # 2  <0> pushmark s
 475 # 3  <0> pushmark s
 476 # 4  <0> pushmark s
 477 # 5  <$> const(IV 1) sM
 478 # 6  <@> mapstart lK
 479 # 7  <|> mapwhile(other->8)[t3] lK
 480 # 8      <$> gvsv(*_) s
 481 # 9      <1> lc[t2] sK/1
 482 #            goto 7
 483 # a  <0> pushmark s
 484 # b  <$> gv(*hash) s
 485 # c  <1> rv2hv[t1] lKRM*/1
 486 # d  <2> aassign[t4] KS/COMMON
 487 # e  <$> gv(*array) s
 488 # f  <1> rv2av[t5] K/1
 489 # g  <@> list K
 490 # h  <1> leavesub[1 ref] K/REFC,1
 491 EONT_EONT
 492
 493
 494 =for gentest
 495
 496 # chunk: @hashes = map +{ lc($_), 1 }, @array # EXPR, so needs , at end
 497
 498 =cut
 499
 500 checkOptree(note   => q{},
 501             bcopts => q{-exec},
 502             code   => q{@hashes = map +{ lc($_), 1 }, @array },
 503             expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 504 # 1  <;> nextstate(main 475 (eval 10):1) v
 505 # 2  <0> pushmark s
 506 # 3  <0> pushmark s
 507 # 4  <#> gv[*array] s
 508 # 5  <1> rv2av[t6] lKM/1
 509 # 6  <@> mapstart lK
 510 # 7  <|> mapwhile(other->8)[t7] lK
 511 # 8      <0> pushmark s
 512 # 9      <#> gvsv[*_] s
 513 # a      <1> lc[t4] sK/1
 514 # b      <$> const[IV 1] s
 515 # c      <@> anonhash sKRM/1
 516 # d      <1> srefgen sK/1
 517 #            goto 7
 518 # e  <0> pushmark s
 519 # f  <#> gv[*hashes] s
 520 # g  <1> rv2av[t2] lKRM*/1
 521 # h  <2> aassign[t8] KS/COMMON
 522 # i  <1> leavesub[1 ref] K/REFC,1
 523 EOT_EOT
 524 # 1  <;> nextstate(main 601 (eval 32):1) v
 525 # 2  <0> pushmark s
 526 # 3  <0> pushmark s
 527 # 4  <$> gv(*array) s
 528 # 5  <1> rv2av[t3] lKM/1
 529 # 6  <@> mapstart lK
 530 # 7  <|> mapwhile(other->8)[t4] lK
 531 # 8      <0> pushmark s
 532 # 9      <$> gvsv(*_) s
 533 # a      <1> lc[t2] sK/1
 534 # b      <$> const(IV 1) s
 535 # c      <@> anonhash sKRM/1
 536 # d      <1> srefgen sK/1
 537 #            goto 7
 538 # e  <0> pushmark s
 539 # f  <$> gv(*hashes) s
 540 # g  <1> rv2av[t1] lKRM*/1
 541 # h  <2> aassign[t5] KS/COMMON
 542 # i  <1> leavesub[1 ref] K/REFC,1
 543 EONT_EONT