1#!perl 2 3# This file specifies an array-of-hashes that define snippets of code that 4# can be run by various measurement and profiling tools. 5# 6# The basic idea is that any time you add an optimisation that is intended 7# to make a particular construct faster, then you should add that construct 8# to this file. 9# 10# Under the normal test suite, the test file benchmarks.t does a basic 11# compile and run of each of these snippets; not to test performance, 12# but just to ensure that the code doesn't have errors. 13# 14# Over time, it is intended that various measurement and profiling tools 15# will be written that can run selected (or all) snippets in various 16# environments. These will not be run as part of a normal test suite run. 17# 18# It is intended that the tests in this file will be lightweight; e.g. 19# a hash access, an empty function call, or a single regex match etc. 20# 21# This file is designed to be read in by 'do' (and in such a way that 22# multiple versions of this file from different releases can be read in 23# by a single process). 24# 25# The top-level array has name/hash pairs (we use an array rather than a 26# hash so that duplicate keys can be spotted) Each name is a token that 27# describes a particular test. Code will be compiled in the package named 28# after the token, so it should match /^(\w|::)+$/a. It is intended that 29# this can be used on the command line of tools to select particular 30# tests. 31# In addition, the package names are arranged into an informal hierarchy 32# whose top members are (this is subject to change): 33# 34# call:: subroutine and method handling 35# expr:: expressions: e.g. $x=1, $foo{bar}[0] 36# func:: perl functions, e.g. func::sort::... 37# loop:: structural code like for, while(), etc 38# regex:: regular expressions 39# string:: string handling 40# 41# 42# Each hash has up to five fields: 43# 44# desc is a description of the test; if not present, it defaults 45# to the same value as the 'code' field 46# 47# setup is an optional string containing setup code that is run once 48# 49# code is a string containing the code to run in a loop 50# 51# pre is an optional string containing setup code which is executed 52# just before 'code' for every iteration, but whose execution 53# time is not included in the result 54# 55# post like pre, but executed just after 'code'. 56# 57# So typically a benchmark tool might execute variations on something like 58# 59# eval "package $name; $setup; for (1..1000000) { $pre; $code; $post }" 60# 61# Currently the only tool that uses this file is Porting/bench.pl; 62# try C<perl Porting/bench.pl --help> for more info 63# 64# ------ 65# 66# Note: for the cachegrind variant, an entry like 67# 'foo::bar' => { 68# setup => 'SETUP', 69# pre => 'PRE', 70# code => 'CODE', 71# post => 'POST', 72# } 73# creates two temporary perl sources looking like: 74# 75# package foo::bar; 76# BEGIN { srand(0) } 77# SETUP; 78# for my $__loop__ (1..$ARGV[0]) { 79# PRE; 1; POST; 80# } 81# 82# and as above, but with the loop body replaced with: 83# 84# PRE; CODE; POST; 85# 86# It then pipes each of the two sources into 87# 88# PERL_HASH_SEED=0 valgrind [options] someperl [options] - N 89# 90# where N is set to 10 and then 20. 91# 92# It then uses the result of those four cachegrind runs to subtract out 93# the perl startup and loop overheads (including SETUP, PRE and POST), leaving 94# (in theory only CODE); 95# 96# Note that misleading results may be obtained if each iteration is 97# not identical. For example with 98# 99# code => '$x .= "foo"', 100# 101# the string $x gets longer on each iteration. Similarly, a hash might be 102# empty on the first iteration, but have entries on subsequent iterations. 103# 104# To avoid this, use 'pre' or 'post', e.g. 105# 106# pre => '$x = ""', 107# code => '$x .= "foo"', 108# 109# Finally, the optional 'compile' key causes the code body to be wrapped 110# in eval qw{ sub { ... }}, so that compile time rather than execution 111# time is measured. 112 113 114[ 115 'call::sub::empty' => { 116 desc => 'function call with no args or body', 117 setup => 'sub f { }', 118 code => 'f()', 119 }, 120 'call::sub::amp_empty' => { 121 desc => '&foo function call with no args or body', 122 setup => 'sub f { }; @_ = ();', 123 code => '&f', 124 }, 125 'call::sub::args3' => { 126 desc => 'function call with 3 local lexical vars', 127 setup => 'sub f { my ($a, $b, $c) = @_; 1 }', 128 code => 'f(1,2,3)', 129 }, 130 'call::sub::args2_ret1' => { 131 desc => 'function call with 2 local lex vars and 1 return value', 132 setup => 'my $x; sub f { my ($a, $b) = @_; $a+$b }', 133 code => '$x = f(1,2)', 134 }, 135 'call::sub::args2_ret1temp' => { 136 desc => 'function call with 2 local lex vars and 1 return TEMP value', 137 setup => 'my $x; sub f { my ($a, $b) = @_; \$a }', 138 code => '$x = f(1,2)', 139 }, 140 'call::sub::args3_ret3' => { 141 desc => 'function call with 3 local lex vars and 3 return values', 142 setup => 'my @a; sub f { my ($a, $b, $c) = @_; $a+$b, $c, 1 }', 143 code => '@a = f(1,2,3)', 144 }, 145 'call::sub::args3_ret3str' => { 146 desc => 'function call with 3 local lex vars and 3 string return values', 147 setup => 'my @a; sub f { my ($a, $b, $c) = @_; my @s = ("aa","bb","cc"); @s }', 148 code => '@a = f(1,2,3)', 149 }, 150 'call::sub::args3_ret3temp' => { 151 desc => 'function call with 3 local lex vars and 3 TEMP return values', 152 setup => 'my @a; sub f { my ($a, $b, $c) = @_; 1..3 }', 153 code => '@a = f(1,2,3)', 154 }, 155 'call::sub::recursive' => { 156 desc => 'basic recursive function call', 157 setup => 'my $x; sub f { my ($i) = @_; $i > 0 ? $i + f($i-1) : 0 }', 158 code => '$x = f(1)', 159 }, 160 161 'call::sub::scalar' => { 162 desc => 'sub called in scalar context', 163 setup => 'my $x; my @a = 1..4; sub f { @a }', 164 code => '$x = f()', 165 }, 166 167 'call::goto::empty' => { 168 desc => 'goto &funtion with no args or body', 169 setup => 'sub f { goto &g } sub g {}', 170 code => 'f()', 171 }, 172 'call::goto::args3' => { 173 desc => 'goto &funtion with 3 local lexical vars', 174 setup => 'sub f { goto &g } sub g { my ($a, $b, $c) = @_ }', 175 code => 'f(1,2,3)', 176 }, 177 178 179 'expr::array::lex_1const_0' => { 180 desc => 'lexical $array[0]', 181 setup => 'my @a = (1)', 182 code => '$a[0]', 183 }, 184 'expr::array::lex_1const_m1' => { 185 desc => 'lexical $array[-1]', 186 setup => 'my @a = (1)', 187 code => '$a[-1]', 188 }, 189 'expr::array::lex_2const' => { 190 desc => 'lexical $array[const][const]', 191 setup => 'my @a = ([1,2])', 192 code => '$a[0][1]', 193 }, 194 'expr::array::lex_2var' => { 195 desc => 'lexical $array[$i1][$i2]', 196 setup => 'my ($i1,$i2) = (0,1); my @a = ([1,2])', 197 code => '$a[$i1][$i2]', 198 }, 199 'expr::array::ref_lex_2var' => { 200 desc => 'lexical $arrayref->[$i1][$i2]', 201 setup => 'my ($i1,$i2) = (0,1); my $r = [[1,2]]', 202 code => '$r->[$i1][$i2]', 203 }, 204 'expr::array::ref_lex_3const' => { 205 desc => 'lexical $arrayref->[const][const][const]', 206 setup => 'my $r = [[[1,2]]]', 207 code => '$r->[0][0][0]', 208 }, 209 'expr::array::ref_expr_lex_3const' => { 210 desc => '(lexical expr)->[const][const][const]', 211 setup => 'my $r = [[[1,2]]]', 212 code => '($r||0)->[0][0][0]', 213 }, 214 215 216 'expr::array::pkg_1const_0' => { 217 desc => 'package $array[0]', 218 setup => '@a = (1)', 219 code => '$a[0]', 220 }, 221 'expr::array::pkg_1const_m1' => { 222 desc => 'package $array[-1]', 223 setup => '@a = (1)', 224 code => '$a[-1]', 225 }, 226 'expr::array::pkg_2const' => { 227 desc => 'package $array[const][const]', 228 setup => '@a = ([1,2])', 229 code => '$a[0][1]', 230 }, 231 'expr::array::pkg_2var' => { 232 desc => 'package $array[$i1][$i2]', 233 setup => '($i1,$i2) = (0,1); @a = ([1,2])', 234 code => '$a[$i1][$i2]', 235 }, 236 'expr::array::ref_pkg_2var' => { 237 desc => 'package $arrayref->[$i1][$i2]', 238 setup => '($i1,$i2) = (0,1); $r = [[1,2]]', 239 code => '$r->[$i1][$i2]', 240 }, 241 'expr::array::ref_pkg_3const' => { 242 desc => 'package $arrayref->[const][const][const]', 243 setup => '$r = [[[1,2]]]', 244 code => '$r->[0][0][0]', 245 }, 246 'expr::array::ref_expr_pkg_3const' => { 247 desc => '(package expr)->[const][const][const]', 248 setup => '$r = [[[1,2]]]', 249 code => '($r||0)->[0][0][0]', 250 }, 251 252 'expr::array::lex_bool_empty' => { 253 desc => 'empty lexical array in boolean context', 254 setup => 'my @a;', 255 code => '!@a', 256 }, 257 'expr::array::lex_bool_full' => { 258 desc => 'non-empty lexical array in boolean context', 259 setup => 'my @a = 1..10;', 260 code => '!@a', 261 }, 262 'expr::array::lex_scalar_empty' => { 263 desc => 'empty lexical array in scalar context', 264 setup => 'my (@a, $i);', 265 code => '$i = @a', 266 }, 267 'expr::array::lex_scalar_full' => { 268 desc => 'non-empty lexical array in scalar context', 269 setup => 'my @a = 1..10; my $i', 270 code => '$i = @a', 271 }, 272 'expr::array::pkg_bool_empty' => { 273 desc => 'empty lexical array in boolean context', 274 setup => 'our @a;', 275 code => '!@a', 276 }, 277 'expr::array::pkg_bool_full' => { 278 desc => 'non-empty lexical array in boolean context', 279 setup => 'our @a = 1..10;', 280 code => '!@a', 281 }, 282 'expr::array::pkg_scalar_empty' => { 283 desc => 'empty lexical array in scalar context', 284 setup => 'our @a; my $i;', 285 code => '$i = @a', 286 }, 287 'expr::array::pkg_scalar_full' => { 288 desc => 'non-empty lexical array in scalar context', 289 setup => 'our @a = 1..10; my $i', 290 code => '$i = @a', 291 }, 292 293 'expr::arrayhash::lex_3var' => { 294 desc => 'lexical $h{$k1}[$i]{$k2}', 295 setup => 'my ($i, $k1, $k2) = (0,"foo","bar");' 296 . 'my %h = (foo => [ { bar => 1 } ])', 297 code => '$h{$k1}[$i]{$k2}', 298 }, 299 'expr::arrayhash::pkg_3var' => { 300 desc => 'package $h{$k1}[$i]{$k2}', 301 setup => '($i, $k1, $k2) = (0,"foo","bar");' 302 . '%h = (foo => [ { bar => 1 } ])', 303 code => '$h{$k1}[$i]{$k2}', 304 }, 305 306 'expr::hash::lex_1const' => { 307 desc => 'lexical $hash{const}', 308 setup => 'my %h = ("foo" => 1)', 309 code => '$h{foo}', 310 }, 311 'expr::hash::lex_2const' => { 312 desc => 'lexical $hash{const}{const}', 313 setup => 'my %h = (foo => { bar => 1 })', 314 code => '$h{foo}{bar}', 315 }, 316 'expr::hash::lex_2var' => { 317 desc => 'lexical $hash{$k1}{$k2}', 318 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 })', 319 code => '$h{$k1}{$k2}', 320 }, 321 'expr::hash::ref_lex_2var' => { 322 desc => 'lexical $hashref->{$k1}{$k2}', 323 setup => 'my ($k1,$k2) = qw(foo bar); my $r = {$k1 => { $k2 => 1 }}', 324 code => '$r->{$k1}{$k2}', 325 }, 326 'expr::hash::ref_lex_3const' => { 327 desc => 'lexical $hashref->{const}{const}{const}', 328 setup => 'my $r = {foo => { bar => { baz => 1 }}}', 329 code => '$r->{foo}{bar}{baz}', 330 }, 331 'expr::hash::ref_expr_lex_3const' => { 332 desc => '(lexical expr)->{const}{const}{const}', 333 setup => 'my $r = {foo => { bar => { baz => 1 }}}', 334 code => '($r||0)->{foo}{bar}{baz}', 335 }, 336 337 'expr::hash::pkg_1const' => { 338 desc => 'package $hash{const}', 339 setup => '%h = ("foo" => 1)', 340 code => '$h{foo}', 341 }, 342 'expr::hash::pkg_2const' => { 343 desc => 'package $hash{const}{const}', 344 setup => '%h = (foo => { bar => 1 })', 345 code => '$h{foo}{bar}', 346 }, 347 'expr::hash::pkg_2var' => { 348 desc => 'package $hash{$k1}{$k2}', 349 setup => '($k1,$k2) = qw(foo bar); %h = ($k1 => { $k2 => 1 })', 350 code => '$h{$k1}{$k2}', 351 }, 352 'expr::hash::ref_pkg_2var' => { 353 desc => 'package $hashref->{$k1}{$k2}', 354 setup => '($k1,$k2) = qw(foo bar); $r = {$k1 => { $k2 => 1 }}', 355 code => '$r->{$k1}{$k2}', 356 }, 357 'expr::hash::ref_pkg_3const' => { 358 desc => 'package $hashref->{const}{const}{const}', 359 setup => '$r = {foo => { bar => { baz => 1 }}}', 360 code => '$r->{foo}{bar}{baz}', 361 }, 362 'expr::hash::ref_expr_pkg_3const' => { 363 desc => '(package expr)->{const}{const}{const}', 364 setup => '$r = {foo => { bar => { baz => 1 }}}', 365 code => '($r||0)->{foo}{bar}{baz}', 366 }, 367 368 369 'expr::hash::exists_lex_2var' => { 370 desc => 'lexical exists $hash{$k1}{$k2}', 371 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });', 372 code => 'exists $h{$k1}{$k2}', 373 }, 374 375 'expr::hash::bool_empty' => { 376 desc => 'empty lexical hash in boolean context', 377 setup => 'my %h;', 378 code => '!%h', 379 }, 380 'expr::hash::bool_empty_unknown' => { 381 desc => 'empty lexical hash in unknown context', 382 setup => 'my ($i, %h); sub f { if (%h) { $i++ }}', 383 code => 'f()', 384 }, 385 'expr::hash::bool_full' => { 386 desc => 'non-empty lexical hash in boolean context', 387 setup => 'my %h = 1..10;', 388 code => '!%h', 389 }, 390 391 392 ( 393 map { 394 sprintf('expr::hash::notexists_lex_keylen%04d',$_) => { 395 desc => 'exists on non-key of length '. $_, 396 setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key."x"} = 1;', 397 code => 'exists $h{$key}', 398 }, 399 } ( 400 1 .. 24, 401 # 1,2,3,7,8,9,14,15,16,20,24, 402 50, 403 100, 404 1000, 405 ) 406 ), 407 ( 408 map { 409 sprintf('expr::hash::exists_lex_keylen%04d',$_) => { 410 desc => 'exists on existing key of length '. $_, 411 setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key} = 1;', 412 code => 'exists $h{$key}', 413 }, 414 } ( 415 1 .. 24, 416 # 1,2,3,7,8,9,14,15,16,20,24, 417 50, 418 100, 419 1000, 420 ) 421 ), 422 423 'expr::hash::delete_lex_2var' => { 424 desc => 'lexical delete $hash{$k1}{$k2}', 425 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });', 426 code => 'delete $h{$k1}{$k2}', 427 }, 428 429 430 # list assign, OP_AASSIGN 431 432 433 # (....) = () 434 435 'expr::aassign::ma_empty' => { 436 desc => 'my array assigned empty', 437 setup => '', 438 code => 'my @a = ()', 439 }, 440 'expr::aassign::lax_empty' => { 441 desc => 'non-empty lexical array assigned empty', 442 setup => 'my @a = 1..3;', 443 code => '@a = ()', 444 }, 445 'expr::aassign::llax_empty' => { 446 desc => 'non-empty lexical var and array assigned empty', 447 setup => 'my ($x, @a) = 1..4;', 448 code => '($x, @a) = ()', 449 }, 450 'expr::aassign::mh_empty' => { 451 desc => 'my hash assigned empty', 452 setup => '', 453 code => 'my %h = ()', 454 }, 455 'expr::aassign::lhx_empty' => { 456 desc => 'non-empty lexical hash assigned empty', 457 setup => 'my %h = 1..4;', 458 code => '%h = ()', 459 }, 460 'expr::aassign::llhx_empty' => { 461 desc => 'non-empty lexical var and hash assigned empty', 462 setup => 'my ($x, %h) = 1..5;', 463 code => '($x, %h) = ()', 464 }, 465 'expr::aassign::3m_empty' => { 466 desc => 'three my vars assigned empty', 467 setup => '', 468 code => 'my ($x,$y,$z) = ()', 469 }, 470 'expr::aassign::3l_empty' => { 471 desc => 'three lexical vars assigned empty', 472 setup => 'my ($x,$y,$z)', 473 code => '($x,$y,$z) = ()', 474 }, 475 'expr::aassign::3lref_empty' => { 476 desc => 'three lexical ref vars assigned empty', 477 setup => 'my ($x,$y,$z); my $r = []; ', 478 code => '($x,$y,$z) = ($r,$r,$r); ($x,$y,$z) = ()', 479 }, 480 'expr::aassign::pa_empty' => { 481 desc => 'package array assigned empty', 482 setup => '', 483 code => '@a = ()', 484 }, 485 'expr::aassign::pax_empty' => { 486 desc => 'non-empty package array assigned empty', 487 setup => '@a = (1,2,3)', 488 code => '@a = ()', 489 }, 490 'expr::aassign::3p_empty' => { 491 desc => 'three package vars assigned empty', 492 setup => '($x,$y,$z) = 1..3;', 493 code => '($x,$y,$z) = ()', 494 }, 495 496 # (....) = (1,2,3) 497 498 'expr::aassign::ma_3c' => { 499 desc => 'my array assigned 3 consts', 500 setup => '', 501 code => 'my @a = (1,2,3)', 502 }, 503 'expr::aassign::lax_3c' => { 504 desc => 'non-empty lexical array assigned 3 consts', 505 setup => 'my @a = 1..3;', 506 code => '@a = (1,2,3)', 507 }, 508 'expr::aassign::llax_3c' => { 509 desc => 'non-empty lexical var and array assigned 3 consts', 510 setup => 'my ($x, @a) = 1..4;', 511 code => '($x, @a) = (1,2,3)', 512 }, 513 'expr::aassign::mh_4c' => { 514 desc => 'my hash assigned 4 consts', 515 setup => '', 516 code => 'my %h = qw(a 1 b 2)', 517 }, 518 'expr::aassign::lhx_4c' => { 519 desc => 'non-empty lexical hash assigned 4 consts', 520 setup => 'my %h = qw(a 1 b 2);', 521 code => '%h = qw(c 3 d 4)', 522 }, 523 'expr::aassign::llhx_5c' => { 524 desc => 'non-empty lexical var and array assigned 5 consts', 525 setup => 'my ($x, %h) = (1, qw(a 1 b 2));', 526 code => '($x, %h) = (10, qw(c 3 d 4))', 527 }, 528 'expr::aassign::3m_3c' => { 529 desc => 'three my vars assigned 3 consts', 530 setup => '', 531 code => 'my ($x,$y,$z) = (1,2,3)', 532 }, 533 'expr::aassign::3l_3c' => { 534 desc => 'three lexical vars assigned 3 consts', 535 setup => 'my ($x,$y,$z)', 536 code => '($x,$y,$z) = (1,2,3)', 537 }, 538 'expr::aassign::pa_3c' => { 539 desc => 'package array assigned 3 consts', 540 setup => '', 541 code => '@a = (1,2,3)', 542 }, 543 'expr::aassign::pax_3c' => { 544 desc => 'non-empty package array assigned 3 consts', 545 setup => '@a = (1,2,3)', 546 code => '@a = (1,2,3)', 547 }, 548 'expr::aassign::3p_3c' => { 549 desc => 'three package vars assigned 3 consts', 550 setup => '($x,$y,$z) = 1..3;', 551 code => '($x,$y,$z) = (1,2,3)', 552 }, 553 554 # (....) = @lexical 555 556 'expr::aassign::ma_la' => { 557 desc => 'my array assigned lexical array', 558 setup => 'my @init = 1..3;', 559 code => 'my @a = @init', 560 }, 561 'expr::aassign::lax_la' => { 562 desc => 'non-empty lexical array assigned lexical array', 563 setup => 'my @init = 1..3; my @a = 1..3;', 564 code => '@a = @init', 565 }, 566 'expr::aassign::llax_la' => { 567 desc => 'non-empty lexical var and array assigned lexical array', 568 setup => 'my @init = 1..3; my ($x, @a) = 1..4;', 569 code => '($x, @a) = @init', 570 }, 571 'expr::aassign::3m_la' => { 572 desc => 'three my vars assigned lexical array', 573 setup => 'my @init = 1..3;', 574 code => 'my ($x,$y,$z) = @init', 575 }, 576 'expr::aassign::3l_la' => { 577 desc => 'three lexical vars assigned lexical array', 578 setup => 'my @init = 1..3; my ($x,$y,$z)', 579 code => '($x,$y,$z) = @init', 580 }, 581 'expr::aassign::pa_la' => { 582 desc => 'package array assigned lexical array', 583 setup => 'my @init = 1..3;', 584 code => '@a = @init', 585 }, 586 'expr::aassign::pax_la' => { 587 desc => 'non-empty package array assigned lexical array', 588 setup => 'my @init = 1..3; @a = @init', 589 code => '@a = @init', 590 }, 591 'expr::aassign::3p_la' => { 592 desc => 'three package vars assigned lexical array', 593 setup => 'my @init = 1..3; ($x,$y,$z) = 1..3;', 594 code => '($x,$y,$z) = @init', 595 }, 596 597 # (....) = @package 598 599 'expr::aassign::ma_pa' => { 600 desc => 'my array assigned package array', 601 setup => '@init = 1..3;', 602 code => 'my @a = @init', 603 }, 604 'expr::aassign::lax_pa' => { 605 desc => 'non-empty lexical array assigned package array', 606 setup => '@init = 1..3; my @a = 1..3;', 607 code => '@a = @init', 608 }, 609 'expr::aassign::llax_pa' => { 610 desc => 'non-empty lexical var and array assigned package array', 611 setup => '@init = 1..3; my ($x, @a) = 1..4;', 612 code => '($x, @a) = @init', 613 }, 614 'expr::aassign::3m_pa' => { 615 desc => 'three my vars assigned package array', 616 setup => '@init = 1..3;', 617 code => 'my ($x,$y,$z) = @init', 618 }, 619 'expr::aassign::3l_pa' => { 620 desc => 'three lexical vars assigned package array', 621 setup => '@init = 1..3; my ($x,$y,$z)', 622 code => '($x,$y,$z) = @init', 623 }, 624 'expr::aassign::pa_pa' => { 625 desc => 'package array assigned package array', 626 setup => '@init = 1..3;', 627 code => '@a = @init', 628 }, 629 'expr::aassign::pax_pa' => { 630 desc => 'non-empty package array assigned package array', 631 setup => '@init = 1..3; @a = @init', 632 code => '@a = @init', 633 }, 634 'expr::aassign::3p_pa' => { 635 desc => 'three package vars assigned package array', 636 setup => '@init = 1..3; ($x,$y,$z) = 1..3;', 637 code => '($x,$y,$z) = @init', 638 }, 639 640 # (....) = @_; 641 642 'expr::aassign::ma_defary' => { 643 desc => 'my array assigned @_', 644 setup => '@_ = 1..3;', 645 code => 'my @a = @_', 646 }, 647 'expr::aassign::lax_defary' => { 648 desc => 'non-empty lexical array assigned @_', 649 setup => '@_ = 1..3; my @a = 1..3;', 650 code => '@a = @_', 651 }, 652 'expr::aassign::llax_defary' => { 653 desc => 'non-empty lexical var and array assigned @_', 654 setup => '@_ = 1..3; my ($x, @a) = 1..4;', 655 code => '($x, @a) = @_', 656 }, 657 'expr::aassign::3m_defary' => { 658 desc => 'three my vars assigned @_', 659 setup => '@_ = 1..3;', 660 code => 'my ($x,$y,$z) = @_', 661 }, 662 'expr::aassign::3l_defary' => { 663 desc => 'three lexical vars assigned @_', 664 setup => '@_ = 1..3; my ($x,$y,$z)', 665 code => '($x,$y,$z) = @_', 666 }, 667 'expr::aassign::pa_defary' => { 668 desc => 'package array assigned @_', 669 setup => '@_ = 1..3;', 670 code => '@a = @_', 671 }, 672 'expr::aassign::pax_defary' => { 673 desc => 'non-empty package array assigned @_', 674 setup => '@_ = 1..3; @a = @_', 675 code => '@a = @_', 676 }, 677 'expr::aassign::3p_defary' => { 678 desc => 'three package vars assigned @_', 679 setup => '@_ = 1..3; ($x,$y,$z) = 1..3;', 680 code => '($x,$y,$z) = @_', 681 }, 682 683 # (....) = %lexical 684 685 'expr::aassign::ma_lh' => { 686 desc => 'my array assigned lexical hash', 687 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 688 code => 'my @a = %h', 689 }, 690 691 692 # (....) = ($lex1,$lex2,$lex3); 693 694 'expr::aassign::ma_3l' => { 695 desc => 'my array assigned lexicals', 696 setup => 'my ($v1,$v2,$v3) = 1..3;', 697 code => 'my @a = ($v1,$v2,$v3)', 698 }, 699 'expr::aassign::lax_3l' => { 700 desc => 'non-empty lexical array assigned lexicals', 701 setup => 'my ($v1,$v2,$v3) = 1..3; my @a = 1..3;', 702 code => '@a = ($v1,$v2,$v3)', 703 }, 704 'expr::aassign::llax_3l' => { 705 desc => 'non-empty lexical var and array assigned lexicals', 706 setup => 'my ($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;', 707 code => '($x, @a) = ($v1,$v2,$v3)', 708 }, 709 'expr::aassign::3m_3l' => { 710 desc => 'three my vars assigned lexicals', 711 setup => 'my ($v1,$v2,$v3) = 1..3;', 712 code => 'my ($x,$y,$z) = ($v1,$v2,$v3)', 713 }, 714 'expr::aassign::3l_3l' => { 715 desc => 'three lexical vars assigned lexicals', 716 setup => 'my ($v1,$v2,$v3) = 1..3; my ($x,$y,$z)', 717 code => '($x,$y,$z) = ($v1,$v2,$v3)', 718 }, 719 'expr::aassign::pa_3l' => { 720 desc => 'package array assigned lexicals', 721 setup => 'my ($v1,$v2,$v3) = 1..3;', 722 code => '@a = ($v1,$v2,$v3)', 723 }, 724 'expr::aassign::pax_3l' => { 725 desc => 'non-empty package array assigned lexicals', 726 setup => 'my ($v1,$v2,$v3) = 1..3; @a = @_', 727 code => '@a = ($v1,$v2,$v3)', 728 }, 729 'expr::aassign::3p_3l' => { 730 desc => 'three package vars assigned lexicals', 731 setup => 'my ($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;', 732 code => '($x,$y,$z) = ($v1,$v2,$v3)', 733 }, 734 735 736 # (....) = ($pkg1,$pkg2,$pkg3); 737 738 'expr::aassign::ma_3p' => { 739 desc => 'my array assigned 3 package vars', 740 setup => '($v1,$v2,$v3) = 1..3;', 741 code => 'my @a = ($v1,$v2,$v3)', 742 }, 743 'expr::aassign::lax_3p' => { 744 desc => 'non-empty lexical array assigned 3 package vars', 745 setup => '($v1,$v2,$v3) = 1..3; my @a = 1..3;', 746 code => '@a = ($v1,$v2,$v3)', 747 }, 748 'expr::aassign::llax_3p' => { 749 desc => 'non-empty lexical var and array assigned 3 package vars', 750 setup => '($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;', 751 code => '($x, @a) = ($v1,$v2,$v3)', 752 }, 753 'expr::aassign::3m_3p' => { 754 desc => 'three my vars assigned 3 package vars', 755 setup => '($v1,$v2,$v3) = 1..3;', 756 code => 'my ($x,$y,$z) = ($v1,$v2,$v3)', 757 }, 758 'expr::aassign::3l_3p' => { 759 desc => 'three lexical vars assigned 3 package vars', 760 setup => '($v1,$v2,$v3) = 1..3; my ($x,$y,$z)', 761 code => '($x,$y,$z) = ($v1,$v2,$v3)', 762 }, 763 'expr::aassign::pa_3p' => { 764 desc => 'package array assigned 3 package vars', 765 setup => '($v1,$v2,$v3) = 1..3;', 766 code => '@a = ($v1,$v2,$v3)', 767 }, 768 'expr::aassign::pax_3p' => { 769 desc => 'non-empty package array assigned 3 package vars', 770 setup => '($v1,$v2,$v3) = 1..3; @a = @_', 771 code => '@a = ($v1,$v2,$v3)', 772 }, 773 'expr::aassign::3p_3p' => { 774 desc => 'three package vars assigned 3 package vars', 775 setup => '($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;', 776 code => '($x,$y,$z) = ($v1,$v2,$v3)', 777 }, 778 779 780 # (....) = (1,2,$shared); 781 782 'expr::aassign::llax_2c1s' => { 783 desc => 'non-empty lexical var and array assigned 2 consts and 1 shared var', 784 setup => 'my ($x, @a) = 1..4;', 785 code => '($x, @a) = (1,2,$x)', 786 }, 787 'expr::aassign::3l_2c1s' => { 788 desc => 'three lexical vars assigned 2 consts and 1 shared var', 789 setup => 'my ($x,$y,$z) = 1..3;', 790 code => '($x,$y,$z) = (1,2,$x)', 791 }, 792 'expr::aassign::3p_2c1s' => { 793 desc => 'three package vars assigned 2 consts and 1 shared var', 794 setup => '($x,$y,$z) = 1..3;', 795 code => '($x,$y,$z) = (1,2,$x)', 796 }, 797 798 799 # ($a,$b) = ($b,$a); 800 801 'expr::aassign::2l_swap' => { 802 desc => 'swap two lexical vars', 803 setup => 'my ($a,$b) = (1,2)', 804 code => '($a,$b) = ($b,$a)', 805 }, 806 'expr::aassign::2p_swap' => { 807 desc => 'swap two package vars', 808 setup => '($a,$b) = (1,2)', 809 code => '($a,$b) = ($b,$a)', 810 }, 811 'expr::aassign::2laelem_swap' => { 812 desc => 'swap two lexical vars', 813 setup => 'my @a = (1,2)', 814 code => '($a[0],$a[1]) = ($a[1],$a[0])', 815 }, 816 817 # misc list assign 818 819 'expr::aassign::5l_4l1s' => { 820 desc => 'long list of lexical vars, 1 shared', 821 setup => 'my ($a,$b,$c,$d,$e) = 1..5', 822 code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)', 823 }, 824 825 'expr::aassign::5p_4p1s' => { 826 desc => 'long list of package vars, 1 shared', 827 setup => '($a,$b,$c,$d,$e) = 1..5', 828 code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)', 829 }, 830 'expr::aassign::5l_defary' => { 831 desc => 'long list of lexical vars to assign @_ to', 832 setup => '@_ = 1..5', 833 code => 'my ($a,$b,$c,$d,$e) = @_', 834 }, 835 'expr::aassign::5l1la_defary' => { 836 desc => 'long list of lexical vars plus long slurp to assign @_ to', 837 setup => '@_ = 1..20', 838 code => 'my ($a,$b,$c,$d,$e,@rest) = @_', 839 }, 840 'expr::aassign::1l_2l' => { 841 desc => 'single lexical LHS', 842 setup => 'my $x = 1;', 843 code => '(undef,$x) = ($x,$x)', 844 }, 845 'expr::aassign::2l_1l' => { 846 desc => 'single lexical RHS', 847 setup => 'my $x = 1;', 848 code => '($x,$x) = ($x)', 849 }, 850 'expr::aassign::2l_1ul' => { 851 desc => 'undef and single lexical RHS', 852 setup => 'my $x = 1;', 853 code => '($x,$x) = (undef, $x)', 854 }, 855 856 'expr::aassign::2list_lex' => { 857 desc => 'lexical ($x, $y) = (1, 2)', 858 setup => 'my ($x, $y)', 859 code => '($x, $y) = (1, 2)', 860 }, 861 862 'expr::aassign::lex_rv' => { 863 desc => 'lexical ($ref1, $ref2) = ($ref3, $ref4)', 864 setup => 'my ($r1, $r2, $r3, $r4); 865 ($r1, $r2) = (($r3, $r4) = ([], []));', 866 code => '($r1, $r2) = ($r3, $r4)', 867 }, 868 869 'expr::aassign::lex_rv1' => { 870 desc => 'lexical ($ref1, $ref2) = ($ref3, $ref4) where ref1,2 are freed', 871 setup => 'my ($r1, $r2);', 872 code => '($r1, $r2) = ([], []);', 873 }, 874 875 'expr::aassign::boolean' => { 876 desc => '!(@a = @b)', 877 setup => 'my ($s,@a, @b); @b = (1,2)', 878 code => '!(@a = @b);', 879 }, 880 'expr::aassign::scalar' => { 881 desc => '$scalar = (@a = @b)', 882 setup => 'my ($s, @a, @b); @b = (1,2)', 883 code => '$s = (@a = @b);', 884 }, 885 886 # array assign of strings 887 888 'expr::aassign::la_3s' => { 889 desc => 'assign 3 strings to empty lexical array', 890 setup => 'my @a', 891 code => '@a = (); @a = qw(abc defg hijkl);', 892 }, 893 'expr::aassign::la_3ts' => { 894 desc => 'assign 3 temp strings to empty lexical array', 895 setup => 'my @a', 896 code => '@a = (); @a = map $_, qw(abc defg hijkl);', 897 }, 898 'expr::aassign::lan_3s' => { 899 desc => 'assign 3 strings to non-empty lexical array', 900 setup => 'my @a = qw(abc defg hijkl)', 901 code => '@a = qw(abc defg hijkl);', 902 }, 903 'expr::aassign::lan_3ts' => { 904 desc => 'assign 3 temp strings to non-empty lexical array', 905 setup => 'my @a = qw(abc defg hijkl)', 906 code => '@a = map $_, qw(abc defg hijkl);', 907 }, 908 909 # hash assign of strings 910 911 'expr::aassign::lh_2s' => { 912 desc => 'assign 2 strings to empty lexical hash', 913 setup => 'my %h', 914 code => '%h = (); %h = qw(k1 abc k2 defg);', 915 }, 916 'expr::aassign::lh_2ts' => { 917 desc => 'assign 2 temp strings to empty lexical hash', 918 setup => 'my %h', 919 code => '%h = (); %h = map $_, qw(k1 abc k2 defg);', 920 }, 921 'expr::aassign::lhn_2s' => { 922 desc => 'assign 2 strings to non-empty lexical hash', 923 setup => 'my %h = qw(k1 abc k2 defg);', 924 code => '%h = qw(k1 abc k2 defg);', 925 }, 926 'expr::aassign::lhn_2ts' => { 927 desc => 'assign 2 temp strings to non-empty lexical hash', 928 setup => 'my %h = qw(k1 abc k2 defg);', 929 code => '%h = map $_, qw(k1 abc k2 defg);', 930 }, 931 932 933 'expr::arith::add_lex_ii' => { 934 desc => 'add two integers and assign to a lexical var', 935 setup => 'my ($x,$y,$z) = 1..3;', 936 code => '$z = $x + $y', 937 }, 938 'expr::arith::add_pkg_ii' => { 939 desc => 'add two integers and assign to a package var', 940 setup => 'my ($x,$y) = 1..2; $z = 3;', 941 code => '$z = $x + $y', 942 }, 943 'expr::arith::add_lex_nn' => { 944 desc => 'add two NVs and assign to a lexical var', 945 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 946 code => '$z = $x + $y', 947 }, 948 'expr::arith::add_pkg_nn' => { 949 desc => 'add two NVs and assign to a package var', 950 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 951 code => '$z = $x + $y', 952 }, 953 'expr::arith::add_lex_ni' => { 954 desc => 'add an int and an NV and assign to a lexical var', 955 setup => 'my ($y,$z) = (2.2, 3.3);', 956 pre => 'my $x = 1', # after 1st iter gets upgraded to PVNV 957 code => '$z = $x + $y', 958 }, 959 'expr::arith::add_pkg_ni' => { 960 desc => 'add an int and an NV and assign to a package var', 961 setup => 'my ($y); ($y,$z) = (2.2, 3.3);', 962 pre => 'my $x = 1', # after 1st iter gets upgraded to PVNV 963 code => '$z = $x + $y', 964 }, 965 'expr::arith::add_lex_ss' => { 966 desc => 'add two short strings and assign to a lexical var', 967 setup => 'my ($x,$y,$z) = ("1", "2", 1);', 968 code => '$z = $x + $y; $x = "1"; ', 969 }, 970 971 'expr::arith::add_lex_ll' => { 972 desc => 'add two long strings and assign to a lexical var', 973 setup => 'my ($x,$y,$z) = ("12345", "23456", 1);', 974 code => '$z = $x + $y; $x = "12345"; ', 975 }, 976 977 'expr::arith::sub_lex_ii' => { 978 desc => 'subtract two integers and assign to a lexical var', 979 setup => 'my ($x,$y,$z) = 1..3;', 980 code => '$z = $x - $y', 981 }, 982 'expr::arith::sub_pkg_ii' => { 983 desc => 'subtract two integers and assign to a package var', 984 setup => 'my ($x,$y) = 1..2; $z = 3;', 985 code => '$z = $x - $y', 986 }, 987 'expr::arith::sub_lex_nn' => { 988 desc => 'subtract two NVs and assign to a lexical var', 989 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 990 code => '$z = $x - $y', 991 }, 992 'expr::arith::sub_pkg_nn' => { 993 desc => 'subtract two NVs and assign to a package var', 994 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 995 code => '$z = $x - $y', 996 }, 997 'expr::arith::sub_lex_ni' => { 998 desc => 'subtract an int and an NV and assign to a lexical var', 999 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 1000 code => '$z = $x - $y', 1001 }, 1002 'expr::arith::sub_pkg_ni' => { 1003 desc => 'subtract an int and an NV and assign to a package var', 1004 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 1005 code => '$z = $x - $y', 1006 }, 1007 1008 'expr::arith::mult_lex_ii' => { 1009 desc => 'multiply two integers and assign to a lexical var', 1010 setup => 'my ($x,$y,$z) = 1..3;', 1011 code => '$z = $x * $y', 1012 }, 1013 'expr::arith::mult_pkg_ii' => { 1014 desc => 'multiply two integers and assign to a package var', 1015 setup => 'my ($x,$y) = 1..2; $z = 3;', 1016 code => '$z = $x * $y', 1017 }, 1018 'expr::arith::mult_lex_nn' => { 1019 desc => 'multiply two NVs and assign to a lexical var', 1020 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 1021 code => '$z = $x * $y', 1022 }, 1023 'expr::arith::mult_pkg_nn' => { 1024 desc => 'multiply two NVs and assign to a package var', 1025 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 1026 code => '$z = $x * $y', 1027 }, 1028 'expr::arith::mult_lex_ni' => { 1029 desc => 'multiply an int and an NV and assign to a lexical var', 1030 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 1031 code => '$z = $x * $y', 1032 }, 1033 'expr::arith::mult_pkg_ni' => { 1034 desc => 'multiply an int and an NV and assign to a package var', 1035 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 1036 code => '$z = $x * $y', 1037 }, 1038 1039 # use '!' to test SvTRUE on various classes of value 1040 1041 'expr::arith::not_PL_undef' => { 1042 desc => '!undef (using PL_sv_undef)', 1043 setup => 'my $x', 1044 code => '$x = !undef', 1045 }, 1046 'expr::arith::not_PL_no' => { 1047 desc => '!($x == $y) (using PL_sv_no)', 1048 setup => 'my ($x, $y) = (1,2); my $z;', 1049 code => '$z = !($x == $y)', 1050 }, 1051 'expr::arith::not_PL_zero' => { 1052 desc => '!%h (using PL_sv_zero)', 1053 setup => 'my ($x, %h)', 1054 code => '$x = !%h', 1055 }, 1056 'expr::arith::not_PL_yes' => { 1057 desc => '!($x == $y) (using PL_sv_yes)', 1058 setup => 'my ($x, $y) = (1,1); my $z;', 1059 code => '$z = !($x == $y)', 1060 }, 1061 'expr::arith::not_undef' => { 1062 desc => '!$y where $y is undef', 1063 setup => 'my ($x, $y)', 1064 code => '$x = !$y', 1065 }, 1066 'expr::arith::not_0' => { 1067 desc => '!$x where $x is 0', 1068 setup => 'my ($x, $y) = (0, 0)', 1069 code => '$y = !$x', 1070 }, 1071 'expr::arith::not_1' => { 1072 desc => '!$x where $x is 1', 1073 setup => 'my ($x, $y) = (1, 0)', 1074 code => '$y = !$x', 1075 }, 1076 'expr::arith::not_string' => { 1077 desc => '!$x where $x is "foo"', 1078 setup => 'my ($x, $y) = ("foo", 0)', 1079 code => '$y = !$x', 1080 }, 1081 'expr::arith::not_ref' => { 1082 desc => '!$x where $s is an array ref', 1083 setup => 'my ($x, $y) = ([], 0)', 1084 code => '$y = !$x', 1085 }, 1086 1087 'expr::arith::preinc' => { 1088 setup => 'my $x = 1;', 1089 code => '++$x', 1090 }, 1091 'expr::arith::predec' => { 1092 setup => 'my $x = 1;', 1093 code => '--$x', 1094 }, 1095 'expr::arith::postinc' => { 1096 desc => '$x++', 1097 setup => 'my $x = 1; my $y', 1098 code => '$y = $x++', # scalar context so not optimised to ++$x 1099 }, 1100 'expr::arith::postdec' => { 1101 desc => '$x--', 1102 setup => 'my $x = 1; my $y', 1103 code => '$y = $x--', # scalar context so not optimised to --$x 1104 }, 1105 1106 1107 # concatenation; quite possibly optimised to OP_MULTICONCAT 1108 1109 'expr::concat::cl' => { 1110 setup => 'my $lex = "abcd"', 1111 code => '"foo" . $lex', 1112 }, 1113 'expr::concat::lc' => { 1114 setup => 'my $lex = "abcd"', 1115 code => '$lex . "foo"', 1116 }, 1117 'expr::concat::ll' => { 1118 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1119 code => '$lex1 . $lex2', 1120 }, 1121 1122 'expr::concat::l_append_c' => { 1123 setup => 'my $lex', 1124 pre => '$lex = "abcd"', 1125 code => '$lex .= "foo"', 1126 }, 1127 'expr::concat::l_append_l' => { 1128 setup => 'my $lex1; my $lex2 = "wxyz"', 1129 pre => '$lex1 = "abcd"', 1130 code => '$lex1 .= $lex2', 1131 }, 1132 'expr::concat::l_append_ll' => { 1133 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1134 pre => '$lex1 = "abcd"', 1135 code => '$lex1 .= $lex2 . $lex3', 1136 }, 1137 'expr::concat::l_append_clclc' => { 1138 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1139 pre => '$lex1 = "abcd"', 1140 code => '$lex1 .= "-foo-$lex2-foo-$lex3-foo"', 1141 }, 1142 'expr::concat::l_append_lll' => { 1143 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(pqrs wxyz 1234)', 1144 pre => '$lex1 = "abcd"', 1145 code => '$lex1 .= $lex2 . $lex3 . $lex4', 1146 }, 1147 1148 'expr::concat::m_ll' => { 1149 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1150 code => 'my $lex = $lex1 . $lex2', 1151 }, 1152 'expr::concat::m_lll' => { 1153 setup => 'my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1154 code => 'my $lex = $lex1 . $lex2 . $lex3', 1155 }, 1156 'expr::concat::m_cl' => { 1157 setup => 'my $lex1 = "abcd"', 1158 code => 'my $lex = "const$lex1"', 1159 }, 1160 'expr::concat::m_clclc' => { 1161 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1162 code => 'my $lex = "foo=$lex1 bar=$lex2\n"', 1163 }, 1164 'expr::concat::m_clclc_long' => { 1165 desc => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1166 setup => 'my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1167 code => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1168 }, 1169 1170 'expr::concat::l_ll' => { 1171 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1172 code => '$lex = $lex1 . $lex2', 1173 }, 1174 'expr::concat::l_ll_ldup' => { 1175 setup => 'my $lex1; my $lex2 = "wxyz"', 1176 pre => '$lex1 = "abcd"', 1177 code => '$lex1 = $lex1 . $lex2', 1178 }, 1179 'expr::concat::l_ll_rdup' => { 1180 setup => 'my $lex1; my $lex2 = "wxyz"', 1181 pre => '$lex1 = "abcd"', 1182 code => '$lex1 = $lex2 . $lex1', 1183 }, 1184 'expr::concat::l_ll_lrdup' => { 1185 setup => 'my $lex1', 1186 pre => '$lex1 = "abcd"', 1187 code => '$lex1 = $lex1 . $lex1', 1188 }, 1189 'expr::concat::l_lll' => { 1190 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1191 code => '$lex = $lex1 . $lex2 . $lex3', 1192 }, 1193 'expr::concat::l_lllll' => { 1194 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"; my $lex4 = "the quick brown fox"; my $lex5 = "to be, or not to be..."', 1195 code => '$lex = $lex1 . $lex2 . $lex3 . $lex4 . $lex5', 1196 }, 1197 'expr::concat::l_cl' => { 1198 setup => 'my $lex; my $lex1 = "abcd"', 1199 code => '$lex = "const$lex1"', 1200 }, 1201 'expr::concat::l_clclc' => { 1202 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1203 code => '$lex = "foo=$lex1 bar=$lex2\n"', 1204 }, 1205 'expr::concat::l_clclc_long' => { 1206 desc => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1207 setup => 'my $lex; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1208 code => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1209 }, 1210 'expr::concat::l_clclclclclc' => { 1211 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "the quick brown fox"; my $lex4 = "to be, or not to be..."', 1212 code => '$lex = "foo1=$lex1 foo2=$lex2 foo3=$lex3 foo4=$lex4\n"', 1213 }, 1214 1215 'expr::concat::g_append_c' => { 1216 setup => 'our $pkg', 1217 pre => '$pkg = "abcd"', 1218 code => '$pkg .= "foo"', 1219 }, 1220 'expr::concat::g_append_l' => { 1221 setup => 'our $pkg; my $lex1 = "wxyz"', 1222 pre => '$pkg = "abcd"', 1223 code => '$pkg .= $lex1', 1224 }, 1225 'expr::concat::g_append_ll' => { 1226 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1227 pre => '$pkg = "abcd"', 1228 code => '$pkg .= $lex1 . $lex2', 1229 }, 1230 'expr::concat::g_append_clclc' => { 1231 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1232 pre => '$pkg = "abcd"', 1233 code => '$pkg .= "-foo-$lex1-foo-$lex2-foo-"', 1234 }, 1235 1236 'expr::concat::g_ll' => { 1237 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1238 code => '$pkg = $lex1 . $lex2', 1239 }, 1240 'expr::concat::g_gl_ldup' => { 1241 setup => 'our $pkg; my $lex2 = "wxyz"', 1242 pre => '$pkg = "abcd"', 1243 code => '$pkg = $pkg . $lex2', 1244 }, 1245 'expr::concat::g_lg_rdup' => { 1246 setup => 'our $pkg; my $lex1 = "wxyz"', 1247 pre => '$pkg = "abcd"', 1248 code => '$pkg = $lex1 . $pkg', 1249 }, 1250 'expr::concat::g_gg_lrdup' => { 1251 setup => 'our $pkg', 1252 pre => '$pkg = "abcd"', 1253 code => '$pkg = $pkg . $pkg', 1254 }, 1255 'expr::concat::g_lll' => { 1256 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1257 code => '$pkg = $lex1 . $lex2 . $lex3', 1258 }, 1259 'expr::concat::g_cl' => { 1260 setup => 'our $pkg; my $lex1 = "abcd"', 1261 code => '$pkg = "const$lex1"', 1262 }, 1263 'expr::concat::g_clclc' => { 1264 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1265 code => '$pkg = "foo=$lex1 bar=$lex2\n"', 1266 }, 1267 'expr::concat::g_clclc_long' => { 1268 desc => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1269 setup => 'our $pkg; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1270 code => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1271 }, 1272 1273 'expr::concat::utf8_uuu' => { 1274 desc => 'my $s = $a.$b.$c where all args are utf8', 1275 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1276 code => '$s = $a.$b.$c', 1277 }, 1278 'expr::concat::utf8_suu' => { 1279 desc => 'my $s = "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1280 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1281 code => '$s = "foo=$a bar=$b baz=$c"', 1282 }, 1283 'expr::concat::utf8_usu' => { 1284 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1285 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1286 code => '$s = "foo=$a bar=$b baz=$c"', 1287 }, 1288 'expr::concat::utf8_usx' => { 1289 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1290 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1291 code => '$s = "foo=$a bar=$b baz=$c"', 1292 }, 1293 1294 'expr::concat::utf8_s_append_uuu' => { 1295 desc => '$s .= $a.$b.$c where all RH args are utf8', 1296 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1297 pre => '$s = "abcd"', 1298 code => '$s .= $a.$b.$c', 1299 }, 1300 'expr::concat::utf8_s_append_suu' => { 1301 desc => '$s .= "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1302 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1303 pre => '$s = "abcd"', 1304 code => '$s .= "foo=$a bar=$b baz=$c"', 1305 }, 1306 'expr::concat::utf8_s_append_usu' => { 1307 desc => '$s .= "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1308 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1309 pre => '$s = "abcd"', 1310 code => '$s .= "foo=$a bar=$b baz=$c"', 1311 }, 1312 'expr::concat::utf8_s_append_usx' => { 1313 desc => '$s .= "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1314 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1315 pre => '$s = "abcd"', 1316 code => '$s .= "foo=$a bar=$b baz=$c"', 1317 }, 1318 1319 'expr::concat::utf8_u_append_uuu' => { 1320 desc => '$s .= $a.$b.$c where all args are utf8', 1321 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1322 pre => '$s = "\x{100}wxyz"', 1323 code => '$s .= $a.$b.$c', 1324 }, 1325 'expr::concat::utf8_u_append_suu' => { 1326 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$b,$c are utf8', 1327 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1328 pre => '$s = "\x{100}wxyz"', 1329 code => '$s .= "foo=$a bar=$b baz=$c"', 1330 }, 1331 'expr::concat::utf8_u_append_usu' => { 1332 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a,$c are utf8', 1333 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1334 pre => '$s = "\x{100}wxyz"', 1335 code => '$s .= "foo=$a bar=$b baz=$c"', 1336 }, 1337 'expr::concat::utf8_u_append_usx' => { 1338 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a are utf8, $c has 0x80', 1339 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1340 pre => '$s = "\x{100}wxyz"', 1341 code => '$s .= "foo=$a bar=$b baz=$c"', 1342 }, 1343 1344 'expr::concat::nested_mutator' => { 1345 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(abcd pqrs wxyz)', 1346 pre => '$lex1 = "QPR"', 1347 code => '(($lex1 .= $lex2) .= $lex3) .= $lex4', 1348 }, 1349 1350 1351 # concatenation with magic vars; 1352 # quite possibly optimised to OP_MULTICONCAT 1353 1354 'expr::concat::mg::cM' => { 1355 setup => '"abcd" =~ /(.*)/', 1356 code => '"foo" . $1', 1357 }, 1358 'expr::concat::mg::Mc' => { 1359 setup => '"abcd" =~ /(.*)/', 1360 code => '$1 . "foo"', 1361 }, 1362 'expr::concat::mg::MM' => { 1363 setup => '"abcd" =~ /(.*)/', 1364 code => '$1 . $1', 1365 }, 1366 1367 'expr::concat::mg::l_append_M' => { 1368 setup => 'my $lex; "abcd" =~ /(.*)/;', 1369 pre => '$lex = "abcd"', 1370 code => '$lex .= $1', 1371 }, 1372 'expr::concat::mg::l_append_MM' => { 1373 setup => 'my $lex; "abcd" =~ /(.*)/;', 1374 pre => '$lex = "abcd"', 1375 code => '$lex .= $1 .$1', 1376 }, 1377 'expr::concat::mg::l_append_cMcMc' => { 1378 setup => 'my $lex; "abcd" =~ /(.*)/;', 1379 pre => '$lex = "abcd"', 1380 code => '$lex .= "-foo-$1-foo-$1-foo"', 1381 }, 1382 'expr::concat::mg::l_append_MMM' => { 1383 setup => 'my $lex; "abcd" =~ /(.*)/;', 1384 pre => '$lex = "abcd"', 1385 code => '$lex .= $1 .$1 . $1', 1386 }, 1387 1388 'expr::concat::mg::m_MM' => { 1389 setup => '"abcd" =~ /(.*)/;', 1390 code => 'my $lex = $1 . $1', 1391 }, 1392 'expr::concat::mg::m_MMM' => { 1393 setup => '"abcd" =~ /(.*)/;', 1394 code => 'my $lex = $1 . $1 . $1', 1395 }, 1396 'expr::concat::mg::m_cL' => { 1397 setup => '"abcd" =~ /(.*)/;', 1398 code => 'my $lex = "const$1"', 1399 }, 1400 'expr::concat::mg::m_cMcMc' => { 1401 setup => '"abcd" =~ /(.*)/;', 1402 code => 'my $lex = "foo=$1 bar=$1\n"', 1403 }, 1404 'expr::concat::mg::m_cMcMc_long' => { 1405 desc => 'my $lex = "foooooooooo=$1 baaaaaaaaar=$1\n" where $1 is 400 chars', 1406 setup => 'my $s = "abcd" x 100; $s =~ /(.*)/;', 1407 code => 'my $lex = "foooooooooo=$1 baaaaaaaaar=$1\n"', 1408 }, 1409 1410 'expr::concat::mg::l_MM' => { 1411 setup => 'my $lex; "abcd" =~ /(.*)/;', 1412 code => '$lex = $1 . $1', 1413 }, 1414 'expr::concat::mg::l_lM_ldup' => { 1415 setup => 'my $lex1; "abcd" =~ /(.*)/;', 1416 pre => '$lex1 = "abcd"', 1417 code => '$lex1 = $lex1 . $1', 1418 }, 1419 'expr::concat::mg::l_Ml_rdup' => { 1420 setup => 'my $lex1; "abcd" =~ /(.*)/;', 1421 pre => '$lex1 = "abcd"', 1422 code => '$lex1 = $1 . $lex1', 1423 }, 1424 'expr::concat::mg::l_MMM' => { 1425 setup => 'my $lex; "abcd" =~ /(.*)/;', 1426 code => '$lex = $1 . $1 . $1', 1427 }, 1428 'expr::concat::mg::l_MMMMM' => { 1429 setup => 'my $lex; "abcd" =~ /(.*)/;', 1430 code => '$lex = $1 . $1 . $1 . $1 . $1', 1431 }, 1432 'expr::concat::mg::l_cM' => { 1433 setup => 'my $lex; "abcd" =~ /(.*)/;', 1434 code => '$lex = "const$1"', 1435 }, 1436 'expr::concat::mg::l_cMcMc' => { 1437 setup => 'my $lex; "abcd" =~ /(.*)/;', 1438 code => '$lex = "foo=$1 bar=$1\n"', 1439 }, 1440 'expr::concat::mg::l_cMcMc_long' => { 1441 desc => '$lex = "foooooooooo=$1 baaaaaaaaar=$1\n" where $1 is 400 chars', 1442 setup => 'my $s = "abcd" x 100; $s =~ /(.*)/;', 1443 code => '$lex = "foooooooooo=$1 baaaaaaaaar=$1\n"', 1444 }, 1445 'expr::concat::mg::l_cMcMcMcMcMc' => { 1446 setup => 'my $lex; "abcd" =~ /(.*)/;', 1447 code => '$lex = "foo1=$1 foo2=$1 foo3=$1 foo4=$1\n"', 1448 }, 1449 1450 'expr::concat::mg::g_append_M' => { 1451 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1452 pre => '$pkg = "abcd"', 1453 code => '$pkg .= $1', 1454 }, 1455 'expr::concat::mg::g_append_MM' => { 1456 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1457 pre => '$pkg = "abcd"', 1458 code => '$pkg .= $1', 1459 code => '$pkg .= $1 . $1', 1460 }, 1461 'expr::concat::mg::g_append_cMcMc' => { 1462 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1463 pre => '$pkg = "abcd"', 1464 code => '$pkg .= "-foo-$1-foo-$1-foo-"', 1465 }, 1466 1467 'expr::concat::mg::g_MM' => { 1468 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1469 code => '$pkg = $1 . $1', 1470 }, 1471 'expr::concat::mg::g_gM_ldup' => { 1472 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1473 pre => '$pkg = "abcd"', 1474 code => '$pkg = $pkg . $1', 1475 }, 1476 'expr::concat::mg::g_Mg_rdup' => { 1477 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1478 pre => '$pkg = "abcd"', 1479 code => '$pkg = $1 . $pkg', 1480 }, 1481 'expr::concat::mg::g_MMM' => { 1482 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1483 code => '$pkg = $1 . $1 . $1', 1484 }, 1485 'expr::concat::mg::g_cM' => { 1486 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1487 code => '$pkg = "const$1"', 1488 }, 1489 'expr::concat::mg::g_cMcMc' => { 1490 setup => 'our $pkg; "abcd" =~ /(.*)/;', 1491 code => '$pkg = "foo=$1 bar=$1\n"', 1492 }, 1493 'expr::concat::mg::g_cMcMc_long' => { 1494 desc => '$lex = "foooooooooo=$1 baaaaaaaaar=$1\n" where $1 is 400 chars', 1495 setup => 'our $pkg; my $s = "abcd" x 100; $s =~ /(.*)/;', 1496 code => '$pkg = "foooooooooo=$1 baaaaaaaaar=$1\n"', 1497 }, 1498 1499 'expr::concat::mg::utf8_uuu' => { 1500 desc => 'my $s = $1.$1.$1 where $1 utf8', 1501 setup => 'my $s; "ab\x{100}cde" =~ /(.*)/;', 1502 code => '$s = $1.$1.$1', 1503 }, 1504 'expr::concat::mg::utf8_suu' => { 1505 desc => 'my $s = "foo=$a bar=$1 baz=$1" where $1 is utf8', 1506 setup => 'my $s; my $a = "abcde"; "ab\x{100}cde" =~ /(.*)/;', 1507 code => '$s = "foo=$a bar=$1 baz=$1"', 1508 }, 1509 1510 # OP_MULTICONCAT with magic within s///g - see GH #21360 1511 1512 'expr::concat::mg::subst1_1' => { 1513 desc => 's/(.)/$1-/g, 1 iteration', 1514 pre => '$_ = "a"', 1515 code => 's/(.)/$1-/g', 1516 }, 1517 1518 'expr::concat::mg::subst1_2' => { 1519 desc => 's/(.)/$1-/g, 2 iterations', 1520 pre => '$_ = "aa"', 1521 code => 's/(.)/$1-/g', 1522 }, 1523 1524 'expr::concat::mg::subst1_5' => { 1525 desc => 's/(.)/$1-/g, 5 iterations', 1526 pre => '$_ = "aaaaa"', 1527 code => 's/(.)/$1-/g', 1528 }, 1529 1530 'expr::concat::mg::subst2_1' => { 1531 desc => 's/(.)/$1-$1/g, 1 iteration', 1532 pre => '$_ = "a"', 1533 code => 's/(.)/$1-/g', 1534 }, 1535 1536 'expr::concat::mg::subst3_1' => { 1537 desc => 's/(.)/$1-$1-$1/g, 1 iteration', 1538 pre => '$_ = "a"', 1539 code => 's/(.)/$1-$1-$1/g', 1540 }, 1541 1542 1543 1544 # scalar assign, OP_SASSIGN 1545 1546 'expr::sassign::undef_lex' => { 1547 setup => 'my $x', 1548 code => '$x = undef', 1549 }, 1550 'expr::sassign::undef_lex_direc' => { 1551 setup => 'my $x', 1552 code => 'undef $x', 1553 }, 1554 'expr::sassign::undef_my_lex' => { 1555 setup => '', 1556 code => 'my $x = undef', 1557 }, 1558 'expr::sassign::undef_my_lex_direc' => { 1559 setup => '', 1560 code => 'undef my $x', 1561 }, 1562 1563 'expr::sassign::anonlist' => { 1564 setup => '', 1565 code => '$x = []' 1566 }, 1567 'expr::sassign::anonlist_lex' => { 1568 setup => 'my $x', 1569 code => '$x = []' 1570 }, 1571 'expr::sassign::my_anonlist_lex' => { 1572 setup => '', 1573 code => 'my $x = []' 1574 }, 1575 'expr::sassign::anonhash' => { 1576 setup => '', 1577 code => '$x = {}' 1578 }, 1579 'expr::sassign::anonhash_lex' => { 1580 setup => 'my $x', 1581 code => '$x = {}' 1582 }, 1583 'expr::sassign::my_anonhash_lex' => { 1584 setup => '', 1585 code => 'my $x = {}' 1586 }, 1587 1588 'expr::sassign::my_conststr' => { 1589 setup => '', 1590 code => 'my $x = "abc"', 1591 }, 1592 'expr::sassign::scalar_lex_int' => { 1593 desc => 'lexical $x = 1', 1594 setup => 'my $x', 1595 code => '$x = 1', 1596 }, 1597 'expr::sassign::scalar_lex_str' => { 1598 desc => 'lexical $x = "abc"', 1599 setup => 'my $x', 1600 code => '$x = "abc"', 1601 }, 1602 'expr::sassign::scalar_lex_strint' => { 1603 desc => 'lexical $x = 1 where $x was previously a string', 1604 setup => 'my $x = "abc"', 1605 code => '$x = 1', 1606 }, 1607 'expr::sassign::scalar_lex_intstr' => { 1608 desc => 'lexical $x = "abc" where $x was previously an int', 1609 setup => 'my $x = 1;', 1610 code => '$x = "abc"', 1611 }, 1612 'expr::sassign::lex_rv' => { 1613 desc => 'lexical $ref1 = $ref2;', 1614 setup => 'my $r1 = []; my $r = $r1;', 1615 code => '$r = $r1;', 1616 }, 1617 'expr::sassign::lex_rv1' => { 1618 desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', 1619 setup => 'my $r1 = []; my $r', 1620 code => '$r = []; $r = $r1;', 1621 }, 1622 1623 'expr::sassign::aelemfast_lex_assign' => { 1624 desc => 'lexical $x[0] = 1', 1625 setup => 'my @x', 1626 code => '$x[0] = 1', 1627 }, 1628 'expr::sassign::aelemfast_lex_assign_ref' => { 1629 desc => 'lexical $x[0] = []', 1630 setup => 'my @x', 1631 code => '$x[0] = []', 1632 }, 1633 'expr::sassign::aelemfast_lex_assign_deref' => { 1634 desc => 'lexical $x[0][1]', 1635 setup => 'my @x = ([1,2])', 1636 code => '$x[0][1] = 1', 1637 }, 1638 1639 'expr::sassign::bless_lex' => { 1640 setup => 'my $x', 1641 code => '$x = bless {}, "X"' 1642 }, 1643 1644 'func::grep::bool0' => { 1645 desc => 'grep returning 0 items in boolean context', 1646 setup => 'my @a;', 1647 code => '!grep $_, @a;', 1648 }, 1649 'func::grep::bool1' => { 1650 desc => 'grep returning 1 item in boolean context', 1651 setup => 'my @a =(1);', 1652 code => '!grep $_, @a;', 1653 }, 1654 'func::grep::scalar0' => { 1655 desc => 'returning 0 items in scalar context', 1656 setup => 'my $g; my @a;', 1657 code => '$g = grep $_, @a;', 1658 }, 1659 'func::grep::scalar1' => { 1660 desc => 'returning 1 item in scalar context', 1661 setup => 'my $g; my @a =(1);', 1662 code => '$g = grep $_, @a;', 1663 }, 1664 1665 # (index() == -1) and variants optimise away the op_const and op_eq 1666 # and any assignment to a lexical var 1667 'func::index::bool' => { 1668 desc => '(index() == -1) for match', 1669 setup => 'my $x = "aaaab"', 1670 code => 'index($x, "b") == -1', 1671 }, 1672 'func::index::bool_fail' => { 1673 desc => '(index() == -1) for no match', 1674 setup => 'my $x = "aaaab"', 1675 code => 'index($x, "c") == -1', 1676 }, 1677 'func::index::lex_bool' => { 1678 desc => '$lex = (index() == -1) for match', 1679 setup => 'my $r; my $x = "aaaab"', 1680 code => '$r = index($x, "b") == -1', 1681 }, 1682 'func::index::lex_bool_fail' => { 1683 desc => '$lex = (index() == -1) for no match', 1684 setup => 'my $r; my $x = "aaaab"', 1685 code => '$r = index($x, "c") == -1', 1686 }, 1687 1688 # using a const string as second arg to index triggers using FBM. 1689 # the FBM matcher special-cases 1,2-byte strings. 1690 # 1691 'func::index::short_const1' => { 1692 desc => 'index of a short string against a 1 char const substr', 1693 setup => 'my $x = "aaaab"', 1694 code => 'index $x, "b"', 1695 }, 1696 'func::index::long_const1' => { 1697 desc => 'index of a long string against a 1 char const substr', 1698 setup => 'my $x = "a" x 1000 . "b"', 1699 code => 'index $x, "b"', 1700 }, 1701 'func::index::short_const2aabc_bc' => { 1702 desc => 'index of a short string against a 2 char const substr', 1703 setup => 'my $x = "aaaabc"', 1704 code => 'index $x, "bc"', 1705 }, 1706 'func::index::long_const2aabc_bc' => { 1707 desc => 'index of a long string against a 2 char const substr', 1708 setup => 'my $x = "a" x 1000 . "bc"', 1709 code => 'index $x, "bc"', 1710 }, 1711 'func::index::long_const2aa_ab' => { 1712 desc => 'index of a long string aaa.. against const substr "ab"', 1713 setup => 'my $x = "a" x 1000', 1714 code => 'index $x, "ab"', 1715 }, 1716 'func::index::long_const2bb_ab' => { 1717 desc => 'index of a long string bbb.. against const substr "ab"', 1718 setup => 'my $x = "b" x 1000', 1719 code => 'index $x, "ab"', 1720 }, 1721 'func::index::long_const2aa_bb' => { 1722 desc => 'index of a long string aaa.. against const substr "bb"', 1723 setup => 'my $x = "a" x 1000', 1724 code => 'index $x, "bb"', 1725 }, 1726 # this one is designed to be pathological 1727 'func::index::long_const2ab_aa' => { 1728 desc => 'index of a long string abab.. against const substr "aa"', 1729 setup => 'my $x = "ab" x 500', 1730 code => 'index $x, "aa"', 1731 }, 1732 # near misses with gaps, 1st letter 1733 'func::index::long_const2aaxx_xy' => { 1734 desc => 'index of a long string with "xx"s against const substr "xy"', 1735 setup => 'my $x = "aaaaaaaaxx" x 100', 1736 code => 'index $x, "xy"', 1737 }, 1738 # near misses with gaps, 2nd letter 1739 'func::index::long_const2aayy_xy' => { 1740 desc => 'index of a long string with "yy"s against const substr "xy"', 1741 setup => 'my $x = "aaaaaaaayy" x 100', 1742 code => 'index $x, "xy"', 1743 }, 1744 # near misses with gaps, duplicate letter 1745 'func::index::long_const2aaxy_xx' => { 1746 desc => 'index of a long string with "xy"s against const substr "xx"', 1747 setup => 'my $x = "aaaaaaaaxy" x 100', 1748 code => 'index $x, "xx"', 1749 }, 1750 # alternating near misses with gaps 1751 'func::index::long_const2aaxxaayy_xy' => { 1752 desc => 'index of a long string with "xx/yy"s against const substr "xy"', 1753 setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', 1754 code => 'index $x, "xy"', 1755 }, 1756 'func::index::short_const3aabcd_bcd' => { 1757 desc => 'index of a short string against a 3 char const substr', 1758 setup => 'my $x = "aaaabcd"', 1759 code => 'index $x, "bcd"', 1760 }, 1761 'func::index::long_const3aabcd_bcd' => { 1762 desc => 'index of a long string against a 3 char const substr', 1763 setup => 'my $x = "a" x 1000 . "bcd"', 1764 code => 'index $x, "bcd"', 1765 }, 1766 'func::index::long_const3ab_abc' => { 1767 desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', 1768 setup => 'my $x = "ab" x 500', 1769 code => 'index $x, "abc"', 1770 }, 1771 'func::index::long_const3bc_abc' => { 1772 desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', 1773 setup => 'my $x = "bc" x 500', 1774 code => 'index $x, "abc"', 1775 }, 1776 'func::index::utf8_position_1' => { 1777 desc => 'index of a utf8 string, matching at position 1', 1778 setup => 'my $x = "abc". chr(0x100); chop $x', 1779 code => 'index $x, "b"', 1780 }, 1781 1782 1783 # JOIN 1784 1785 1786 'func::join::empty_l_ll' => { 1787 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1788 code => '$lex = join "", $lex1, $lex2', 1789 }, 1790 1791 1792 # KEYS 1793 1794 1795 'func::keys::lex::void_cxt_empty' => { 1796 desc => ' keys() on an empty lexical hash in void context', 1797 setup => 'my %h = ()', 1798 code => 'keys %h', 1799 }, 1800 'func::keys::lex::void_cxt' => { 1801 desc => ' keys() on a non-empty lexical hash in void context', 1802 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1803 code => 'keys %h', 1804 }, 1805 'func::keys::lex::bool_cxt_empty' => { 1806 desc => ' keys() on an empty lexical hash in bool context', 1807 setup => 'my %h = ()', 1808 code => '!keys %h', 1809 }, 1810 'func::keys::lex::bool_cxt' => { 1811 desc => ' keys() on a non-empty lexical hash in bool context', 1812 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1813 code => '!keys %h', 1814 }, 1815 'func::keys::lex::scalar_cxt_empty' => { 1816 desc => ' keys() on an empty lexical hash in scalar context', 1817 setup => 'my $k; my %h = ()', 1818 code => '$k = keys %h', 1819 }, 1820 'func::keys::lex::scalar_cxt' => { 1821 desc => ' keys() on a non-empty lexical hash in scalar context', 1822 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1823 code => '$k = keys %h', 1824 }, 1825 'func::keys::lex::list_cxt_empty' => { 1826 desc => ' keys() on an empty lexical hash in list context', 1827 setup => 'my %h = ()', 1828 code => '() = keys %h', 1829 }, 1830 'func::keys::lex::list_cxt' => { 1831 desc => ' keys() on a non-empty lexical hash in list context', 1832 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1833 code => '() = keys %h', 1834 }, 1835 1836 'func::keys::pkg::void_cxt_empty' => { 1837 desc => ' keys() on an empty package hash in void context', 1838 setup => 'our %h = ()', 1839 code => 'keys %h', 1840 }, 1841 'func::keys::pkg::void_cxt' => { 1842 desc => ' keys() on a non-empty package hash in void context', 1843 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1844 code => 'keys %h', 1845 }, 1846 'func::keys::pkg::bool_cxt_empty' => { 1847 desc => ' keys() on an empty package hash in bool context', 1848 setup => 'our %h = ()', 1849 code => '!keys %h', 1850 }, 1851 'func::keys::pkg::bool_cxt' => { 1852 desc => ' keys() on a non-empty package hash in bool context', 1853 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1854 code => '!keys %h', 1855 }, 1856 'func::keys::pkg::scalar_cxt_empty' => { 1857 desc => ' keys() on an empty package hash in scalar context', 1858 setup => 'my $k; our %h = ()', 1859 code => '$k = keys %h', 1860 }, 1861 'func::keys::pkg::scalar_cxt' => { 1862 desc => ' keys() on a non-empty package hash in scalar context', 1863 setup => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)', 1864 code => '$k = keys %h', 1865 }, 1866 'func::keys::pkg::list_cxt_empty' => { 1867 desc => ' keys() on an empty package hash in list context', 1868 setup => 'our %h = ()', 1869 code => '() = keys %h', 1870 }, 1871 'func::keys::pkg::list_cxt' => { 1872 desc => ' keys() on a non-empty package hash in list context', 1873 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1874 code => '() = keys %h', 1875 }, 1876 1877 1878 'func::length::bool0' => { 1879 desc => 'length==0 in boolean context', 1880 setup => 'my $s = "";', 1881 code => '!length($s);', 1882 }, 1883 'func::length::bool10' => { 1884 desc => 'length==10 in boolean context', 1885 setup => 'my $s = "abcdefghijk";', 1886 code => '!length($s);', 1887 }, 1888 'func::length::scalar10' => { 1889 desc => 'length==10 in scalar context', 1890 setup => 'my $p; my $s = "abcdefghijk";', 1891 code => '$p = length($s);', 1892 }, 1893 'func::length::bool0_utf8' => { 1894 desc => 'utf8 string length==0 in boolean context', 1895 setup => 'my $s = "\x{100}"; chop $s;', 1896 code => '!length($s);', 1897 }, 1898 'func::length::bool10_utf8' => { 1899 desc => 'utf8 string length==10 in boolean context', 1900 setup => 'my $s = "abcdefghij\x{100}";', 1901 code => '!length($s);', 1902 }, 1903 'func::length::scalar10_utf8' => { 1904 desc => 'utf8 string length==10 in scalar context', 1905 setup => 'my $p; my $s = "abcdefghij\x{100}";', 1906 code => '$p = length($s);', 1907 }, 1908 1909 'func::pos::bool0' => { 1910 desc => 'pos==0 in boolean context', 1911 setup => 'my $s = "abc"; pos($s) = 0', 1912 code => '!pos($s);', 1913 }, 1914 'func::pos::bool10' => { 1915 desc => 'pos==10 in boolean context', 1916 setup => 'my $s = "abcdefghijk"; pos($s) = 10', 1917 code => '!pos($s);', 1918 }, 1919 'func::pos::scalar10' => { 1920 desc => 'pos==10 in scalar context', 1921 setup => 'my $p; my $s = "abcdefghijk"; pos($s) = 10', 1922 code => '$p = pos($s);', 1923 }, 1924 1925 'func::ref::notaref_bool' => { 1926 desc => 'ref($notaref) in boolean context', 1927 setup => 'my $r = "boo"', 1928 code => '!ref $r', 1929 }, 1930 'func::ref::ref_bool' => { 1931 desc => 'ref($ref) in boolean context', 1932 setup => 'my $r = []', 1933 code => '!ref $r', 1934 }, 1935 'func::ref::blessedref_bool' => { 1936 desc => 'ref($blessed_ref) in boolean context', 1937 setup => 'my $r = bless []', 1938 code => '!ref $r', 1939 }, 1940 1941 'func::ref::notaref' => { 1942 desc => 'ref($notaref) in scalar context', 1943 setup => 'my $x; my $r = "boo"', 1944 code => '$x = ref $r', 1945 }, 1946 'func::ref::ref' => { 1947 desc => 'ref($ref) in scalar context', 1948 setup => 'my $x; my $r = []', 1949 code => '$x = ref $r', 1950 }, 1951 'func::ref::blessedref' => { 1952 desc => 'ref($blessed_ref) in scalar context', 1953 setup => 'my $x; my $r = bless []', 1954 code => '$x = ref $r', 1955 }, 1956 1957 1958 1959 'func::sort::num' => { 1960 desc => 'plain numeric sort', 1961 setup => 'my (@a, @b); @a = reverse 1..10;', 1962 code => '@b = sort { $a <=> $b } @a', 1963 }, 1964 'func::sort::num_block' => { 1965 desc => 'codeblock numeric sort', 1966 setup => 'my (@a, @b); @a = reverse 1..10;', 1967 code => '@b = sort { $a + 1 <=> $b + 1 } @a', 1968 }, 1969 'func::sort::num_fn' => { 1970 desc => 'function numeric sort', 1971 setup => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;', 1972 code => '@b = sort f @a', 1973 }, 1974 'func::sort::str' => { 1975 desc => 'plain string sort', 1976 setup => 'my (@a, @b); @a = reverse "a".."j";', 1977 code => '@b = sort { $a cmp $b } @a', 1978 }, 1979 'func::sort::str_block' => { 1980 desc => 'codeblock string sort', 1981 setup => 'my (@a, @b); @a = reverse "a".."j";', 1982 code => '@b = sort { ($a . "") cmp ($b . "") } @a', 1983 }, 1984 'func::sort::str_fn' => { 1985 desc => 'function string sort', 1986 setup => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse "a".."j";', 1987 code => '@b = sort f @a', 1988 }, 1989 1990 'func::sort::num_inplace' => { 1991 desc => 'plain numeric sort in-place', 1992 setup => 'my @a = reverse 1..10;', 1993 code => '@a = sort { $a <=> $b } @a', 1994 }, 1995 'func::sort::num_block_inplace' => { 1996 desc => 'codeblock numeric sort in-place', 1997 setup => 'my @a = reverse 1..10;', 1998 code => '@a = sort { $a + 1 <=> $b + 1 } @a', 1999 }, 2000 'func::sort::num_fn_inplace' => { 2001 desc => 'function numeric sort in-place', 2002 setup => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;', 2003 code => '@a = sort f @a', 2004 }, 2005 'func::sort::str_inplace' => { 2006 desc => 'plain string sort in-place', 2007 setup => 'my @a = reverse "a".."j";', 2008 code => '@a = sort { $a cmp $b } @a', 2009 }, 2010 'func::sort::str_block_inplace' => { 2011 desc => 'codeblock string sort in-place', 2012 setup => 'my @a = reverse "a".."j";', 2013 code => '@a = sort { ($a . "") cmp ($b . "") } @a', 2014 }, 2015 'func::sort::str_fn_inplace' => { 2016 desc => 'function string sort in-place', 2017 setup => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse "a".."j";', 2018 code => '@a = sort f @a', 2019 }, 2020 2021 2022 'func::split::vars' => { 2023 desc => 'split into two lexical vars', 2024 setup => 'my $s = "abc:def";', 2025 code => 'my ($x, $y) = split /:/, $s, 2;', 2026 }, 2027 2028 'func::split::array' => { 2029 desc => 'split into a lexical array', 2030 setup => 'my @a; my $s = "abc:def";', 2031 code => '@a = split /:/, $s, 2;', 2032 }, 2033 'func::split::myarray' => { 2034 desc => 'split into a lexical array declared in the assign', 2035 setup => 'my $s = "abc:def";', 2036 code => 'my @a = split /:/, $s, 2;', 2037 }, 2038 'func::split::arrayexpr' => { 2039 desc => 'split into an @{$expr} ', 2040 setup => 'my $s = "abc:def"; my $r = []', 2041 code => '@$r = split /:/, $s, 2;', 2042 }, 2043 'func::split::arraylist' => { 2044 desc => 'split into an array with extra arg', 2045 setup => 'my @a; my $s = "abc:def";', 2046 code => '@a = (split(/:/, $s, 2), 1);', 2047 }, 2048 2049 # SPRINTF 2050 2051 2052 'func::sprintf::d' => { 2053 desc => '%d', 2054 setup => 'my $s; my $a1 = 1234;', 2055 code => '$s = sprintf "%d", $a1', 2056 }, 2057 'func::sprintf::d8' => { 2058 desc => '%8d', 2059 setup => 'my $s; my $a1 = 1234;', 2060 code => '$s = sprintf "%8d", $a1', 2061 }, 2062 'func::sprintf::foo_d8' => { 2063 desc => 'foo=%8d', 2064 setup => 'my $s; my $a1 = 1234;', 2065 code => '$s = sprintf "foo=%8d", $a1', 2066 }, 2067 2068 'func::sprintf::f0' => { 2069 # "%.0f" is very special-cased 2070 desc => 'sprintf "%.0f"', 2071 setup => 'my $s; my $a1 = 123.456;', 2072 code => '$s = sprintf "%.0f", $a1', 2073 }, 2074 'func::sprintf::foo_f0' => { 2075 # "...%.0f..." is special-cased 2076 desc => 'sprintf "foo=%.0f"', 2077 setup => 'my $s; my $a1 = 123.456;', 2078 code => '$s = sprintf "foo=%.0f\n", $a1', 2079 }, 2080 'func::sprintf::foo_f93' => { 2081 desc => 'foo=%9.3f', 2082 setup => 'my $s; my $a1 = 123.456;', 2083 code => '$s = sprintf "foo=%9.3f\n", $a1', 2084 }, 2085 2086 'func::sprintf::g9' => { 2087 # "...%.NNNg..." is special-cased 2088 desc => '%.9g', 2089 setup => 'my $s; my $a1 = 123.456;', 2090 code => '$s = sprintf "%.9g", $a1', 2091 }, 2092 'func::sprintf::foo_g9' => { 2093 # "...%.NNNg..." is special-cased 2094 desc => 'foo=%.9g', 2095 setup => 'my $s; my $a1 = 123.456;', 2096 code => '$s = sprintf "foo=%.9g\n", $a1', 2097 }, 2098 'func::sprintf::foo_g93' => { 2099 desc => 'foo=%9.3g', 2100 setup => 'my $s; my $a1 = 123.456;', 2101 code => '$s = sprintf "foo=%9.3g\n", $a1', 2102 }, 2103 2104 'func::sprintf::s' => { 2105 desc => '%s', 2106 setup => 'my $s; my $a1 = "abcd";', 2107 code => '$s = sprintf "%s", $a1', 2108 }, 2109 'func::sprintf::foo_s' => { 2110 desc => 'foo=%s', 2111 setup => 'my $s; my $a1 = "abcd";', 2112 code => '$s = sprintf "foo=%s", $a1', 2113 }, 2114 'func::sprintf::mixed_utf8_sss' => { 2115 desc => 'foo=%s bar=%s baz=%s', 2116 setup => 'my $s;my $a = "ab\x{100}cd"; my $b = "efg"; my $c = "h\x{101}ij"', 2117 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 2118 }, 2119 2120 # sprint that's likely to be optimised to an OP_MULTICONCAT 2121 2122 'func::sprintf::l' => { 2123 setup => 'my $lex1 = "abcd"', 2124 code => 'sprintf "%s", $lex1', 2125 }, 2126 'func::sprintf::g_l' => { 2127 setup => 'our $pkg; my $lex1 = "abcd"', 2128 code => '$pkg = sprintf "%s", $lex1', 2129 }, 2130 'func::sprintf::g_append_l' => { 2131 setup => 'our $pkg; my $lex1 = "abcd"', 2132 pre => '$pkg = "pqrs"', 2133 code => '$pkg .= sprintf "%s", $lex1', 2134 }, 2135 'func::sprintf::g_ll' => { 2136 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2137 code => '$pkg = sprintf "%s%s", $lex1, $lex2', 2138 }, 2139 'func::sprintf::g_append_ll' => { 2140 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2141 pre => '$pkg = "pqrs"', 2142 code => '$pkg .= sprintf "%s%s", $lex1, $lex2', 2143 }, 2144 'func::sprintf::g_cl' => { 2145 setup => 'our $pkg; my $lex1 = "abcd"', 2146 code => '$pkg = sprintf "foo=%s", $lex1', 2147 }, 2148 'func::sprintf::g_clclc' => { 2149 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2150 code => '$pkg = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 2151 }, 2152 2153 'func::sprintf::l_l' => { 2154 setup => 'my $lex; my $lex1 = "abcd"', 2155 code => '$lex = sprintf "%s", $lex1', 2156 }, 2157 'func::sprintf::l_append_l' => { 2158 setup => 'my $lex; my $lex1 = "abcd"', 2159 pre => '$lex = "pqrs"', 2160 code => '$lex .= sprintf "%s", $lex1', 2161 }, 2162 'func::sprintf::ll' => { 2163 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 2164 code => 'sprintf "%s%s", $lex1, $lex2', 2165 }, 2166 'func::sprintf::l_ll' => { 2167 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2168 code => '$lex = sprintf "%s%s", $lex1, $lex2', 2169 }, 2170 'func::sprintf::l_append_ll' => { 2171 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2172 pre => '$lex = "pqrs"', 2173 code => '$lex .= sprintf "%s%s", $lex1, $lex2', 2174 }, 2175 'func::sprintf::l_cl' => { 2176 setup => 'my $lex; my $lex1 = "abcd"', 2177 code => '$lex = sprintf "foo=%s", $lex1', 2178 }, 2179 'func::sprintf::l_clclc' => { 2180 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 2181 code => '$lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 2182 }, 2183 2184 'func::sprintf::m_l' => { 2185 setup => 'my $lex1 = "abcd"', 2186 code => 'my $lex = sprintf "%s", $lex1', 2187 }, 2188 'func::sprintf::m_ll' => { 2189 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 2190 code => 'my $lex = sprintf "%s%s", $lex1, $lex2', 2191 }, 2192 'func::sprintf::m_cl' => { 2193 setup => 'my $lex1 = "abcd"', 2194 code => 'my $lex = sprintf "foo=%s", $lex1', 2195 }, 2196 'func::sprintf::m_clclc' => { 2197 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 2198 code => 'my $lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 2199 }, 2200 2201 'func::sprintf::utf8__l_lll' => { 2202 desc => '$s = sprintf("foo=%s bar=%s baz=%s", $a, $b, $c) where $a,$c are utf8', 2203 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 2204 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 2205 }, 2206 2207 2208 # S/// 2209 2210 'func::subst::bool' => { 2211 desc => 's/// in boolean context', 2212 setup => '', 2213 code => '$_ = "aaa"; !s/./x/g;' 2214 }, 2215 2216 2217 'func::values::scalar_cxt_empty' => { 2218 desc => ' values() on an empty hash in scalar context', 2219 setup => 'my $k; my %h = ()', 2220 code => '$k = values %h', 2221 }, 2222 'func::values::scalar_cxt' => { 2223 desc => ' values() on a non-empty hash in scalar context', 2224 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 2225 code => '$k = values %h', 2226 }, 2227 'func::values::list_cxt_empty' => { 2228 desc => ' values() on an empty hash in list context', 2229 setup => 'my %h = ()', 2230 code => '() = values %h', 2231 }, 2232 'func::values::list_cxt' => { 2233 desc => ' values() on a non-empty hash in list context', 2234 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 2235 code => '() = values %h', 2236 }, 2237 2238 2239 2240 'loop::block' => { 2241 desc => 'empty basic loop', 2242 setup => '', 2243 code => '{1;}', 2244 }, 2245 2246 'loop::do' => { 2247 desc => 'basic do block', 2248 setup => 'my $x; my $y = 2;', 2249 code => '$x = do {1; $y}', # the ';' stops the do being optimised 2250 }, 2251 2252 'loop::for::my_range1' => { 2253 desc => 'empty for loop with my var and 1 integer range', 2254 setup => '', 2255 code => 'for my $x (1..1) {}', 2256 }, 2257 'loop::for::lex_range1' => { 2258 desc => 'empty for loop with lexical var and 1 integer range', 2259 setup => 'my $x;', 2260 code => 'for $x (1..1) {}', 2261 }, 2262 'loop::for::pkg_range1' => { 2263 desc => 'empty for loop with package var and 1 integer range', 2264 setup => '$x = 1;', 2265 code => 'for $x (1..1) {}', 2266 }, 2267 'loop::for::defsv_range1' => { 2268 desc => 'empty for loop with $_ and integer 1 range', 2269 setup => ';', 2270 code => 'for (1..1) {}', 2271 }, 2272 'loop::for::my_range4' => { 2273 desc => 'empty for loop with my var and 4 integer range', 2274 setup => '', 2275 code => 'for my $x (1..4) {}', 2276 }, 2277 'loop::for::lex_range4' => { 2278 desc => 'empty for loop with lexical var and 4 integer range', 2279 setup => 'my $x;', 2280 code => 'for $x (1..4) {}', 2281 }, 2282 'loop::for::pkg_range4' => { 2283 desc => 'empty for loop with package var and 4 integer range', 2284 setup => '$x = 1;', 2285 code => 'for $x (1..4) {}', 2286 }, 2287 'loop::for::defsv_range4' => { 2288 desc => 'empty for loop with $_ and integer 4 range', 2289 setup => ';', 2290 code => 'for (1..4) {}', 2291 }, 2292 2293 'loop::for::my_list1' => { 2294 desc => 'empty for loop with my var and 1 integer list', 2295 setup => '', 2296 code => 'for my $x (1) {}', 2297 }, 2298 'loop::for::lex_list1' => { 2299 desc => 'empty for loop with lexical var and 1 integer list', 2300 setup => 'my $x;', 2301 code => 'for $x (1) {}', 2302 }, 2303 'loop::for::pkg_list1' => { 2304 desc => 'empty for loop with package var and 1 integer list', 2305 setup => '$x = 1;', 2306 code => 'for $x (1) {}', 2307 }, 2308 'loop::for::defsv_list1' => { 2309 desc => 'empty for loop with $_ and integer 1 list', 2310 setup => ';', 2311 code => 'for (1) {}', 2312 }, 2313 'loop::for::my_list4' => { 2314 desc => 'empty for loop with my var and 4 integer list', 2315 setup => '', 2316 code => 'for my $x (1,2,3,4) {}', 2317 }, 2318 'loop::for::lex_list4' => { 2319 desc => 'empty for loop with lexical var and 4 integer list', 2320 setup => 'my $x;', 2321 code => 'for $x (1,2,3,4) {}', 2322 }, 2323 'loop::for::pkg_list4' => { 2324 desc => 'empty for loop with package var and 4 integer list', 2325 setup => '$x = 1;', 2326 code => 'for $x (1,2,3,4) {}', 2327 }, 2328 'loop::for::defsv_list4' => { 2329 desc => 'empty for loop with $_ and integer 4 list', 2330 setup => '', 2331 code => 'for (1,2,3,4) {}', 2332 }, 2333 2334 'loop::for::my_array1' => { 2335 desc => 'empty for loop with my var and 1 integer array', 2336 setup => 'my @a = (1);', 2337 code => 'for my $x (@a) {}', 2338 }, 2339 'loop::for::lex_array1' => { 2340 desc => 'empty for loop with lexical var and 1 integer array', 2341 setup => 'my $x; my @a = (1);', 2342 code => 'for $x (@a) {}', 2343 }, 2344 'loop::for::pkg_array1' => { 2345 desc => 'empty for loop with package var and 1 integer array', 2346 setup => '$x = 1; my @a = (1);', 2347 code => 'for $x (@a) {}', 2348 }, 2349 'loop::for::defsv_array1' => { 2350 desc => 'empty for loop with $_ and integer 1 array', 2351 setup => 'my @a = (@a);', 2352 code => 'for (1) {}', 2353 }, 2354 'loop::for::my_array4' => { 2355 desc => 'empty for loop with my var and 4 integer array', 2356 setup => 'my @a = (1..4);', 2357 code => 'for my $x (@a) {}', 2358 }, 2359 'loop::for::lex_array4' => { 2360 desc => 'empty for loop with lexical var and 4 integer array', 2361 setup => 'my $x; my @a = (1..4);', 2362 code => 'for $x (@a) {}', 2363 }, 2364 'loop::for::pkg_array4' => { 2365 desc => 'empty for loop with package var and 4 integer array', 2366 setup => '$x = 1; my @a = (1..4);', 2367 code => 'for $x (@a) {}', 2368 }, 2369 'loop::for::defsv_array4' => { 2370 desc => 'empty for loop with $_ and integer 4 array', 2371 setup => 'my @a = (1..4);', 2372 code => 'for (@a) {}', 2373 }, 2374 2375 'loop::for::next4' => { 2376 desc => 'for loop containing only next with my var and integer 4 array', 2377 setup => 'my @a = (1..4);', 2378 code => 'for my $x (@a) {next}', 2379 }, 2380 2381 'loop::grep::expr_3int' => { 2382 desc => 'grep $_ > 0, 1,2,3', 2383 setup => 'my @a', 2384 code => '@a = grep $_ > 0, 1,2,3', 2385 }, 2386 2387 'loop::grep::block_3int' => { 2388 desc => 'grep { 1; $_ > 0} 1,2,3', 2389 setup => 'my @a', 2390 code => '@a = grep { 1; $_ > 0} 1,2,3', 2391 }, 2392 2393 'loop::map::expr_3int' => { 2394 desc => 'map $_+1, 1,2,3', 2395 setup => 'my @a', 2396 code => '@a = map $_+1, 1,2,3', 2397 }, 2398 2399 'loop::map::block_3int' => { 2400 desc => 'map { 1; $_+1} 1,2,3', 2401 setup => 'my @a', 2402 code => '@a = map { 1; $_+1} 1,2,3', 2403 }, 2404 2405 'loop::while::i1' => { 2406 desc => 'empty while loop 1 iteration', 2407 setup => 'my $i = 0;', 2408 code => 'while (++$i % 2) {}', 2409 }, 2410 'loop::while::i4' => { 2411 desc => 'empty while loop 4 iterations', 2412 setup => 'my $i = 0;', 2413 code => 'while (++$i % 4) {}', 2414 }, 2415 2416 2417 'regex::anyof_plus::anchored' => { 2418 setup => '$_ = "a" x 100;', 2419 code => '/^[acgt]+/', 2420 }, 2421 'regex::anyof_plus::floating' => { 2422 desc => '/[acgt]+where match starts at position 0 for 100 chars/', 2423 setup => '$_ = "a" x 100;', 2424 code => '/[acgt]+/', 2425 }, 2426 'regex::anyof_plus::floating_away' => { 2427 desc => '/[acgt]+/ where match starts at position 100 for 100 chars', 2428 setup => '$_ = ("0" x 100) . ("a" x 100);', 2429 code => '/[acgt]+/', 2430 }, 2431 2432 'regex::whilem::min_captures_fail' => { 2433 desc => '/WHILEM with anon-greedy match and captures that fails', 2434 setup => '$_ = ("a" x 20)', 2435 code => '/^(?:(.)(.))*?[XY]/', 2436 }, 2437 'regex::whilem::max_captures_fail' => { 2438 desc => '/WHILEM with a greedy match and captures that fails', 2439 setup => '$_ = ("a" x 20)', 2440 code => '/^(?:(.)(.))*[XY]/', 2441 }, 2442]; 2443