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