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 # scalar assign, OP_SASSIGN 1352 1353 'expr::sassign::undef_lex' => { 1354 setup => 'my $x', 1355 code => '$x = undef', 1356 }, 1357 'expr::sassign::undef_lex_direc' => { 1358 setup => 'my $x', 1359 code => 'undef $x', 1360 }, 1361 'expr::sassign::undef_my_lex' => { 1362 setup => '', 1363 code => 'my $x = undef', 1364 }, 1365 'expr::sassign::undef_my_lex_direc' => { 1366 setup => '', 1367 code => 'undef my $x', 1368 }, 1369 1370 'expr::sassign::anonlist' => { 1371 setup => '', 1372 code => '$x = []' 1373 }, 1374 'expr::sassign::anonlist_lex' => { 1375 setup => 'my $x', 1376 code => '$x = []' 1377 }, 1378 'expr::sassign::my_anonlist_lex' => { 1379 setup => '', 1380 code => 'my $x = []' 1381 }, 1382 'expr::sassign::anonhash' => { 1383 setup => '', 1384 code => '$x = {}' 1385 }, 1386 'expr::sassign::anonhash_lex' => { 1387 setup => 'my $x', 1388 code => '$x = {}' 1389 }, 1390 'expr::sassign::my_anonhash_lex' => { 1391 setup => '', 1392 code => 'my $x = {}' 1393 }, 1394 1395 'expr::sassign::my_conststr' => { 1396 setup => '', 1397 code => 'my $x = "abc"', 1398 }, 1399 'expr::sassign::scalar_lex_int' => { 1400 desc => 'lexical $x = 1', 1401 setup => 'my $x', 1402 code => '$x = 1', 1403 }, 1404 'expr::sassign::scalar_lex_str' => { 1405 desc => 'lexical $x = "abc"', 1406 setup => 'my $x', 1407 code => '$x = "abc"', 1408 }, 1409 'expr::sassign::scalar_lex_strint' => { 1410 desc => 'lexical $x = 1 where $x was previously a string', 1411 setup => 'my $x = "abc"', 1412 code => '$x = 1', 1413 }, 1414 'expr::sassign::scalar_lex_intstr' => { 1415 desc => 'lexical $x = "abc" where $x was previously an int', 1416 setup => 'my $x = 1;', 1417 code => '$x = "abc"', 1418 }, 1419 'expr::sassign::lex_rv' => { 1420 desc => 'lexical $ref1 = $ref2;', 1421 setup => 'my $r1 = []; my $r = $r1;', 1422 code => '$r = $r1;', 1423 }, 1424 'expr::sassign::lex_rv1' => { 1425 desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', 1426 setup => 'my $r1 = []; my $r', 1427 code => '$r = []; $r = $r1;', 1428 }, 1429 1430 'expr::sassign::aelemfast_lex_assign' => { 1431 desc => 'lexical $x[0] = 1', 1432 setup => 'my @x', 1433 code => '$x[0] = 1', 1434 }, 1435 'expr::sassign::aelemfast_lex_assign_ref' => { 1436 desc => 'lexical $x[0] = []', 1437 setup => 'my @x', 1438 code => '$x[0] = []', 1439 }, 1440 'expr::sassign::aelemfast_lex_assign_deref' => { 1441 desc => 'lexical $x[0][1]', 1442 setup => 'my @x = ([1,2])', 1443 code => '$x[0][1] = 1', 1444 }, 1445 1446 'expr::sassign::bless_lex' => { 1447 setup => 'my $x', 1448 code => '$x = bless {}, "X"' 1449 }, 1450 1451 'func::grep::bool0' => { 1452 desc => 'grep returning 0 items in boolean context', 1453 setup => 'my @a;', 1454 code => '!grep $_, @a;', 1455 }, 1456 'func::grep::bool1' => { 1457 desc => 'grep returning 1 item in boolean context', 1458 setup => 'my @a =(1);', 1459 code => '!grep $_, @a;', 1460 }, 1461 'func::grep::scalar0' => { 1462 desc => 'returning 0 items in scalar context', 1463 setup => 'my $g; my @a;', 1464 code => '$g = grep $_, @a;', 1465 }, 1466 'func::grep::scalar1' => { 1467 desc => 'returning 1 item in scalar context', 1468 setup => 'my $g; my @a =(1);', 1469 code => '$g = grep $_, @a;', 1470 }, 1471 1472 # (index() == -1) and variants optimise away the op_const and op_eq 1473 # and any assignment to a lexical var 1474 'func::index::bool' => { 1475 desc => '(index() == -1) for match', 1476 setup => 'my $x = "aaaab"', 1477 code => 'index($x, "b") == -1', 1478 }, 1479 'func::index::bool_fail' => { 1480 desc => '(index() == -1) for no match', 1481 setup => 'my $x = "aaaab"', 1482 code => 'index($x, "c") == -1', 1483 }, 1484 'func::index::lex_bool' => { 1485 desc => '$lex = (index() == -1) for match', 1486 setup => 'my $r; my $x = "aaaab"', 1487 code => '$r = index($x, "b") == -1', 1488 }, 1489 'func::index::lex_bool_fail' => { 1490 desc => '$lex = (index() == -1) for no match', 1491 setup => 'my $r; my $x = "aaaab"', 1492 code => '$r = index($x, "c") == -1', 1493 }, 1494 1495 # using a const string as second arg to index triggers using FBM. 1496 # the FBM matcher special-cases 1,2-byte strings. 1497 # 1498 'func::index::short_const1' => { 1499 desc => 'index of a short string against a 1 char const substr', 1500 setup => 'my $x = "aaaab"', 1501 code => 'index $x, "b"', 1502 }, 1503 'func::index::long_const1' => { 1504 desc => 'index of a long string against a 1 char const substr', 1505 setup => 'my $x = "a" x 1000 . "b"', 1506 code => 'index $x, "b"', 1507 }, 1508 'func::index::short_const2aabc_bc' => { 1509 desc => 'index of a short string against a 2 char const substr', 1510 setup => 'my $x = "aaaabc"', 1511 code => 'index $x, "bc"', 1512 }, 1513 'func::index::long_const2aabc_bc' => { 1514 desc => 'index of a long string against a 2 char const substr', 1515 setup => 'my $x = "a" x 1000 . "bc"', 1516 code => 'index $x, "bc"', 1517 }, 1518 'func::index::long_const2aa_ab' => { 1519 desc => 'index of a long string aaa.. against const substr "ab"', 1520 setup => 'my $x = "a" x 1000', 1521 code => 'index $x, "ab"', 1522 }, 1523 'func::index::long_const2bb_ab' => { 1524 desc => 'index of a long string bbb.. against const substr "ab"', 1525 setup => 'my $x = "b" x 1000', 1526 code => 'index $x, "ab"', 1527 }, 1528 'func::index::long_const2aa_bb' => { 1529 desc => 'index of a long string aaa.. against const substr "bb"', 1530 setup => 'my $x = "a" x 1000', 1531 code => 'index $x, "bb"', 1532 }, 1533 # this one is designed to be pathological 1534 'func::index::long_const2ab_aa' => { 1535 desc => 'index of a long string abab.. against const substr "aa"', 1536 setup => 'my $x = "ab" x 500', 1537 code => 'index $x, "aa"', 1538 }, 1539 # near misses with gaps, 1st letter 1540 'func::index::long_const2aaxx_xy' => { 1541 desc => 'index of a long string with "xx"s against const substr "xy"', 1542 setup => 'my $x = "aaaaaaaaxx" x 100', 1543 code => 'index $x, "xy"', 1544 }, 1545 # near misses with gaps, 2nd letter 1546 'func::index::long_const2aayy_xy' => { 1547 desc => 'index of a long string with "yy"s against const substr "xy"', 1548 setup => 'my $x = "aaaaaaaayy" x 100', 1549 code => 'index $x, "xy"', 1550 }, 1551 # near misses with gaps, duplicate letter 1552 'func::index::long_const2aaxy_xx' => { 1553 desc => 'index of a long string with "xy"s against const substr "xx"', 1554 setup => 'my $x = "aaaaaaaaxy" x 100', 1555 code => 'index $x, "xx"', 1556 }, 1557 # alternating near misses with gaps 1558 'func::index::long_const2aaxxaayy_xy' => { 1559 desc => 'index of a long string with "xx/yy"s against const substr "xy"', 1560 setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', 1561 code => 'index $x, "xy"', 1562 }, 1563 'func::index::short_const3aabcd_bcd' => { 1564 desc => 'index of a short string against a 3 char const substr', 1565 setup => 'my $x = "aaaabcd"', 1566 code => 'index $x, "bcd"', 1567 }, 1568 'func::index::long_const3aabcd_bcd' => { 1569 desc => 'index of a long string against a 3 char const substr', 1570 setup => 'my $x = "a" x 1000 . "bcd"', 1571 code => 'index $x, "bcd"', 1572 }, 1573 'func::index::long_const3ab_abc' => { 1574 desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', 1575 setup => 'my $x = "ab" x 500', 1576 code => 'index $x, "abc"', 1577 }, 1578 'func::index::long_const3bc_abc' => { 1579 desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', 1580 setup => 'my $x = "bc" x 500', 1581 code => 'index $x, "abc"', 1582 }, 1583 'func::index::utf8_position_1' => { 1584 desc => 'index of a utf8 string, matching at position 1', 1585 setup => 'my $x = "abc". chr(0x100); chop $x', 1586 code => 'index $x, "b"', 1587 }, 1588 1589 1590 # JOIN 1591 1592 1593 'func::join::empty_l_ll' => { 1594 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1595 code => '$lex = join "", $lex1, $lex2', 1596 }, 1597 1598 1599 # KEYS 1600 1601 1602 'func::keys::lex::void_cxt_empty' => { 1603 desc => ' keys() on an empty lexical hash in void context', 1604 setup => 'my %h = ()', 1605 code => 'keys %h', 1606 }, 1607 'func::keys::lex::void_cxt' => { 1608 desc => ' keys() on a non-empty lexical hash in void context', 1609 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1610 code => 'keys %h', 1611 }, 1612 'func::keys::lex::bool_cxt_empty' => { 1613 desc => ' keys() on an empty lexical hash in bool context', 1614 setup => 'my %h = ()', 1615 code => '!keys %h', 1616 }, 1617 'func::keys::lex::bool_cxt' => { 1618 desc => ' keys() on a non-empty lexical hash in bool context', 1619 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1620 code => '!keys %h', 1621 }, 1622 'func::keys::lex::scalar_cxt_empty' => { 1623 desc => ' keys() on an empty lexical hash in scalar context', 1624 setup => 'my $k; my %h = ()', 1625 code => '$k = keys %h', 1626 }, 1627 'func::keys::lex::scalar_cxt' => { 1628 desc => ' keys() on a non-empty lexical hash in scalar context', 1629 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1630 code => '$k = keys %h', 1631 }, 1632 'func::keys::lex::list_cxt_empty' => { 1633 desc => ' keys() on an empty lexical hash in list context', 1634 setup => 'my %h = ()', 1635 code => '() = keys %h', 1636 }, 1637 'func::keys::lex::list_cxt' => { 1638 desc => ' keys() on a non-empty lexical hash in list context', 1639 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1640 code => '() = keys %h', 1641 }, 1642 1643 'func::keys::pkg::void_cxt_empty' => { 1644 desc => ' keys() on an empty package hash in void context', 1645 setup => 'our %h = ()', 1646 code => 'keys %h', 1647 }, 1648 'func::keys::pkg::void_cxt' => { 1649 desc => ' keys() on a non-empty package hash in void context', 1650 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1651 code => 'keys %h', 1652 }, 1653 'func::keys::pkg::bool_cxt_empty' => { 1654 desc => ' keys() on an empty package hash in bool context', 1655 setup => 'our %h = ()', 1656 code => '!keys %h', 1657 }, 1658 'func::keys::pkg::bool_cxt' => { 1659 desc => ' keys() on a non-empty package hash in bool context', 1660 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1661 code => '!keys %h', 1662 }, 1663 'func::keys::pkg::scalar_cxt_empty' => { 1664 desc => ' keys() on an empty package hash in scalar context', 1665 setup => 'my $k; our %h = ()', 1666 code => '$k = keys %h', 1667 }, 1668 'func::keys::pkg::scalar_cxt' => { 1669 desc => ' keys() on a non-empty package hash in scalar context', 1670 setup => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)', 1671 code => '$k = keys %h', 1672 }, 1673 'func::keys::pkg::list_cxt_empty' => { 1674 desc => ' keys() on an empty package hash in list context', 1675 setup => 'our %h = ()', 1676 code => '() = keys %h', 1677 }, 1678 'func::keys::pkg::list_cxt' => { 1679 desc => ' keys() on a non-empty package hash in list context', 1680 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1681 code => '() = keys %h', 1682 }, 1683 1684 1685 'func::length::bool0' => { 1686 desc => 'length==0 in boolean context', 1687 setup => 'my $s = "";', 1688 code => '!length($s);', 1689 }, 1690 'func::length::bool10' => { 1691 desc => 'length==10 in boolean context', 1692 setup => 'my $s = "abcdefghijk";', 1693 code => '!length($s);', 1694 }, 1695 'func::length::scalar10' => { 1696 desc => 'length==10 in scalar context', 1697 setup => 'my $p; my $s = "abcdefghijk";', 1698 code => '$p = length($s);', 1699 }, 1700 'func::length::bool0_utf8' => { 1701 desc => 'utf8 string length==0 in boolean context', 1702 setup => 'my $s = "\x{100}"; chop $s;', 1703 code => '!length($s);', 1704 }, 1705 'func::length::bool10_utf8' => { 1706 desc => 'utf8 string length==10 in boolean context', 1707 setup => 'my $s = "abcdefghij\x{100}";', 1708 code => '!length($s);', 1709 }, 1710 'func::length::scalar10_utf8' => { 1711 desc => 'utf8 string length==10 in scalar context', 1712 setup => 'my $p; my $s = "abcdefghij\x{100}";', 1713 code => '$p = length($s);', 1714 }, 1715 1716 'func::pos::bool0' => { 1717 desc => 'pos==0 in boolean context', 1718 setup => 'my $s = "abc"; pos($s) = 0', 1719 code => '!pos($s);', 1720 }, 1721 'func::pos::bool10' => { 1722 desc => 'pos==10 in boolean context', 1723 setup => 'my $s = "abcdefghijk"; pos($s) = 10', 1724 code => '!pos($s);', 1725 }, 1726 'func::pos::scalar10' => { 1727 desc => 'pos==10 in scalar context', 1728 setup => 'my $p; my $s = "abcdefghijk"; pos($s) = 10', 1729 code => '$p = pos($s);', 1730 }, 1731 1732 'func::ref::notaref_bool' => { 1733 desc => 'ref($notaref) in boolean context', 1734 setup => 'my $r = "boo"', 1735 code => '!ref $r', 1736 }, 1737 'func::ref::ref_bool' => { 1738 desc => 'ref($ref) in boolean context', 1739 setup => 'my $r = []', 1740 code => '!ref $r', 1741 }, 1742 'func::ref::blessedref_bool' => { 1743 desc => 'ref($blessed_ref) in boolean context', 1744 setup => 'my $r = bless []', 1745 code => '!ref $r', 1746 }, 1747 1748 'func::ref::notaref' => { 1749 desc => 'ref($notaref) in scalar context', 1750 setup => 'my $x; my $r = "boo"', 1751 code => '$x = ref $r', 1752 }, 1753 'func::ref::ref' => { 1754 desc => 'ref($ref) in scalar context', 1755 setup => 'my $x; my $r = []', 1756 code => '$x = ref $r', 1757 }, 1758 'func::ref::blessedref' => { 1759 desc => 'ref($blessed_ref) in scalar context', 1760 setup => 'my $x; my $r = bless []', 1761 code => '$x = ref $r', 1762 }, 1763 1764 1765 1766 'func::sort::num' => { 1767 desc => 'plain numeric sort', 1768 setup => 'my (@a, @b); @a = reverse 1..10;', 1769 code => '@b = sort { $a <=> $b } @a', 1770 }, 1771 'func::sort::num_block' => { 1772 desc => 'codeblock numeric sort', 1773 setup => 'my (@a, @b); @a = reverse 1..10;', 1774 code => '@b = sort { $a + 1 <=> $b + 1 } @a', 1775 }, 1776 'func::sort::num_fn' => { 1777 desc => 'function numeric sort', 1778 setup => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;', 1779 code => '@b = sort f @a', 1780 }, 1781 'func::sort::str' => { 1782 desc => 'plain string sort', 1783 setup => 'my (@a, @b); @a = reverse "a".."j";', 1784 code => '@b = sort { $a cmp $b } @a', 1785 }, 1786 'func::sort::str_block' => { 1787 desc => 'codeblock string sort', 1788 setup => 'my (@a, @b); @a = reverse "a".."j";', 1789 code => '@b = sort { ($a . "") cmp ($b . "") } @a', 1790 }, 1791 'func::sort::str_fn' => { 1792 desc => 'function string sort', 1793 setup => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse "a".."j";', 1794 code => '@b = sort f @a', 1795 }, 1796 1797 'func::sort::num_inplace' => { 1798 desc => 'plain numeric sort in-place', 1799 setup => 'my @a = reverse 1..10;', 1800 code => '@a = sort { $a <=> $b } @a', 1801 }, 1802 'func::sort::num_block_inplace' => { 1803 desc => 'codeblock numeric sort in-place', 1804 setup => 'my @a = reverse 1..10;', 1805 code => '@a = sort { $a + 1 <=> $b + 1 } @a', 1806 }, 1807 'func::sort::num_fn_inplace' => { 1808 desc => 'function numeric sort in-place', 1809 setup => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;', 1810 code => '@a = sort f @a', 1811 }, 1812 'func::sort::str_inplace' => { 1813 desc => 'plain string sort in-place', 1814 setup => 'my @a = reverse "a".."j";', 1815 code => '@a = sort { $a cmp $b } @a', 1816 }, 1817 'func::sort::str_block_inplace' => { 1818 desc => 'codeblock string sort in-place', 1819 setup => 'my @a = reverse "a".."j";', 1820 code => '@a = sort { ($a . "") cmp ($b . "") } @a', 1821 }, 1822 'func::sort::str_fn_inplace' => { 1823 desc => 'function string sort in-place', 1824 setup => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse "a".."j";', 1825 code => '@a = sort f @a', 1826 }, 1827 1828 1829 'func::split::vars' => { 1830 desc => 'split into two lexical vars', 1831 setup => 'my $s = "abc:def";', 1832 code => 'my ($x, $y) = split /:/, $s, 2;', 1833 }, 1834 1835 'func::split::array' => { 1836 desc => 'split into a lexical array', 1837 setup => 'my @a; my $s = "abc:def";', 1838 code => '@a = split /:/, $s, 2;', 1839 }, 1840 'func::split::myarray' => { 1841 desc => 'split into a lexical array declared in the assign', 1842 setup => 'my $s = "abc:def";', 1843 code => 'my @a = split /:/, $s, 2;', 1844 }, 1845 'func::split::arrayexpr' => { 1846 desc => 'split into an @{$expr} ', 1847 setup => 'my $s = "abc:def"; my $r = []', 1848 code => '@$r = split /:/, $s, 2;', 1849 }, 1850 'func::split::arraylist' => { 1851 desc => 'split into an array with extra arg', 1852 setup => 'my @a; my $s = "abc:def";', 1853 code => '@a = (split(/:/, $s, 2), 1);', 1854 }, 1855 1856 # SPRINTF 1857 1858 1859 'func::sprintf::d' => { 1860 desc => '%d', 1861 setup => 'my $s; my $a1 = 1234;', 1862 code => '$s = sprintf "%d", $a1', 1863 }, 1864 'func::sprintf::d8' => { 1865 desc => '%8d', 1866 setup => 'my $s; my $a1 = 1234;', 1867 code => '$s = sprintf "%8d", $a1', 1868 }, 1869 'func::sprintf::foo_d8' => { 1870 desc => 'foo=%8d', 1871 setup => 'my $s; my $a1 = 1234;', 1872 code => '$s = sprintf "foo=%8d", $a1', 1873 }, 1874 1875 'func::sprintf::f0' => { 1876 # "%.0f" is very special-cased 1877 desc => 'sprintf "%.0f"', 1878 setup => 'my $s; my $a1 = 123.456;', 1879 code => '$s = sprintf "%.0f", $a1', 1880 }, 1881 'func::sprintf::foo_f0' => { 1882 # "...%.0f..." is special-cased 1883 desc => 'sprintf "foo=%.0f"', 1884 setup => 'my $s; my $a1 = 123.456;', 1885 code => '$s = sprintf "foo=%.0f\n", $a1', 1886 }, 1887 'func::sprintf::foo_f93' => { 1888 desc => 'foo=%9.3f', 1889 setup => 'my $s; my $a1 = 123.456;', 1890 code => '$s = sprintf "foo=%9.3f\n", $a1', 1891 }, 1892 1893 'func::sprintf::g9' => { 1894 # "...%.NNNg..." is special-cased 1895 desc => '%.9g', 1896 setup => 'my $s; my $a1 = 123.456;', 1897 code => '$s = sprintf "%.9g", $a1', 1898 }, 1899 'func::sprintf::foo_g9' => { 1900 # "...%.NNNg..." is special-cased 1901 desc => 'foo=%.9g', 1902 setup => 'my $s; my $a1 = 123.456;', 1903 code => '$s = sprintf "foo=%.9g\n", $a1', 1904 }, 1905 'func::sprintf::foo_g93' => { 1906 desc => 'foo=%9.3g', 1907 setup => 'my $s; my $a1 = 123.456;', 1908 code => '$s = sprintf "foo=%9.3g\n", $a1', 1909 }, 1910 1911 'func::sprintf::s' => { 1912 desc => '%s', 1913 setup => 'my $s; my $a1 = "abcd";', 1914 code => '$s = sprintf "%s", $a1', 1915 }, 1916 'func::sprintf::foo_s' => { 1917 desc => 'foo=%s', 1918 setup => 'my $s; my $a1 = "abcd";', 1919 code => '$s = sprintf "foo=%s", $a1', 1920 }, 1921 'func::sprintf::mixed_utf8_sss' => { 1922 desc => 'foo=%s bar=%s baz=%s', 1923 setup => 'my $s;my $a = "ab\x{100}cd"; my $b = "efg"; my $c = "h\x{101}ij"', 1924 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 1925 }, 1926 1927 # sprint that's likely to be optimised to an OP_MULTICONCAT 1928 1929 'func::sprintf::l' => { 1930 setup => 'my $lex1 = "abcd"', 1931 code => 'sprintf "%s", $lex1', 1932 }, 1933 'func::sprintf::g_l' => { 1934 setup => 'our $pkg; my $lex1 = "abcd"', 1935 code => '$pkg = sprintf "%s", $lex1', 1936 }, 1937 'func::sprintf::g_append_l' => { 1938 setup => 'our $pkg; my $lex1 = "abcd"', 1939 pre => '$pkg = "pqrs"', 1940 code => '$pkg .= sprintf "%s", $lex1', 1941 }, 1942 'func::sprintf::g_ll' => { 1943 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1944 code => '$pkg = sprintf "%s%s", $lex1, $lex2', 1945 }, 1946 'func::sprintf::g_append_ll' => { 1947 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1948 pre => '$pkg = "pqrs"', 1949 code => '$pkg .= sprintf "%s%s", $lex1, $lex2', 1950 }, 1951 'func::sprintf::g_cl' => { 1952 setup => 'our $pkg; my $lex1 = "abcd"', 1953 code => '$pkg = sprintf "foo=%s", $lex1', 1954 }, 1955 'func::sprintf::g_clclc' => { 1956 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1957 code => '$pkg = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1958 }, 1959 1960 'func::sprintf::l_l' => { 1961 setup => 'my $lex; my $lex1 = "abcd"', 1962 code => '$lex = sprintf "%s", $lex1', 1963 }, 1964 'func::sprintf::l_append_l' => { 1965 setup => 'my $lex; my $lex1 = "abcd"', 1966 pre => '$lex = "pqrs"', 1967 code => '$lex .= sprintf "%s", $lex1', 1968 }, 1969 'func::sprintf::ll' => { 1970 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1971 code => 'sprintf "%s%s", $lex1, $lex2', 1972 }, 1973 'func::sprintf::l_ll' => { 1974 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1975 code => '$lex = sprintf "%s%s", $lex1, $lex2', 1976 }, 1977 'func::sprintf::l_append_ll' => { 1978 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1979 pre => '$lex = "pqrs"', 1980 code => '$lex .= sprintf "%s%s", $lex1, $lex2', 1981 }, 1982 'func::sprintf::l_cl' => { 1983 setup => 'my $lex; my $lex1 = "abcd"', 1984 code => '$lex = sprintf "foo=%s", $lex1', 1985 }, 1986 'func::sprintf::l_clclc' => { 1987 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1988 code => '$lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1989 }, 1990 1991 'func::sprintf::m_l' => { 1992 setup => 'my $lex1 = "abcd"', 1993 code => 'my $lex = sprintf "%s", $lex1', 1994 }, 1995 'func::sprintf::m_ll' => { 1996 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1997 code => 'my $lex = sprintf "%s%s", $lex1, $lex2', 1998 }, 1999 'func::sprintf::m_cl' => { 2000 setup => 'my $lex1 = "abcd"', 2001 code => 'my $lex = sprintf "foo=%s", $lex1', 2002 }, 2003 'func::sprintf::m_clclc' => { 2004 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 2005 code => 'my $lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 2006 }, 2007 2008 'func::sprintf::utf8__l_lll' => { 2009 desc => '$s = sprintf("foo=%s bar=%s baz=%s", $a, $b, $c) where $a,$c are utf8', 2010 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 2011 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 2012 }, 2013 2014 2015 # S/// 2016 2017 'func::subst::bool' => { 2018 desc => 's/// in boolean context', 2019 setup => '', 2020 code => '$_ = "aaa"; !s/./x/g;' 2021 }, 2022 2023 2024 'func::values::scalar_cxt_empty' => { 2025 desc => ' values() on an empty hash in scalar context', 2026 setup => 'my $k; my %h = ()', 2027 code => '$k = values %h', 2028 }, 2029 'func::values::scalar_cxt' => { 2030 desc => ' values() on a non-empty hash in scalar context', 2031 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 2032 code => '$k = values %h', 2033 }, 2034 'func::values::list_cxt_empty' => { 2035 desc => ' values() on an empty hash in list context', 2036 setup => 'my %h = ()', 2037 code => '() = values %h', 2038 }, 2039 'func::values::list_cxt' => { 2040 desc => ' values() on a non-empty hash in list context', 2041 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 2042 code => '() = values %h', 2043 }, 2044 2045 2046 2047 'loop::block' => { 2048 desc => 'empty basic loop', 2049 setup => '', 2050 code => '{1;}', 2051 }, 2052 2053 'loop::do' => { 2054 desc => 'basic do block', 2055 setup => 'my $x; my $y = 2;', 2056 code => '$x = do {1; $y}', # the ';' stops the do being optimised 2057 }, 2058 2059 'loop::for::my_range1' => { 2060 desc => 'empty for loop with my var and 1 integer range', 2061 setup => '', 2062 code => 'for my $x (1..1) {}', 2063 }, 2064 'loop::for::lex_range1' => { 2065 desc => 'empty for loop with lexical var and 1 integer range', 2066 setup => 'my $x;', 2067 code => 'for $x (1..1) {}', 2068 }, 2069 'loop::for::pkg_range1' => { 2070 desc => 'empty for loop with package var and 1 integer range', 2071 setup => '$x = 1;', 2072 code => 'for $x (1..1) {}', 2073 }, 2074 'loop::for::defsv_range1' => { 2075 desc => 'empty for loop with $_ and integer 1 range', 2076 setup => ';', 2077 code => 'for (1..1) {}', 2078 }, 2079 'loop::for::my_range4' => { 2080 desc => 'empty for loop with my var and 4 integer range', 2081 setup => '', 2082 code => 'for my $x (1..4) {}', 2083 }, 2084 'loop::for::lex_range4' => { 2085 desc => 'empty for loop with lexical var and 4 integer range', 2086 setup => 'my $x;', 2087 code => 'for $x (1..4) {}', 2088 }, 2089 'loop::for::pkg_range4' => { 2090 desc => 'empty for loop with package var and 4 integer range', 2091 setup => '$x = 1;', 2092 code => 'for $x (1..4) {}', 2093 }, 2094 'loop::for::defsv_range4' => { 2095 desc => 'empty for loop with $_ and integer 4 range', 2096 setup => ';', 2097 code => 'for (1..4) {}', 2098 }, 2099 2100 'loop::for::my_list1' => { 2101 desc => 'empty for loop with my var and 1 integer list', 2102 setup => '', 2103 code => 'for my $x (1) {}', 2104 }, 2105 'loop::for::lex_list1' => { 2106 desc => 'empty for loop with lexical var and 1 integer list', 2107 setup => 'my $x;', 2108 code => 'for $x (1) {}', 2109 }, 2110 'loop::for::pkg_list1' => { 2111 desc => 'empty for loop with package var and 1 integer list', 2112 setup => '$x = 1;', 2113 code => 'for $x (1) {}', 2114 }, 2115 'loop::for::defsv_list1' => { 2116 desc => 'empty for loop with $_ and integer 1 list', 2117 setup => ';', 2118 code => 'for (1) {}', 2119 }, 2120 'loop::for::my_list4' => { 2121 desc => 'empty for loop with my var and 4 integer list', 2122 setup => '', 2123 code => 'for my $x (1,2,3,4) {}', 2124 }, 2125 'loop::for::lex_list4' => { 2126 desc => 'empty for loop with lexical var and 4 integer list', 2127 setup => 'my $x;', 2128 code => 'for $x (1,2,3,4) {}', 2129 }, 2130 'loop::for::pkg_list4' => { 2131 desc => 'empty for loop with package var and 4 integer list', 2132 setup => '$x = 1;', 2133 code => 'for $x (1,2,3,4) {}', 2134 }, 2135 'loop::for::defsv_list4' => { 2136 desc => 'empty for loop with $_ and integer 4 list', 2137 setup => '', 2138 code => 'for (1,2,3,4) {}', 2139 }, 2140 2141 'loop::for::my_array1' => { 2142 desc => 'empty for loop with my var and 1 integer array', 2143 setup => 'my @a = (1);', 2144 code => 'for my $x (@a) {}', 2145 }, 2146 'loop::for::lex_array1' => { 2147 desc => 'empty for loop with lexical var and 1 integer array', 2148 setup => 'my $x; my @a = (1);', 2149 code => 'for $x (@a) {}', 2150 }, 2151 'loop::for::pkg_array1' => { 2152 desc => 'empty for loop with package var and 1 integer array', 2153 setup => '$x = 1; my @a = (1);', 2154 code => 'for $x (@a) {}', 2155 }, 2156 'loop::for::defsv_array1' => { 2157 desc => 'empty for loop with $_ and integer 1 array', 2158 setup => 'my @a = (@a);', 2159 code => 'for (1) {}', 2160 }, 2161 'loop::for::my_array4' => { 2162 desc => 'empty for loop with my var and 4 integer array', 2163 setup => 'my @a = (1..4);', 2164 code => 'for my $x (@a) {}', 2165 }, 2166 'loop::for::lex_array4' => { 2167 desc => 'empty for loop with lexical var and 4 integer array', 2168 setup => 'my $x; my @a = (1..4);', 2169 code => 'for $x (@a) {}', 2170 }, 2171 'loop::for::pkg_array4' => { 2172 desc => 'empty for loop with package var and 4 integer array', 2173 setup => '$x = 1; my @a = (1..4);', 2174 code => 'for $x (@a) {}', 2175 }, 2176 'loop::for::defsv_array4' => { 2177 desc => 'empty for loop with $_ and integer 4 array', 2178 setup => 'my @a = (1..4);', 2179 code => 'for (@a) {}', 2180 }, 2181 2182 'loop::for::next4' => { 2183 desc => 'for loop containing only next with my var and integer 4 array', 2184 setup => 'my @a = (1..4);', 2185 code => 'for my $x (@a) {next}', 2186 }, 2187 2188 'loop::grep::expr_3int' => { 2189 desc => 'grep $_ > 0, 1,2,3', 2190 setup => 'my @a', 2191 code => '@a = grep $_ > 0, 1,2,3', 2192 }, 2193 2194 'loop::grep::block_3int' => { 2195 desc => 'grep { 1; $_ > 0} 1,2,3', 2196 setup => 'my @a', 2197 code => '@a = grep { 1; $_ > 0} 1,2,3', 2198 }, 2199 2200 'loop::map::expr_3int' => { 2201 desc => 'map $_+1, 1,2,3', 2202 setup => 'my @a', 2203 code => '@a = map $_+1, 1,2,3', 2204 }, 2205 2206 'loop::map::block_3int' => { 2207 desc => 'map { 1; $_+1} 1,2,3', 2208 setup => 'my @a', 2209 code => '@a = map { 1; $_+1} 1,2,3', 2210 }, 2211 2212 'loop::while::i1' => { 2213 desc => 'empty while loop 1 iteration', 2214 setup => 'my $i = 0;', 2215 code => 'while (++$i % 2) {}', 2216 }, 2217 'loop::while::i4' => { 2218 desc => 'empty while loop 4 iterations', 2219 setup => 'my $i = 0;', 2220 code => 'while (++$i % 4) {}', 2221 }, 2222 2223 2224 'regex::anyof_plus::anchored' => { 2225 setup => '$_ = "a" x 100;', 2226 code => '/^[acgt]+/', 2227 }, 2228 'regex::anyof_plus::floating' => { 2229 desc => '/[acgt]+where match starts at position 0 for 100 chars/', 2230 setup => '$_ = "a" x 100;', 2231 code => '/[acgt]+/', 2232 }, 2233 'regex::anyof_plus::floating_away' => { 2234 desc => '/[acgt]+/ where match starts at position 100 for 100 chars', 2235 setup => '$_ = ("0" x 100) . ("a" x 100);', 2236 code => '/[acgt]+/', 2237 }, 2238 2239 'regex::whilem::min_captures_fail' => { 2240 desc => '/WHILEM with anon-greedy match and captures that fails', 2241 setup => '$_ = ("a" x 20)', 2242 code => '/^(?:(.)(.))*?[XY]/', 2243 }, 2244 'regex::whilem::max_captures_fail' => { 2245 desc => '/WHILEM with a greedy match and captures that fails', 2246 setup => '$_ = ("a" x 20)', 2247 code => '/^(?:(.)(.))*[XY]/', 2248 }, 2249]; 2250