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 ($x,$y,$z) = (1, 2.2, 3.3);', 956 code => '$z = $x + $y', 957 }, 958 'expr::arith::add_pkg_ni' => { 959 desc => 'add an int and an NV and assign to a package var', 960 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 961 code => '$z = $x + $y', 962 }, 963 'expr::arith::add_lex_ss' => { 964 desc => 'add two short strings and assign to a lexical var', 965 setup => 'my ($x,$y,$z) = ("1", "2", 1);', 966 code => '$z = $x + $y; $x = "1"; ', 967 }, 968 969 'expr::arith::add_lex_ll' => { 970 desc => 'add two long strings and assign to a lexical var', 971 setup => 'my ($x,$y,$z) = ("12345", "23456", 1);', 972 code => '$z = $x + $y; $x = "12345"; ', 973 }, 974 975 'expr::arith::sub_lex_ii' => { 976 desc => 'subtract two integers and assign to a lexical var', 977 setup => 'my ($x,$y,$z) = 1..3;', 978 code => '$z = $x - $y', 979 }, 980 'expr::arith::sub_pkg_ii' => { 981 desc => 'subtract two integers and assign to a package var', 982 setup => 'my ($x,$y) = 1..2; $z = 3;', 983 code => '$z = $x - $y', 984 }, 985 'expr::arith::sub_lex_nn' => { 986 desc => 'subtract two NVs and assign to a lexical var', 987 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 988 code => '$z = $x - $y', 989 }, 990 'expr::arith::sub_pkg_nn' => { 991 desc => 'subtract two NVs and assign to a package var', 992 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 993 code => '$z = $x - $y', 994 }, 995 'expr::arith::sub_lex_ni' => { 996 desc => 'subtract an int and an NV and assign to a lexical var', 997 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 998 code => '$z = $x - $y', 999 }, 1000 'expr::arith::sub_pkg_ni' => { 1001 desc => 'subtract an int and an NV and assign to a package var', 1002 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 1003 code => '$z = $x - $y', 1004 }, 1005 1006 'expr::arith::mult_lex_ii' => { 1007 desc => 'multiply two integers and assign to a lexical var', 1008 setup => 'my ($x,$y,$z) = 1..3;', 1009 code => '$z = $x * $y', 1010 }, 1011 'expr::arith::mult_pkg_ii' => { 1012 desc => 'multiply two integers and assign to a package var', 1013 setup => 'my ($x,$y) = 1..2; $z = 3;', 1014 code => '$z = $x * $y', 1015 }, 1016 'expr::arith::mult_lex_nn' => { 1017 desc => 'multiply two NVs and assign to a lexical var', 1018 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 1019 code => '$z = $x * $y', 1020 }, 1021 'expr::arith::mult_pkg_nn' => { 1022 desc => 'multiply two NVs and assign to a package var', 1023 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 1024 code => '$z = $x * $y', 1025 }, 1026 'expr::arith::mult_lex_ni' => { 1027 desc => 'multiply an int and an NV and assign to a lexical var', 1028 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 1029 code => '$z = $x * $y', 1030 }, 1031 'expr::arith::mult_pkg_ni' => { 1032 desc => 'multiply an int and an NV and assign to a package var', 1033 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 1034 code => '$z = $x * $y', 1035 }, 1036 1037 # use '!' to test SvTRUE on various classes of value 1038 1039 'expr::arith::not_PL_undef' => { 1040 desc => '!undef (using PL_sv_undef)', 1041 setup => 'my $x', 1042 code => '$x = !undef', 1043 }, 1044 'expr::arith::not_PL_no' => { 1045 desc => '!($x == $y) (using PL_sv_no)', 1046 setup => 'my ($x, $y) = (1,2); my $z;', 1047 code => '$z = !($x == $y)', 1048 }, 1049 'expr::arith::not_PL_zero' => { 1050 desc => '!%h (using PL_sv_zero)', 1051 setup => 'my ($x, %h)', 1052 code => '$x = !%h', 1053 }, 1054 'expr::arith::not_PL_yes' => { 1055 desc => '!($x == $y) (using PL_sv_yes)', 1056 setup => 'my ($x, $y) = (1,1); my $z;', 1057 code => '$z = !($x == $y)', 1058 }, 1059 'expr::arith::not_undef' => { 1060 desc => '!$y where $y is undef', 1061 setup => 'my ($x, $y)', 1062 code => '$x = !$y', 1063 }, 1064 'expr::arith::not_0' => { 1065 desc => '!$x where $x is 0', 1066 setup => 'my ($x, $y) = (0, 0)', 1067 code => '$y = !$x', 1068 }, 1069 'expr::arith::not_1' => { 1070 desc => '!$x where $x is 1', 1071 setup => 'my ($x, $y) = (1, 0)', 1072 code => '$y = !$x', 1073 }, 1074 'expr::arith::not_string' => { 1075 desc => '!$x where $x is "foo"', 1076 setup => 'my ($x, $y) = ("foo", 0)', 1077 code => '$y = !$x', 1078 }, 1079 'expr::arith::not_ref' => { 1080 desc => '!$x where $s is an array ref', 1081 setup => 'my ($x, $y) = ([], 0)', 1082 code => '$y = !$x', 1083 }, 1084 1085 'expr::arith::preinc' => { 1086 setup => 'my $x = 1;', 1087 code => '++$x', 1088 }, 1089 'expr::arith::predec' => { 1090 setup => 'my $x = 1;', 1091 code => '--$x', 1092 }, 1093 'expr::arith::postinc' => { 1094 desc => '$x++', 1095 setup => 'my $x = 1; my $y', 1096 code => '$y = $x++', # scalar context so not optimised to ++$x 1097 }, 1098 'expr::arith::postdec' => { 1099 desc => '$x--', 1100 setup => 'my $x = 1; my $y', 1101 code => '$y = $x--', # scalar context so not optimised to --$x 1102 }, 1103 1104 1105 # concatenation; quite possibly optimised to OP_MULTICONCAT 1106 1107 'expr::concat::cl' => { 1108 setup => 'my $lex = "abcd"', 1109 code => '"foo" . $lex', 1110 }, 1111 'expr::concat::lc' => { 1112 setup => 'my $lex = "abcd"', 1113 code => '$lex . "foo"', 1114 }, 1115 'expr::concat::ll' => { 1116 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1117 code => '$lex1 . $lex2', 1118 }, 1119 1120 'expr::concat::l_append_c' => { 1121 setup => 'my $lex', 1122 pre => '$lex = "abcd"', 1123 code => '$lex .= "foo"', 1124 }, 1125 'expr::concat::l_append_l' => { 1126 setup => 'my $lex1; my $lex2 = "wxyz"', 1127 pre => '$lex1 = "abcd"', 1128 code => '$lex1 .= $lex2', 1129 }, 1130 'expr::concat::l_append_ll' => { 1131 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1132 pre => '$lex1 = "abcd"', 1133 code => '$lex1 .= $lex2 . $lex3', 1134 }, 1135 'expr::concat::l_append_clclc' => { 1136 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1137 pre => '$lex1 = "abcd"', 1138 code => '$lex1 .= "-foo-$lex2-foo-$lex3-foo"', 1139 }, 1140 'expr::concat::l_append_lll' => { 1141 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(pqrs wxyz 1234)', 1142 pre => '$lex1 = "abcd"', 1143 code => '$lex1 .= $lex2 . $lex3 . $lex4', 1144 }, 1145 1146 'expr::concat::m_ll' => { 1147 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1148 code => 'my $lex = $lex1 . $lex2', 1149 }, 1150 'expr::concat::m_lll' => { 1151 setup => 'my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1152 code => 'my $lex = $lex1 . $lex2 . $lex3', 1153 }, 1154 'expr::concat::m_cl' => { 1155 setup => 'my $lex1 = "abcd"', 1156 code => 'my $lex = "const$lex1"', 1157 }, 1158 'expr::concat::m_clclc' => { 1159 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1160 code => 'my $lex = "foo=$lex1 bar=$lex2\n"', 1161 }, 1162 'expr::concat::m_clclc_long' => { 1163 desc => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1164 setup => 'my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1165 code => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1166 }, 1167 1168 'expr::concat::l_ll' => { 1169 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1170 code => '$lex = $lex1 . $lex2', 1171 }, 1172 'expr::concat::l_ll_ldup' => { 1173 setup => 'my $lex1; my $lex2 = "wxyz"', 1174 pre => '$lex1 = "abcd"', 1175 code => '$lex1 = $lex1 . $lex2', 1176 }, 1177 'expr::concat::l_ll_rdup' => { 1178 setup => 'my $lex1; my $lex2 = "wxyz"', 1179 pre => '$lex1 = "abcd"', 1180 code => '$lex1 = $lex2 . $lex1', 1181 }, 1182 'expr::concat::l_ll_lrdup' => { 1183 setup => 'my $lex1', 1184 pre => '$lex1 = "abcd"', 1185 code => '$lex1 = $lex1 . $lex1', 1186 }, 1187 'expr::concat::l_lll' => { 1188 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1189 code => '$lex = $lex1 . $lex2 . $lex3', 1190 }, 1191 'expr::concat::l_lllll' => { 1192 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..."', 1193 code => '$lex = $lex1 . $lex2 . $lex3 . $lex4 . $lex5', 1194 }, 1195 'expr::concat::l_cl' => { 1196 setup => 'my $lex; my $lex1 = "abcd"', 1197 code => '$lex = "const$lex1"', 1198 }, 1199 'expr::concat::l_clclc' => { 1200 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1201 code => '$lex = "foo=$lex1 bar=$lex2\n"', 1202 }, 1203 'expr::concat::l_clclc_long' => { 1204 desc => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1205 setup => 'my $lex; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1206 code => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1207 }, 1208 'expr::concat::l_clclclclclc' => { 1209 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "the quick brown fox"; my $lex4 = "to be, or not to be..."', 1210 code => '$lex = "foo1=$lex1 foo2=$lex2 foo3=$lex3 foo4=$lex4\n"', 1211 }, 1212 1213 'expr::concat::g_append_c' => { 1214 setup => 'our $pkg', 1215 pre => '$pkg = "abcd"', 1216 code => '$pkg .= "foo"', 1217 }, 1218 'expr::concat::g_append_l' => { 1219 setup => 'our $pkg; my $lex1 = "wxyz"', 1220 pre => '$pkg = "abcd"', 1221 code => '$pkg .= $lex1', 1222 }, 1223 'expr::concat::g_append_ll' => { 1224 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1225 pre => '$pkg = "abcd"', 1226 code => '$pkg .= $lex1 . $lex2', 1227 }, 1228 'expr::concat::g_append_clclc' => { 1229 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1230 pre => '$pkg = "abcd"', 1231 code => '$pkg .= "-foo-$lex1-foo-$lex2-foo-"', 1232 }, 1233 1234 'expr::concat::g_ll' => { 1235 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1236 code => '$pkg = $lex1 . $lex2', 1237 }, 1238 'expr::concat::g_gl_ldup' => { 1239 setup => 'our $pkg; my $lex2 = "wxyz"', 1240 pre => '$pkg = "abcd"', 1241 code => '$pkg = $pkg . $lex2', 1242 }, 1243 'expr::concat::g_lg_rdup' => { 1244 setup => 'our $pkg; my $lex1 = "wxyz"', 1245 pre => '$pkg = "abcd"', 1246 code => '$pkg = $lex1 . $pkg', 1247 }, 1248 'expr::concat::g_gg_lrdup' => { 1249 setup => 'our $pkg', 1250 pre => '$pkg = "abcd"', 1251 code => '$pkg = $pkg . $pkg', 1252 }, 1253 'expr::concat::g_lll' => { 1254 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1255 code => '$pkg = $lex1 . $lex2 . $lex3', 1256 }, 1257 'expr::concat::g_cl' => { 1258 setup => 'our $pkg; my $lex1 = "abcd"', 1259 code => '$pkg = "const$lex1"', 1260 }, 1261 'expr::concat::g_clclc' => { 1262 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1263 code => '$pkg = "foo=$lex1 bar=$lex2\n"', 1264 }, 1265 'expr::concat::g_clclc_long' => { 1266 desc => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1267 setup => 'our $pkg; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1268 code => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1269 }, 1270 1271 'expr::concat::utf8_uuu' => { 1272 desc => 'my $s = $a.$b.$c where all args are utf8', 1273 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1274 code => '$s = $a.$b.$c', 1275 }, 1276 'expr::concat::utf8_suu' => { 1277 desc => 'my $s = "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1278 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1279 code => '$s = "foo=$a bar=$b baz=$c"', 1280 }, 1281 'expr::concat::utf8_usu' => { 1282 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1283 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1284 code => '$s = "foo=$a bar=$b baz=$c"', 1285 }, 1286 'expr::concat::utf8_usx' => { 1287 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1288 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1289 code => '$s = "foo=$a bar=$b baz=$c"', 1290 }, 1291 1292 'expr::concat::utf8_s_append_uuu' => { 1293 desc => '$s .= $a.$b.$c where all RH args are utf8', 1294 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1295 pre => '$s = "abcd"', 1296 code => '$s .= $a.$b.$c', 1297 }, 1298 'expr::concat::utf8_s_append_suu' => { 1299 desc => '$s .= "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1300 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1301 pre => '$s = "abcd"', 1302 code => '$s .= "foo=$a bar=$b baz=$c"', 1303 }, 1304 'expr::concat::utf8_s_append_usu' => { 1305 desc => '$s .= "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1306 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1307 pre => '$s = "abcd"', 1308 code => '$s .= "foo=$a bar=$b baz=$c"', 1309 }, 1310 'expr::concat::utf8_s_append_usx' => { 1311 desc => '$s .= "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1312 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1313 pre => '$s = "abcd"', 1314 code => '$s .= "foo=$a bar=$b baz=$c"', 1315 }, 1316 1317 'expr::concat::utf8_u_append_uuu' => { 1318 desc => '$s .= $a.$b.$c where all args are utf8', 1319 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1320 pre => '$s = "\x{100}wxyz"', 1321 code => '$s .= $a.$b.$c', 1322 }, 1323 'expr::concat::utf8_u_append_suu' => { 1324 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$b,$c are utf8', 1325 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1326 pre => '$s = "\x{100}wxyz"', 1327 code => '$s .= "foo=$a bar=$b baz=$c"', 1328 }, 1329 'expr::concat::utf8_u_append_usu' => { 1330 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a,$c are utf8', 1331 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1332 pre => '$s = "\x{100}wxyz"', 1333 code => '$s .= "foo=$a bar=$b baz=$c"', 1334 }, 1335 'expr::concat::utf8_u_append_usx' => { 1336 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a are utf8, $c has 0x80', 1337 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1338 pre => '$s = "\x{100}wxyz"', 1339 code => '$s .= "foo=$a bar=$b baz=$c"', 1340 }, 1341 1342 'expr::concat::nested_mutator' => { 1343 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(abcd pqrs wxyz)', 1344 pre => '$lex1 = "QPR"', 1345 code => '(($lex1 .= $lex2) .= $lex3) .= $lex4', 1346 }, 1347 1348 1349 # scalar assign, OP_SASSIGN 1350 1351 1352 'expr::sassign::my_conststr' => { 1353 setup => '', 1354 code => 'my $x = "abc"', 1355 }, 1356 'expr::sassign::scalar_lex_int' => { 1357 desc => 'lexical $x = 1', 1358 setup => 'my $x', 1359 code => '$x = 1', 1360 }, 1361 'expr::sassign::scalar_lex_str' => { 1362 desc => 'lexical $x = "abc"', 1363 setup => 'my $x', 1364 code => '$x = "abc"', 1365 }, 1366 'expr::sassign::scalar_lex_strint' => { 1367 desc => 'lexical $x = 1 where $x was previously a string', 1368 setup => 'my $x = "abc"', 1369 code => '$x = 1', 1370 }, 1371 'expr::sassign::scalar_lex_intstr' => { 1372 desc => 'lexical $x = "abc" where $x was previously an int', 1373 setup => 'my $x = 1;', 1374 code => '$x = "abc"', 1375 }, 1376 'expr::sassign::lex_rv' => { 1377 desc => 'lexical $ref1 = $ref2;', 1378 setup => 'my $r1 = []; my $r = $r1;', 1379 code => '$r = $r1;', 1380 }, 1381 'expr::sassign::lex_rv1' => { 1382 desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', 1383 setup => 'my $r1 = []; my $r', 1384 code => '$r = []; $r = $r1;', 1385 }, 1386 1387 1388 'func::grep::bool0' => { 1389 desc => 'grep returning 0 items in boolean context', 1390 setup => 'my @a;', 1391 code => '!grep $_, @a;', 1392 }, 1393 'func::grep::bool1' => { 1394 desc => 'grep returning 1 item in boolean context', 1395 setup => 'my @a =(1);', 1396 code => '!grep $_, @a;', 1397 }, 1398 'func::grep::scalar0' => { 1399 desc => 'returning 0 items in scalar context', 1400 setup => 'my $g; my @a;', 1401 code => '$g = grep $_, @a;', 1402 }, 1403 'func::grep::scalar1' => { 1404 desc => 'returning 1 item in scalar context', 1405 setup => 'my $g; my @a =(1);', 1406 code => '$g = grep $_, @a;', 1407 }, 1408 1409 # (index() == -1) and variants optimise away the op_const and op_eq 1410 # and any assignment to a lexical var 1411 'func::index::bool' => { 1412 desc => '(index() == -1) for match', 1413 setup => 'my $x = "aaaab"', 1414 code => 'index($x, "b") == -1', 1415 }, 1416 'func::index::bool_fail' => { 1417 desc => '(index() == -1) for no match', 1418 setup => 'my $x = "aaaab"', 1419 code => 'index($x, "c") == -1', 1420 }, 1421 'func::index::lex_bool' => { 1422 desc => '$lex = (index() == -1) for match', 1423 setup => 'my $r; my $x = "aaaab"', 1424 code => '$r = index($x, "b") == -1', 1425 }, 1426 'func::index::lex_bool_fail' => { 1427 desc => '$lex = (index() == -1) for no match', 1428 setup => 'my $r; my $x = "aaaab"', 1429 code => '$r = index($x, "c") == -1', 1430 }, 1431 1432 # using a const string as second arg to index triggers using FBM. 1433 # the FBM matcher special-cases 1,2-byte strings. 1434 # 1435 'func::index::short_const1' => { 1436 desc => 'index of a short string against a 1 char const substr', 1437 setup => 'my $x = "aaaab"', 1438 code => 'index $x, "b"', 1439 }, 1440 'func::index::long_const1' => { 1441 desc => 'index of a long string against a 1 char const substr', 1442 setup => 'my $x = "a" x 1000 . "b"', 1443 code => 'index $x, "b"', 1444 }, 1445 'func::index::short_const2aabc_bc' => { 1446 desc => 'index of a short string against a 2 char const substr', 1447 setup => 'my $x = "aaaabc"', 1448 code => 'index $x, "bc"', 1449 }, 1450 'func::index::long_const2aabc_bc' => { 1451 desc => 'index of a long string against a 2 char const substr', 1452 setup => 'my $x = "a" x 1000 . "bc"', 1453 code => 'index $x, "bc"', 1454 }, 1455 'func::index::long_const2aa_ab' => { 1456 desc => 'index of a long string aaa.. against const substr "ab"', 1457 setup => 'my $x = "a" x 1000', 1458 code => 'index $x, "ab"', 1459 }, 1460 'func::index::long_const2bb_ab' => { 1461 desc => 'index of a long string bbb.. against const substr "ab"', 1462 setup => 'my $x = "b" x 1000', 1463 code => 'index $x, "ab"', 1464 }, 1465 'func::index::long_const2aa_bb' => { 1466 desc => 'index of a long string aaa.. against const substr "bb"', 1467 setup => 'my $x = "a" x 1000', 1468 code => 'index $x, "bb"', 1469 }, 1470 # this one is designed to be pathological 1471 'func::index::long_const2ab_aa' => { 1472 desc => 'index of a long string abab.. against const substr "aa"', 1473 setup => 'my $x = "ab" x 500', 1474 code => 'index $x, "aa"', 1475 }, 1476 # near misses with gaps, 1st letter 1477 'func::index::long_const2aaxx_xy' => { 1478 desc => 'index of a long string with "xx"s against const substr "xy"', 1479 setup => 'my $x = "aaaaaaaaxx" x 100', 1480 code => 'index $x, "xy"', 1481 }, 1482 # near misses with gaps, 2nd letter 1483 'func::index::long_const2aayy_xy' => { 1484 desc => 'index of a long string with "yy"s against const substr "xy"', 1485 setup => 'my $x = "aaaaaaaayy" x 100', 1486 code => 'index $x, "xy"', 1487 }, 1488 # near misses with gaps, duplicate letter 1489 'func::index::long_const2aaxy_xx' => { 1490 desc => 'index of a long string with "xy"s against const substr "xx"', 1491 setup => 'my $x = "aaaaaaaaxy" x 100', 1492 code => 'index $x, "xx"', 1493 }, 1494 # alternating near misses with gaps 1495 'func::index::long_const2aaxxaayy_xy' => { 1496 desc => 'index of a long string with "xx/yy"s against const substr "xy"', 1497 setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', 1498 code => 'index $x, "xy"', 1499 }, 1500 'func::index::short_const3aabcd_bcd' => { 1501 desc => 'index of a short string against a 3 char const substr', 1502 setup => 'my $x = "aaaabcd"', 1503 code => 'index $x, "bcd"', 1504 }, 1505 'func::index::long_const3aabcd_bcd' => { 1506 desc => 'index of a long string against a 3 char const substr', 1507 setup => 'my $x = "a" x 1000 . "bcd"', 1508 code => 'index $x, "bcd"', 1509 }, 1510 'func::index::long_const3ab_abc' => { 1511 desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', 1512 setup => 'my $x = "ab" x 500', 1513 code => 'index $x, "abc"', 1514 }, 1515 'func::index::long_const3bc_abc' => { 1516 desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', 1517 setup => 'my $x = "bc" x 500', 1518 code => 'index $x, "abc"', 1519 }, 1520 'func::index::utf8_position_1' => { 1521 desc => 'index of a utf8 string, matching at position 1', 1522 setup => 'my $x = "abc". chr(0x100); chop $x', 1523 code => 'index $x, "b"', 1524 }, 1525 1526 1527 # JOIN 1528 1529 1530 'func::join::empty_l_ll' => { 1531 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1532 code => '$lex = join "", $lex1, $lex2', 1533 }, 1534 1535 1536 # KEYS 1537 1538 1539 'func::keys::lex::void_cxt_empty' => { 1540 desc => ' keys() on an empty lexical hash in void context', 1541 setup => 'my %h = ()', 1542 code => 'keys %h', 1543 }, 1544 'func::keys::lex::void_cxt' => { 1545 desc => ' keys() on a non-empty lexical hash in void context', 1546 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1547 code => 'keys %h', 1548 }, 1549 'func::keys::lex::bool_cxt_empty' => { 1550 desc => ' keys() on an empty lexical hash in bool context', 1551 setup => 'my %h = ()', 1552 code => '!keys %h', 1553 }, 1554 'func::keys::lex::bool_cxt' => { 1555 desc => ' keys() on a non-empty lexical hash in bool context', 1556 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1557 code => '!keys %h', 1558 }, 1559 'func::keys::lex::scalar_cxt_empty' => { 1560 desc => ' keys() on an empty lexical hash in scalar context', 1561 setup => 'my $k; my %h = ()', 1562 code => '$k = keys %h', 1563 }, 1564 'func::keys::lex::scalar_cxt' => { 1565 desc => ' keys() on a non-empty lexical hash in scalar context', 1566 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1567 code => '$k = keys %h', 1568 }, 1569 'func::keys::lex::list_cxt_empty' => { 1570 desc => ' keys() on an empty lexical hash in list context', 1571 setup => 'my %h = ()', 1572 code => '() = keys %h', 1573 }, 1574 'func::keys::lex::list_cxt' => { 1575 desc => ' keys() on a non-empty lexical hash in list context', 1576 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1577 code => '() = keys %h', 1578 }, 1579 1580 'func::keys::pkg::void_cxt_empty' => { 1581 desc => ' keys() on an empty package hash in void context', 1582 setup => 'our %h = ()', 1583 code => 'keys %h', 1584 }, 1585 'func::keys::pkg::void_cxt' => { 1586 desc => ' keys() on a non-empty package hash in void context', 1587 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1588 code => 'keys %h', 1589 }, 1590 'func::keys::pkg::bool_cxt_empty' => { 1591 desc => ' keys() on an empty package hash in bool context', 1592 setup => 'our %h = ()', 1593 code => '!keys %h', 1594 }, 1595 'func::keys::pkg::bool_cxt' => { 1596 desc => ' keys() on a non-empty package hash in bool context', 1597 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1598 code => '!keys %h', 1599 }, 1600 'func::keys::pkg::scalar_cxt_empty' => { 1601 desc => ' keys() on an empty package hash in scalar context', 1602 setup => 'my $k; our %h = ()', 1603 code => '$k = keys %h', 1604 }, 1605 'func::keys::pkg::scalar_cxt' => { 1606 desc => ' keys() on a non-empty package hash in scalar context', 1607 setup => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)', 1608 code => '$k = keys %h', 1609 }, 1610 'func::keys::pkg::list_cxt_empty' => { 1611 desc => ' keys() on an empty package hash in list context', 1612 setup => 'our %h = ()', 1613 code => '() = keys %h', 1614 }, 1615 'func::keys::pkg::list_cxt' => { 1616 desc => ' keys() on a non-empty package hash in list context', 1617 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1618 code => '() = keys %h', 1619 }, 1620 1621 1622 'func::length::bool0' => { 1623 desc => 'length==0 in boolean context', 1624 setup => 'my $s = "";', 1625 code => '!length($s);', 1626 }, 1627 'func::length::bool10' => { 1628 desc => 'length==10 in boolean context', 1629 setup => 'my $s = "abcdefghijk";', 1630 code => '!length($s);', 1631 }, 1632 'func::length::scalar10' => { 1633 desc => 'length==10 in scalar context', 1634 setup => 'my $p; my $s = "abcdefghijk";', 1635 code => '$p = length($s);', 1636 }, 1637 'func::length::bool0_utf8' => { 1638 desc => 'utf8 string length==0 in boolean context', 1639 setup => 'my $s = "\x{100}"; chop $s;', 1640 code => '!length($s);', 1641 }, 1642 'func::length::bool10_utf8' => { 1643 desc => 'utf8 string length==10 in boolean context', 1644 setup => 'my $s = "abcdefghij\x{100}";', 1645 code => '!length($s);', 1646 }, 1647 'func::length::scalar10_utf8' => { 1648 desc => 'utf8 string length==10 in scalar context', 1649 setup => 'my $p; my $s = "abcdefghij\x{100}";', 1650 code => '$p = length($s);', 1651 }, 1652 1653 'func::pos::bool0' => { 1654 desc => 'pos==0 in boolean context', 1655 setup => 'my $s = "abc"; pos($s) = 0', 1656 code => '!pos($s);', 1657 }, 1658 'func::pos::bool10' => { 1659 desc => 'pos==10 in boolean context', 1660 setup => 'my $s = "abcdefghijk"; pos($s) = 10', 1661 code => '!pos($s);', 1662 }, 1663 'func::pos::scalar10' => { 1664 desc => 'pos==10 in scalar context', 1665 setup => 'my $p; my $s = "abcdefghijk"; pos($s) = 10', 1666 code => '$p = pos($s);', 1667 }, 1668 1669 'func::ref::notaref_bool' => { 1670 desc => 'ref($notaref) in boolean context', 1671 setup => 'my $r = "boo"', 1672 code => '!ref $r', 1673 }, 1674 'func::ref::ref_bool' => { 1675 desc => 'ref($ref) in boolean context', 1676 setup => 'my $r = []', 1677 code => '!ref $r', 1678 }, 1679 'func::ref::blessedref_bool' => { 1680 desc => 'ref($blessed_ref) in boolean context', 1681 setup => 'my $r = bless []', 1682 code => '!ref $r', 1683 }, 1684 1685 'func::ref::notaref' => { 1686 desc => 'ref($notaref) in scalar context', 1687 setup => 'my $x; my $r = "boo"', 1688 code => '$x = ref $r', 1689 }, 1690 'func::ref::ref' => { 1691 desc => 'ref($ref) in scalar context', 1692 setup => 'my $x; my $r = []', 1693 code => '$x = ref $r', 1694 }, 1695 'func::ref::blessedref' => { 1696 desc => 'ref($blessed_ref) in scalar context', 1697 setup => 'my $x; my $r = bless []', 1698 code => '$x = ref $r', 1699 }, 1700 1701 1702 1703 'func::sort::num' => { 1704 desc => 'plain numeric sort', 1705 setup => 'my (@a, @b); @a = reverse 1..10;', 1706 code => '@b = sort { $a <=> $b } @a', 1707 }, 1708 'func::sort::num_block' => { 1709 desc => 'codeblock numeric sort', 1710 setup => 'my (@a, @b); @a = reverse 1..10;', 1711 code => '@b = sort { $a + 1 <=> $b + 1 } @a', 1712 }, 1713 'func::sort::num_fn' => { 1714 desc => 'function numeric sort', 1715 setup => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;', 1716 code => '@b = sort f @a', 1717 }, 1718 'func::sort::str' => { 1719 desc => 'plain string sort', 1720 setup => 'my (@a, @b); @a = reverse "a".."j";', 1721 code => '@b = sort { $a cmp $b } @a', 1722 }, 1723 'func::sort::str_block' => { 1724 desc => 'codeblock string sort', 1725 setup => 'my (@a, @b); @a = reverse "a".."j";', 1726 code => '@b = sort { ($a . "") cmp ($b . "") } @a', 1727 }, 1728 'func::sort::str_fn' => { 1729 desc => 'function string sort', 1730 setup => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse "a".."j";', 1731 code => '@b = sort f @a', 1732 }, 1733 1734 'func::sort::num_inplace' => { 1735 desc => 'plain numeric sort in-place', 1736 setup => 'my @a = reverse 1..10;', 1737 code => '@a = sort { $a <=> $b } @a', 1738 }, 1739 'func::sort::num_block_inplace' => { 1740 desc => 'codeblock numeric sort in-place', 1741 setup => 'my @a = reverse 1..10;', 1742 code => '@a = sort { $a + 1 <=> $b + 1 } @a', 1743 }, 1744 'func::sort::num_fn_inplace' => { 1745 desc => 'function numeric sort in-place', 1746 setup => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;', 1747 code => '@a = sort f @a', 1748 }, 1749 'func::sort::str_inplace' => { 1750 desc => 'plain string sort in-place', 1751 setup => 'my @a = reverse "a".."j";', 1752 code => '@a = sort { $a cmp $b } @a', 1753 }, 1754 'func::sort::str_block_inplace' => { 1755 desc => 'codeblock string sort in-place', 1756 setup => 'my @a = reverse "a".."j";', 1757 code => '@a = sort { ($a . "") cmp ($b . "") } @a', 1758 }, 1759 'func::sort::str_fn_inplace' => { 1760 desc => 'function string sort in-place', 1761 setup => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse "a".."j";', 1762 code => '@a = sort f @a', 1763 }, 1764 1765 1766 'func::split::vars' => { 1767 desc => 'split into two lexical vars', 1768 setup => 'my $s = "abc:def";', 1769 code => 'my ($x, $y) = split /:/, $s, 2;', 1770 }, 1771 1772 'func::split::array' => { 1773 desc => 'split into a lexical array', 1774 setup => 'my @a; my $s = "abc:def";', 1775 code => '@a = split /:/, $s, 2;', 1776 }, 1777 'func::split::myarray' => { 1778 desc => 'split into a lexical array declared in the assign', 1779 setup => 'my $s = "abc:def";', 1780 code => 'my @a = split /:/, $s, 2;', 1781 }, 1782 'func::split::arrayexpr' => { 1783 desc => 'split into an @{$expr} ', 1784 setup => 'my $s = "abc:def"; my $r = []', 1785 code => '@$r = split /:/, $s, 2;', 1786 }, 1787 'func::split::arraylist' => { 1788 desc => 'split into an array with extra arg', 1789 setup => 'my @a; my $s = "abc:def";', 1790 code => '@a = (split(/:/, $s, 2), 1);', 1791 }, 1792 1793 # SPRINTF 1794 1795 1796 'func::sprintf::d' => { 1797 desc => '%d', 1798 setup => 'my $s; my $a1 = 1234;', 1799 code => '$s = sprintf "%d", $a1', 1800 }, 1801 'func::sprintf::d8' => { 1802 desc => '%8d', 1803 setup => 'my $s; my $a1 = 1234;', 1804 code => '$s = sprintf "%8d", $a1', 1805 }, 1806 'func::sprintf::foo_d8' => { 1807 desc => 'foo=%8d', 1808 setup => 'my $s; my $a1 = 1234;', 1809 code => '$s = sprintf "foo=%8d", $a1', 1810 }, 1811 1812 'func::sprintf::f0' => { 1813 # "%.0f" is very special-cased 1814 desc => 'sprintf "%.0f"', 1815 setup => 'my $s; my $a1 = 123.456;', 1816 code => '$s = sprintf "%.0f", $a1', 1817 }, 1818 'func::sprintf::foo_f0' => { 1819 # "...%.0f..." is special-cased 1820 desc => 'sprintf "foo=%.0f"', 1821 setup => 'my $s; my $a1 = 123.456;', 1822 code => '$s = sprintf "foo=%.0f\n", $a1', 1823 }, 1824 'func::sprintf::foo_f93' => { 1825 desc => 'foo=%9.3f', 1826 setup => 'my $s; my $a1 = 123.456;', 1827 code => '$s = sprintf "foo=%9.3f\n", $a1', 1828 }, 1829 1830 'func::sprintf::g9' => { 1831 # "...%.NNNg..." is special-cased 1832 desc => '%.9g', 1833 setup => 'my $s; my $a1 = 123.456;', 1834 code => '$s = sprintf "%.9g", $a1', 1835 }, 1836 'func::sprintf::foo_g9' => { 1837 # "...%.NNNg..." is special-cased 1838 desc => 'foo=%.9g', 1839 setup => 'my $s; my $a1 = 123.456;', 1840 code => '$s = sprintf "foo=%.9g\n", $a1', 1841 }, 1842 'func::sprintf::foo_g93' => { 1843 desc => 'foo=%9.3g', 1844 setup => 'my $s; my $a1 = 123.456;', 1845 code => '$s = sprintf "foo=%9.3g\n", $a1', 1846 }, 1847 1848 'func::sprintf::s' => { 1849 desc => '%s', 1850 setup => 'my $s; my $a1 = "abcd";', 1851 code => '$s = sprintf "%s", $a1', 1852 }, 1853 'func::sprintf::foo_s' => { 1854 desc => 'foo=%s', 1855 setup => 'my $s; my $a1 = "abcd";', 1856 code => '$s = sprintf "foo=%s", $a1', 1857 }, 1858 'func::sprintf::mixed_utf8_sss' => { 1859 desc => 'foo=%s bar=%s baz=%s', 1860 setup => 'my $s;my $a = "ab\x{100}cd"; my $b = "efg"; my $c = "h\x{101}ij"', 1861 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 1862 }, 1863 1864 # sprint that's likely to be optimised to an OP_MULTICONCAT 1865 1866 'func::sprintf::l' => { 1867 setup => 'my $lex1 = "abcd"', 1868 code => 'sprintf "%s", $lex1', 1869 }, 1870 'func::sprintf::g_l' => { 1871 setup => 'our $pkg; my $lex1 = "abcd"', 1872 code => '$pkg = sprintf "%s", $lex1', 1873 }, 1874 'func::sprintf::g_append_l' => { 1875 setup => 'our $pkg; my $lex1 = "abcd"', 1876 pre => '$pkg = "pqrs"', 1877 code => '$pkg .= sprintf "%s", $lex1', 1878 }, 1879 'func::sprintf::g_ll' => { 1880 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1881 code => '$pkg = sprintf "%s%s", $lex1, $lex2', 1882 }, 1883 'func::sprintf::g_append_ll' => { 1884 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1885 pre => '$pkg = "pqrs"', 1886 code => '$pkg .= sprintf "%s%s", $lex1, $lex2', 1887 }, 1888 'func::sprintf::g_cl' => { 1889 setup => 'our $pkg; my $lex1 = "abcd"', 1890 code => '$pkg = sprintf "foo=%s", $lex1', 1891 }, 1892 'func::sprintf::g_clclc' => { 1893 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1894 code => '$pkg = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1895 }, 1896 1897 'func::sprintf::l_l' => { 1898 setup => 'my $lex; my $lex1 = "abcd"', 1899 code => '$lex = sprintf "%s", $lex1', 1900 }, 1901 'func::sprintf::l_append_l' => { 1902 setup => 'my $lex; my $lex1 = "abcd"', 1903 pre => '$lex = "pqrs"', 1904 code => '$lex .= sprintf "%s", $lex1', 1905 }, 1906 'func::sprintf::ll' => { 1907 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1908 code => 'sprintf "%s%s", $lex1, $lex2', 1909 }, 1910 'func::sprintf::l_ll' => { 1911 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1912 code => '$lex = sprintf "%s%s", $lex1, $lex2', 1913 }, 1914 'func::sprintf::l_append_ll' => { 1915 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1916 pre => '$lex = "pqrs"', 1917 code => '$lex .= sprintf "%s%s", $lex1, $lex2', 1918 }, 1919 'func::sprintf::l_cl' => { 1920 setup => 'my $lex; my $lex1 = "abcd"', 1921 code => '$lex = sprintf "foo=%s", $lex1', 1922 }, 1923 'func::sprintf::l_clclc' => { 1924 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1925 code => '$lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1926 }, 1927 1928 'func::sprintf::m_l' => { 1929 setup => 'my $lex1 = "abcd"', 1930 code => 'my $lex = sprintf "%s", $lex1', 1931 }, 1932 'func::sprintf::m_ll' => { 1933 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1934 code => 'my $lex = sprintf "%s%s", $lex1, $lex2', 1935 }, 1936 'func::sprintf::m_cl' => { 1937 setup => 'my $lex1 = "abcd"', 1938 code => 'my $lex = sprintf "foo=%s", $lex1', 1939 }, 1940 'func::sprintf::m_clclc' => { 1941 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1942 code => 'my $lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1943 }, 1944 1945 'func::sprintf::utf8__l_lll' => { 1946 desc => '$s = sprintf("foo=%s bar=%s baz=%s", $a, $b, $c) where $a,$c are utf8', 1947 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1948 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 1949 }, 1950 1951 1952 # S/// 1953 1954 'func::subst::bool' => { 1955 desc => 's/// in boolean context', 1956 setup => '', 1957 code => '$_ = "aaa"; !s/./x/g;' 1958 }, 1959 1960 1961 'func::values::scalar_cxt_empty' => { 1962 desc => ' values() on an empty hash in scalar context', 1963 setup => 'my $k; my %h = ()', 1964 code => '$k = values %h', 1965 }, 1966 'func::values::scalar_cxt' => { 1967 desc => ' values() on a non-empty hash in scalar context', 1968 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1969 code => '$k = values %h', 1970 }, 1971 'func::values::list_cxt_empty' => { 1972 desc => ' values() on an empty hash in list context', 1973 setup => 'my %h = ()', 1974 code => '() = values %h', 1975 }, 1976 'func::values::list_cxt' => { 1977 desc => ' values() on a non-empty hash in list context', 1978 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1979 code => '() = values %h', 1980 }, 1981 1982 1983 1984 'loop::block' => { 1985 desc => 'empty basic loop', 1986 setup => '', 1987 code => '{1;}', 1988 }, 1989 1990 'loop::do' => { 1991 desc => 'basic do block', 1992 setup => 'my $x; my $y = 2;', 1993 code => '$x = do {1; $y}', # the ';' stops the do being optimised 1994 }, 1995 1996 'loop::for::my_range1' => { 1997 desc => 'empty for loop with my var and 1 integer range', 1998 setup => '', 1999 code => 'for my $x (1..1) {}', 2000 }, 2001 'loop::for::lex_range1' => { 2002 desc => 'empty for loop with lexical var and 1 integer range', 2003 setup => 'my $x;', 2004 code => 'for $x (1..1) {}', 2005 }, 2006 'loop::for::pkg_range1' => { 2007 desc => 'empty for loop with package var and 1 integer range', 2008 setup => '$x = 1;', 2009 code => 'for $x (1..1) {}', 2010 }, 2011 'loop::for::defsv_range1' => { 2012 desc => 'empty for loop with $_ and integer 1 range', 2013 setup => ';', 2014 code => 'for (1..1) {}', 2015 }, 2016 'loop::for::my_range4' => { 2017 desc => 'empty for loop with my var and 4 integer range', 2018 setup => '', 2019 code => 'for my $x (1..4) {}', 2020 }, 2021 'loop::for::lex_range4' => { 2022 desc => 'empty for loop with lexical var and 4 integer range', 2023 setup => 'my $x;', 2024 code => 'for $x (1..4) {}', 2025 }, 2026 'loop::for::pkg_range4' => { 2027 desc => 'empty for loop with package var and 4 integer range', 2028 setup => '$x = 1;', 2029 code => 'for $x (1..4) {}', 2030 }, 2031 'loop::for::defsv_range4' => { 2032 desc => 'empty for loop with $_ and integer 4 range', 2033 setup => ';', 2034 code => 'for (1..4) {}', 2035 }, 2036 2037 'loop::for::my_list1' => { 2038 desc => 'empty for loop with my var and 1 integer list', 2039 setup => '', 2040 code => 'for my $x (1) {}', 2041 }, 2042 'loop::for::lex_list1' => { 2043 desc => 'empty for loop with lexical var and 1 integer list', 2044 setup => 'my $x;', 2045 code => 'for $x (1) {}', 2046 }, 2047 'loop::for::pkg_list1' => { 2048 desc => 'empty for loop with package var and 1 integer list', 2049 setup => '$x = 1;', 2050 code => 'for $x (1) {}', 2051 }, 2052 'loop::for::defsv_list1' => { 2053 desc => 'empty for loop with $_ and integer 1 list', 2054 setup => ';', 2055 code => 'for (1) {}', 2056 }, 2057 'loop::for::my_list4' => { 2058 desc => 'empty for loop with my var and 4 integer list', 2059 setup => '', 2060 code => 'for my $x (1,2,3,4) {}', 2061 }, 2062 'loop::for::lex_list4' => { 2063 desc => 'empty for loop with lexical var and 4 integer list', 2064 setup => 'my $x;', 2065 code => 'for $x (1,2,3,4) {}', 2066 }, 2067 'loop::for::pkg_list4' => { 2068 desc => 'empty for loop with package var and 4 integer list', 2069 setup => '$x = 1;', 2070 code => 'for $x (1,2,3,4) {}', 2071 }, 2072 'loop::for::defsv_list4' => { 2073 desc => 'empty for loop with $_ and integer 4 list', 2074 setup => '', 2075 code => 'for (1,2,3,4) {}', 2076 }, 2077 2078 'loop::for::my_array1' => { 2079 desc => 'empty for loop with my var and 1 integer array', 2080 setup => 'my @a = (1);', 2081 code => 'for my $x (@a) {}', 2082 }, 2083 'loop::for::lex_array1' => { 2084 desc => 'empty for loop with lexical var and 1 integer array', 2085 setup => 'my $x; my @a = (1);', 2086 code => 'for $x (@a) {}', 2087 }, 2088 'loop::for::pkg_array1' => { 2089 desc => 'empty for loop with package var and 1 integer array', 2090 setup => '$x = 1; my @a = (1);', 2091 code => 'for $x (@a) {}', 2092 }, 2093 'loop::for::defsv_array1' => { 2094 desc => 'empty for loop with $_ and integer 1 array', 2095 setup => 'my @a = (@a);', 2096 code => 'for (1) {}', 2097 }, 2098 'loop::for::my_array4' => { 2099 desc => 'empty for loop with my var and 4 integer array', 2100 setup => 'my @a = (1..4);', 2101 code => 'for my $x (@a) {}', 2102 }, 2103 'loop::for::lex_array4' => { 2104 desc => 'empty for loop with lexical var and 4 integer array', 2105 setup => 'my $x; my @a = (1..4);', 2106 code => 'for $x (@a) {}', 2107 }, 2108 'loop::for::pkg_array4' => { 2109 desc => 'empty for loop with package var and 4 integer array', 2110 setup => '$x = 1; my @a = (1..4);', 2111 code => 'for $x (@a) {}', 2112 }, 2113 'loop::for::defsv_array4' => { 2114 desc => 'empty for loop with $_ and integer 4 array', 2115 setup => 'my @a = (1..4);', 2116 code => 'for (@a) {}', 2117 }, 2118 2119 'loop::for::next4' => { 2120 desc => 'for loop containing only next with my var and integer 4 array', 2121 setup => 'my @a = (1..4);', 2122 code => 'for my $x (@a) {next}', 2123 }, 2124 2125 'loop::grep::expr_3int' => { 2126 desc => 'grep $_ > 0, 1,2,3', 2127 setup => 'my @a', 2128 code => '@a = grep $_ > 0, 1,2,3', 2129 }, 2130 2131 'loop::grep::block_3int' => { 2132 desc => 'grep { 1; $_ > 0} 1,2,3', 2133 setup => 'my @a', 2134 code => '@a = grep { 1; $_ > 0} 1,2,3', 2135 }, 2136 2137 'loop::map::expr_3int' => { 2138 desc => 'map $_+1, 1,2,3', 2139 setup => 'my @a', 2140 code => '@a = map $_+1, 1,2,3', 2141 }, 2142 2143 'loop::map::block_3int' => { 2144 desc => 'map { 1; $_+1} 1,2,3', 2145 setup => 'my @a', 2146 code => '@a = map { 1; $_+1} 1,2,3', 2147 }, 2148 2149 'loop::while::i1' => { 2150 desc => 'empty while loop 1 iteration', 2151 setup => 'my $i = 0;', 2152 code => 'while (++$i % 2) {}', 2153 }, 2154 'loop::while::i4' => { 2155 desc => 'empty while loop 4 iterations', 2156 setup => 'my $i = 0;', 2157 code => 'while (++$i % 4) {}', 2158 }, 2159 2160 2161 'regex::anyof_plus::anchored' => { 2162 setup => '$_ = "a" x 100;', 2163 code => '/^[acgt]+/', 2164 }, 2165 'regex::anyof_plus::floating' => { 2166 desc => '/[acgt]+where match starts at position 0 for 100 chars/', 2167 setup => '$_ = "a" x 100;', 2168 code => '/[acgt]+/', 2169 }, 2170 'regex::anyof_plus::floating_away' => { 2171 desc => '/[acgt]+/ where match starts at position 100 for 100 chars', 2172 setup => '$_ = ("0" x 100) . ("a" x 100);', 2173 code => '/[acgt]+/', 2174 }, 2175 2176 'regex::whilem::min_captures_fail' => { 2177 desc => '/WHILEM with anon-greedy match and captures that fails', 2178 setup => '$_ = ("a" x 20)', 2179 code => '/^(?:(.)(.))*?[XY]/', 2180 }, 2181 'regex::whilem::max_captures_fail' => { 2182 desc => '/WHILEM with a greedy match and captures that fails', 2183 setup => '$_ = ("a" x 20)', 2184 code => '/^(?:(.)(.))*[XY]/', 2185 }, 2186]; 2187