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::goto::empty' => { 162 desc => 'goto &funtion with no args or body', 163 setup => 'sub f { goto &g } sub g {}', 164 code => 'f()', 165 }, 166 'call::goto::args3' => { 167 desc => 'goto &funtion with 3 local lexical vars', 168 setup => 'sub f { goto &g } sub g { my ($a, $b, $c) = @_ }', 169 code => 'f(1,2,3)', 170 }, 171 172 173 'expr::array::lex_1const_0' => { 174 desc => 'lexical $array[0]', 175 setup => 'my @a = (1)', 176 code => '$a[0]', 177 }, 178 'expr::array::lex_1const_m1' => { 179 desc => 'lexical $array[-1]', 180 setup => 'my @a = (1)', 181 code => '$a[-1]', 182 }, 183 'expr::array::lex_2const' => { 184 desc => 'lexical $array[const][const]', 185 setup => 'my @a = ([1,2])', 186 code => '$a[0][1]', 187 }, 188 'expr::array::lex_2var' => { 189 desc => 'lexical $array[$i1][$i2]', 190 setup => 'my ($i1,$i2) = (0,1); my @a = ([1,2])', 191 code => '$a[$i1][$i2]', 192 }, 193 'expr::array::ref_lex_2var' => { 194 desc => 'lexical $arrayref->[$i1][$i2]', 195 setup => 'my ($i1,$i2) = (0,1); my $r = [[1,2]]', 196 code => '$r->[$i1][$i2]', 197 }, 198 'expr::array::ref_lex_3const' => { 199 desc => 'lexical $arrayref->[const][const][const]', 200 setup => 'my $r = [[[1,2]]]', 201 code => '$r->[0][0][0]', 202 }, 203 'expr::array::ref_expr_lex_3const' => { 204 desc => '(lexical expr)->[const][const][const]', 205 setup => 'my $r = [[[1,2]]]', 206 code => '($r||0)->[0][0][0]', 207 }, 208 209 210 'expr::array::pkg_1const_0' => { 211 desc => 'package $array[0]', 212 setup => '@a = (1)', 213 code => '$a[0]', 214 }, 215 'expr::array::pkg_1const_m1' => { 216 desc => 'package $array[-1]', 217 setup => '@a = (1)', 218 code => '$a[-1]', 219 }, 220 'expr::array::pkg_2const' => { 221 desc => 'package $array[const][const]', 222 setup => '@a = ([1,2])', 223 code => '$a[0][1]', 224 }, 225 'expr::array::pkg_2var' => { 226 desc => 'package $array[$i1][$i2]', 227 setup => '($i1,$i2) = (0,1); @a = ([1,2])', 228 code => '$a[$i1][$i2]', 229 }, 230 'expr::array::ref_pkg_2var' => { 231 desc => 'package $arrayref->[$i1][$i2]', 232 setup => '($i1,$i2) = (0,1); $r = [[1,2]]', 233 code => '$r->[$i1][$i2]', 234 }, 235 'expr::array::ref_pkg_3const' => { 236 desc => 'package $arrayref->[const][const][const]', 237 setup => '$r = [[[1,2]]]', 238 code => '$r->[0][0][0]', 239 }, 240 'expr::array::ref_expr_pkg_3const' => { 241 desc => '(package expr)->[const][const][const]', 242 setup => '$r = [[[1,2]]]', 243 code => '($r||0)->[0][0][0]', 244 }, 245 246 'expr::array::lex_bool_empty' => { 247 desc => 'empty lexical array in boolean context', 248 setup => 'my @a;', 249 code => '!@a', 250 }, 251 'expr::array::lex_bool_full' => { 252 desc => 'non-empty lexical array in boolean context', 253 setup => 'my @a = 1..10;', 254 code => '!@a', 255 }, 256 'expr::array::lex_scalar_empty' => { 257 desc => 'empty lexical array in scalar context', 258 setup => 'my (@a, $i);', 259 code => '$i = @a', 260 }, 261 'expr::array::lex_scalar_full' => { 262 desc => 'non-empty lexical array in scalar context', 263 setup => 'my @a = 1..10; my $i', 264 code => '$i = @a', 265 }, 266 'expr::array::pkg_bool_empty' => { 267 desc => 'empty lexical array in boolean context', 268 setup => 'our @a;', 269 code => '!@a', 270 }, 271 'expr::array::pkg_bool_full' => { 272 desc => 'non-empty lexical array in boolean context', 273 setup => 'our @a = 1..10;', 274 code => '!@a', 275 }, 276 'expr::array::pkg_scalar_empty' => { 277 desc => 'empty lexical array in scalar context', 278 setup => 'our @a; my $i;', 279 code => '$i = @a', 280 }, 281 'expr::array::pkg_scalar_full' => { 282 desc => 'non-empty lexical array in scalar context', 283 setup => 'our @a = 1..10; my $i', 284 code => '$i = @a', 285 }, 286 287 'expr::arrayhash::lex_3var' => { 288 desc => 'lexical $h{$k1}[$i]{$k2}', 289 setup => 'my ($i, $k1, $k2) = (0,"foo","bar");' 290 . 'my %h = (foo => [ { bar => 1 } ])', 291 code => '$h{$k1}[$i]{$k2}', 292 }, 293 'expr::arrayhash::pkg_3var' => { 294 desc => 'package $h{$k1}[$i]{$k2}', 295 setup => '($i, $k1, $k2) = (0,"foo","bar");' 296 . '%h = (foo => [ { bar => 1 } ])', 297 code => '$h{$k1}[$i]{$k2}', 298 }, 299 300 'expr::hash::lex_1const' => { 301 desc => 'lexical $hash{const}', 302 setup => 'my %h = ("foo" => 1)', 303 code => '$h{foo}', 304 }, 305 'expr::hash::lex_2const' => { 306 desc => 'lexical $hash{const}{const}', 307 setup => 'my %h = (foo => { bar => 1 })', 308 code => '$h{foo}{bar}', 309 }, 310 'expr::hash::lex_2var' => { 311 desc => 'lexical $hash{$k1}{$k2}', 312 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 })', 313 code => '$h{$k1}{$k2}', 314 }, 315 'expr::hash::ref_lex_2var' => { 316 desc => 'lexical $hashref->{$k1}{$k2}', 317 setup => 'my ($k1,$k2) = qw(foo bar); my $r = {$k1 => { $k2 => 1 }}', 318 code => '$r->{$k1}{$k2}', 319 }, 320 'expr::hash::ref_lex_3const' => { 321 desc => 'lexical $hashref->{const}{const}{const}', 322 setup => 'my $r = {foo => { bar => { baz => 1 }}}', 323 code => '$r->{foo}{bar}{baz}', 324 }, 325 'expr::hash::ref_expr_lex_3const' => { 326 desc => '(lexical expr)->{const}{const}{const}', 327 setup => 'my $r = {foo => { bar => { baz => 1 }}}', 328 code => '($r||0)->{foo}{bar}{baz}', 329 }, 330 331 'expr::hash::pkg_1const' => { 332 desc => 'package $hash{const}', 333 setup => '%h = ("foo" => 1)', 334 code => '$h{foo}', 335 }, 336 'expr::hash::pkg_2const' => { 337 desc => 'package $hash{const}{const}', 338 setup => '%h = (foo => { bar => 1 })', 339 code => '$h{foo}{bar}', 340 }, 341 'expr::hash::pkg_2var' => { 342 desc => 'package $hash{$k1}{$k2}', 343 setup => '($k1,$k2) = qw(foo bar); %h = ($k1 => { $k2 => 1 })', 344 code => '$h{$k1}{$k2}', 345 }, 346 'expr::hash::ref_pkg_2var' => { 347 desc => 'package $hashref->{$k1}{$k2}', 348 setup => '($k1,$k2) = qw(foo bar); $r = {$k1 => { $k2 => 1 }}', 349 code => '$r->{$k1}{$k2}', 350 }, 351 'expr::hash::ref_pkg_3const' => { 352 desc => 'package $hashref->{const}{const}{const}', 353 setup => '$r = {foo => { bar => { baz => 1 }}}', 354 code => '$r->{foo}{bar}{baz}', 355 }, 356 'expr::hash::ref_expr_pkg_3const' => { 357 desc => '(package expr)->{const}{const}{const}', 358 setup => '$r = {foo => { bar => { baz => 1 }}}', 359 code => '($r||0)->{foo}{bar}{baz}', 360 }, 361 362 363 'expr::hash::exists_lex_2var' => { 364 desc => 'lexical exists $hash{$k1}{$k2}', 365 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });', 366 code => 'exists $h{$k1}{$k2}', 367 }, 368 369 'expr::hash::bool_empty' => { 370 desc => 'empty lexical hash in boolean context', 371 setup => 'my %h;', 372 code => '!%h', 373 }, 374 'expr::hash::bool_empty_unknown' => { 375 desc => 'empty lexical hash in unknown context', 376 setup => 'my ($i, %h); sub f { if (%h) { $i++ }}', 377 code => 'f()', 378 }, 379 'expr::hash::bool_full' => { 380 desc => 'non-empty lexical hash in boolean context', 381 setup => 'my %h = 1..10;', 382 code => '!%h', 383 }, 384 385 386 ( 387 map { 388 sprintf('expr::hash::notexists_lex_keylen%04d',$_) => { 389 desc => 'exists on non-key of length '. $_, 390 setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key."x"} = 1;', 391 code => 'exists $h{$key}', 392 }, 393 } ( 394 1 .. 24, 395 # 1,2,3,7,8,9,14,15,16,20,24, 396 50, 397 100, 398 1000, 399 ) 400 ), 401 ( 402 map { 403 sprintf('expr::hash::exists_lex_keylen%04d',$_) => { 404 desc => 'exists on existing key of length '. $_, 405 setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key} = 1;', 406 code => 'exists $h{$key}', 407 }, 408 } ( 409 1 .. 24, 410 # 1,2,3,7,8,9,14,15,16,20,24, 411 50, 412 100, 413 1000, 414 ) 415 ), 416 417 'expr::hash::delete_lex_2var' => { 418 desc => 'lexical delete $hash{$k1}{$k2}', 419 setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });', 420 code => 'delete $h{$k1}{$k2}', 421 }, 422 423 424 # list assign, OP_AASSIGN 425 426 427 # (....) = () 428 429 'expr::aassign::ma_empty' => { 430 desc => 'my array assigned empty', 431 setup => '', 432 code => 'my @a = ()', 433 }, 434 'expr::aassign::lax_empty' => { 435 desc => 'non-empty lexical array assigned empty', 436 setup => 'my @a = 1..3;', 437 code => '@a = ()', 438 }, 439 'expr::aassign::llax_empty' => { 440 desc => 'non-empty lexical var and array assigned empty', 441 setup => 'my ($x, @a) = 1..4;', 442 code => '($x, @a) = ()', 443 }, 444 'expr::aassign::mh_empty' => { 445 desc => 'my hash assigned empty', 446 setup => '', 447 code => 'my %h = ()', 448 }, 449 'expr::aassign::lhx_empty' => { 450 desc => 'non-empty lexical hash assigned empty', 451 setup => 'my %h = 1..4;', 452 code => '%h = ()', 453 }, 454 'expr::aassign::llhx_empty' => { 455 desc => 'non-empty lexical var and hash assigned empty', 456 setup => 'my ($x, %h) = 1..5;', 457 code => '($x, %h) = ()', 458 }, 459 'expr::aassign::3m_empty' => { 460 desc => 'three my vars assigned empty', 461 setup => '', 462 code => 'my ($x,$y,$z) = ()', 463 }, 464 'expr::aassign::3l_empty' => { 465 desc => 'three lexical vars assigned empty', 466 setup => 'my ($x,$y,$z)', 467 code => '($x,$y,$z) = ()', 468 }, 469 'expr::aassign::3lref_empty' => { 470 desc => 'three lexical ref vars assigned empty', 471 setup => 'my ($x,$y,$z); my $r = []; ', 472 code => '($x,$y,$z) = ($r,$r,$r); ($x,$y,$z) = ()', 473 }, 474 'expr::aassign::pa_empty' => { 475 desc => 'package array assigned empty', 476 setup => '', 477 code => '@a = ()', 478 }, 479 'expr::aassign::pax_empty' => { 480 desc => 'non-empty package array assigned empty', 481 setup => '@a = (1,2,3)', 482 code => '@a = ()', 483 }, 484 'expr::aassign::3p_empty' => { 485 desc => 'three package vars assigned empty', 486 setup => '($x,$y,$z) = 1..3;', 487 code => '($x,$y,$z) = ()', 488 }, 489 490 # (....) = (1,2,3) 491 492 'expr::aassign::ma_3c' => { 493 desc => 'my array assigned 3 consts', 494 setup => '', 495 code => 'my @a = (1,2,3)', 496 }, 497 'expr::aassign::lax_3c' => { 498 desc => 'non-empty lexical array assigned 3 consts', 499 setup => 'my @a = 1..3;', 500 code => '@a = (1,2,3)', 501 }, 502 'expr::aassign::llax_3c' => { 503 desc => 'non-empty lexical var and array assigned 3 consts', 504 setup => 'my ($x, @a) = 1..4;', 505 code => '($x, @a) = (1,2,3)', 506 }, 507 'expr::aassign::mh_4c' => { 508 desc => 'my hash assigned 4 consts', 509 setup => '', 510 code => 'my %h = qw(a 1 b 2)', 511 }, 512 'expr::aassign::lhx_4c' => { 513 desc => 'non-empty lexical hash assigned 4 consts', 514 setup => 'my %h = qw(a 1 b 2);', 515 code => '%h = qw(c 3 d 4)', 516 }, 517 'expr::aassign::llhx_5c' => { 518 desc => 'non-empty lexical var and array assigned 5 consts', 519 setup => 'my ($x, %h) = (1, qw(a 1 b 2));', 520 code => '($x, %h) = (10, qw(c 3 d 4))', 521 }, 522 'expr::aassign::3m_3c' => { 523 desc => 'three my vars assigned 3 consts', 524 setup => '', 525 code => 'my ($x,$y,$z) = (1,2,3)', 526 }, 527 'expr::aassign::3l_3c' => { 528 desc => 'three lexical vars assigned 3 consts', 529 setup => 'my ($x,$y,$z)', 530 code => '($x,$y,$z) = (1,2,3)', 531 }, 532 'expr::aassign::pa_3c' => { 533 desc => 'package array assigned 3 consts', 534 setup => '', 535 code => '@a = (1,2,3)', 536 }, 537 'expr::aassign::pax_3c' => { 538 desc => 'non-empty package array assigned 3 consts', 539 setup => '@a = (1,2,3)', 540 code => '@a = (1,2,3)', 541 }, 542 'expr::aassign::3p_3c' => { 543 desc => 'three package vars assigned 3 consts', 544 setup => '($x,$y,$z) = 1..3;', 545 code => '($x,$y,$z) = (1,2,3)', 546 }, 547 548 # (....) = @lexical 549 550 'expr::aassign::ma_la' => { 551 desc => 'my array assigned lexical array', 552 setup => 'my @init = 1..3;', 553 code => 'my @a = @init', 554 }, 555 'expr::aassign::lax_la' => { 556 desc => 'non-empty lexical array assigned lexical array', 557 setup => 'my @init = 1..3; my @a = 1..3;', 558 code => '@a = @init', 559 }, 560 'expr::aassign::llax_la' => { 561 desc => 'non-empty lexical var and array assigned lexical array', 562 setup => 'my @init = 1..3; my ($x, @a) = 1..4;', 563 code => '($x, @a) = @init', 564 }, 565 'expr::aassign::3m_la' => { 566 desc => 'three my vars assigned lexical array', 567 setup => 'my @init = 1..3;', 568 code => 'my ($x,$y,$z) = @init', 569 }, 570 'expr::aassign::3l_la' => { 571 desc => 'three lexical vars assigned lexical array', 572 setup => 'my @init = 1..3; my ($x,$y,$z)', 573 code => '($x,$y,$z) = @init', 574 }, 575 'expr::aassign::pa_la' => { 576 desc => 'package array assigned lexical array', 577 setup => 'my @init = 1..3;', 578 code => '@a = @init', 579 }, 580 'expr::aassign::pax_la' => { 581 desc => 'non-empty package array assigned lexical array', 582 setup => 'my @init = 1..3; @a = @init', 583 code => '@a = @init', 584 }, 585 'expr::aassign::3p_la' => { 586 desc => 'three package vars assigned lexical array', 587 setup => 'my @init = 1..3; ($x,$y,$z) = 1..3;', 588 code => '($x,$y,$z) = @init', 589 }, 590 591 # (....) = @package 592 593 'expr::aassign::ma_pa' => { 594 desc => 'my array assigned package array', 595 setup => '@init = 1..3;', 596 code => 'my @a = @init', 597 }, 598 'expr::aassign::lax_pa' => { 599 desc => 'non-empty lexical array assigned package array', 600 setup => '@init = 1..3; my @a = 1..3;', 601 code => '@a = @init', 602 }, 603 'expr::aassign::llax_pa' => { 604 desc => 'non-empty lexical var and array assigned package array', 605 setup => '@init = 1..3; my ($x, @a) = 1..4;', 606 code => '($x, @a) = @init', 607 }, 608 'expr::aassign::3m_pa' => { 609 desc => 'three my vars assigned package array', 610 setup => '@init = 1..3;', 611 code => 'my ($x,$y,$z) = @init', 612 }, 613 'expr::aassign::3l_pa' => { 614 desc => 'three lexical vars assigned package array', 615 setup => '@init = 1..3; my ($x,$y,$z)', 616 code => '($x,$y,$z) = @init', 617 }, 618 'expr::aassign::pa_pa' => { 619 desc => 'package array assigned package array', 620 setup => '@init = 1..3;', 621 code => '@a = @init', 622 }, 623 'expr::aassign::pax_pa' => { 624 desc => 'non-empty package array assigned package array', 625 setup => '@init = 1..3; @a = @init', 626 code => '@a = @init', 627 }, 628 'expr::aassign::3p_pa' => { 629 desc => 'three package vars assigned package array', 630 setup => '@init = 1..3; ($x,$y,$z) = 1..3;', 631 code => '($x,$y,$z) = @init', 632 }, 633 634 # (....) = @_; 635 636 'expr::aassign::ma_defary' => { 637 desc => 'my array assigned @_', 638 setup => '@_ = 1..3;', 639 code => 'my @a = @_', 640 }, 641 'expr::aassign::lax_defary' => { 642 desc => 'non-empty lexical array assigned @_', 643 setup => '@_ = 1..3; my @a = 1..3;', 644 code => '@a = @_', 645 }, 646 'expr::aassign::llax_defary' => { 647 desc => 'non-empty lexical var and array assigned @_', 648 setup => '@_ = 1..3; my ($x, @a) = 1..4;', 649 code => '($x, @a) = @_', 650 }, 651 'expr::aassign::3m_defary' => { 652 desc => 'three my vars assigned @_', 653 setup => '@_ = 1..3;', 654 code => 'my ($x,$y,$z) = @_', 655 }, 656 'expr::aassign::3l_defary' => { 657 desc => 'three lexical vars assigned @_', 658 setup => '@_ = 1..3; my ($x,$y,$z)', 659 code => '($x,$y,$z) = @_', 660 }, 661 'expr::aassign::pa_defary' => { 662 desc => 'package array assigned @_', 663 setup => '@_ = 1..3;', 664 code => '@a = @_', 665 }, 666 'expr::aassign::pax_defary' => { 667 desc => 'non-empty package array assigned @_', 668 setup => '@_ = 1..3; @a = @_', 669 code => '@a = @_', 670 }, 671 'expr::aassign::3p_defary' => { 672 desc => 'three package vars assigned @_', 673 setup => '@_ = 1..3; ($x,$y,$z) = 1..3;', 674 code => '($x,$y,$z) = @_', 675 }, 676 677 # (....) = %lexical 678 679 'expr::aassign::ma_lh' => { 680 desc => 'my array assigned lexical hash', 681 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 682 code => 'my @a = %h', 683 }, 684 685 686 # (....) = ($lex1,$lex2,$lex3); 687 688 'expr::aassign::ma_3l' => { 689 desc => 'my array assigned lexicals', 690 setup => 'my ($v1,$v2,$v3) = 1..3;', 691 code => 'my @a = ($v1,$v2,$v3)', 692 }, 693 'expr::aassign::lax_3l' => { 694 desc => 'non-empty lexical array assigned lexicals', 695 setup => 'my ($v1,$v2,$v3) = 1..3; my @a = 1..3;', 696 code => '@a = ($v1,$v2,$v3)', 697 }, 698 'expr::aassign::llax_3l' => { 699 desc => 'non-empty lexical var and array assigned lexicals', 700 setup => 'my ($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;', 701 code => '($x, @a) = ($v1,$v2,$v3)', 702 }, 703 'expr::aassign::3m_3l' => { 704 desc => 'three my vars assigned lexicals', 705 setup => 'my ($v1,$v2,$v3) = 1..3;', 706 code => 'my ($x,$y,$z) = ($v1,$v2,$v3)', 707 }, 708 'expr::aassign::3l_3l' => { 709 desc => 'three lexical vars assigned lexicals', 710 setup => 'my ($v1,$v2,$v3) = 1..3; my ($x,$y,$z)', 711 code => '($x,$y,$z) = ($v1,$v2,$v3)', 712 }, 713 'expr::aassign::pa_3l' => { 714 desc => 'package array assigned lexicals', 715 setup => 'my ($v1,$v2,$v3) = 1..3;', 716 code => '@a = ($v1,$v2,$v3)', 717 }, 718 'expr::aassign::pax_3l' => { 719 desc => 'non-empty package array assigned lexicals', 720 setup => 'my ($v1,$v2,$v3) = 1..3; @a = @_', 721 code => '@a = ($v1,$v2,$v3)', 722 }, 723 'expr::aassign::3p_3l' => { 724 desc => 'three package vars assigned lexicals', 725 setup => 'my ($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;', 726 code => '($x,$y,$z) = ($v1,$v2,$v3)', 727 }, 728 729 730 # (....) = ($pkg1,$pkg2,$pkg3); 731 732 'expr::aassign::ma_3p' => { 733 desc => 'my array assigned 3 package vars', 734 setup => '($v1,$v2,$v3) = 1..3;', 735 code => 'my @a = ($v1,$v2,$v3)', 736 }, 737 'expr::aassign::lax_3p' => { 738 desc => 'non-empty lexical array assigned 3 package vars', 739 setup => '($v1,$v2,$v3) = 1..3; my @a = 1..3;', 740 code => '@a = ($v1,$v2,$v3)', 741 }, 742 'expr::aassign::llax_3p' => { 743 desc => 'non-empty lexical var and array assigned 3 package vars', 744 setup => '($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;', 745 code => '($x, @a) = ($v1,$v2,$v3)', 746 }, 747 'expr::aassign::3m_3p' => { 748 desc => 'three my vars assigned 3 package vars', 749 setup => '($v1,$v2,$v3) = 1..3;', 750 code => 'my ($x,$y,$z) = ($v1,$v2,$v3)', 751 }, 752 'expr::aassign::3l_3p' => { 753 desc => 'three lexical vars assigned 3 package vars', 754 setup => '($v1,$v2,$v3) = 1..3; my ($x,$y,$z)', 755 code => '($x,$y,$z) = ($v1,$v2,$v3)', 756 }, 757 'expr::aassign::pa_3p' => { 758 desc => 'package array assigned 3 package vars', 759 setup => '($v1,$v2,$v3) = 1..3;', 760 code => '@a = ($v1,$v2,$v3)', 761 }, 762 'expr::aassign::pax_3p' => { 763 desc => 'non-empty package array assigned 3 package vars', 764 setup => '($v1,$v2,$v3) = 1..3; @a = @_', 765 code => '@a = ($v1,$v2,$v3)', 766 }, 767 'expr::aassign::3p_3p' => { 768 desc => 'three package vars assigned 3 package vars', 769 setup => '($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;', 770 code => '($x,$y,$z) = ($v1,$v2,$v3)', 771 }, 772 773 774 # (....) = (1,2,$shared); 775 776 'expr::aassign::llax_2c1s' => { 777 desc => 'non-empty lexical var and array assigned 2 consts and 1 shared var', 778 setup => 'my ($x, @a) = 1..4;', 779 code => '($x, @a) = (1,2,$x)', 780 }, 781 'expr::aassign::3l_2c1s' => { 782 desc => 'three lexical vars assigned 2 consts and 1 shared var', 783 setup => 'my ($x,$y,$z) = 1..3;', 784 code => '($x,$y,$z) = (1,2,$x)', 785 }, 786 'expr::aassign::3p_2c1s' => { 787 desc => 'three package vars assigned 2 consts and 1 shared var', 788 setup => '($x,$y,$z) = 1..3;', 789 code => '($x,$y,$z) = (1,2,$x)', 790 }, 791 792 793 # ($a,$b) = ($b,$a); 794 795 'expr::aassign::2l_swap' => { 796 desc => 'swap two lexical vars', 797 setup => 'my ($a,$b) = (1,2)', 798 code => '($a,$b) = ($b,$a)', 799 }, 800 'expr::aassign::2p_swap' => { 801 desc => 'swap two package vars', 802 setup => '($a,$b) = (1,2)', 803 code => '($a,$b) = ($b,$a)', 804 }, 805 'expr::aassign::2laelem_swap' => { 806 desc => 'swap two lexical vars', 807 setup => 'my @a = (1,2)', 808 code => '($a[0],$a[1]) = ($a[1],$a[0])', 809 }, 810 811 # misc list assign 812 813 'expr::aassign::5l_4l1s' => { 814 desc => 'long list of lexical vars, 1 shared', 815 setup => 'my ($a,$b,$c,$d,$e) = 1..5', 816 code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)', 817 }, 818 819 'expr::aassign::5p_4p1s' => { 820 desc => 'long list of package vars, 1 shared', 821 setup => '($a,$b,$c,$d,$e) = 1..5', 822 code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)', 823 }, 824 'expr::aassign::5l_defary' => { 825 desc => 'long list of lexical vars to assign @_ to', 826 setup => '@_ = 1..5', 827 code => 'my ($a,$b,$c,$d,$e) = @_', 828 }, 829 'expr::aassign::5l1la_defary' => { 830 desc => 'long list of lexical vars plus long slurp to assign @_ to', 831 setup => '@_ = 1..20', 832 code => 'my ($a,$b,$c,$d,$e,@rest) = @_', 833 }, 834 'expr::aassign::1l_2l' => { 835 desc => 'single lexical LHS', 836 setup => 'my $x = 1;', 837 code => '(undef,$x) = ($x,$x)', 838 }, 839 'expr::aassign::2l_1l' => { 840 desc => 'single lexical RHS', 841 setup => 'my $x = 1;', 842 code => '($x,$x) = ($x)', 843 }, 844 'expr::aassign::2l_1ul' => { 845 desc => 'undef and single lexical RHS', 846 setup => 'my $x = 1;', 847 code => '($x,$x) = (undef, $x)', 848 }, 849 850 'expr::aassign::2list_lex' => { 851 desc => 'lexical ($x, $y) = (1, 2)', 852 setup => 'my ($x, $y)', 853 code => '($x, $y) = (1, 2)', 854 }, 855 856 'expr::aassign::lex_rv' => { 857 desc => 'lexical ($ref1, $ref2) = ($ref3, $ref4)', 858 setup => 'my ($r1, $r2, $r3, $r4); 859 ($r1, $r2) = (($r3, $r4) = ([], []));', 860 code => '($r1, $r2) = ($r3, $r4)', 861 }, 862 863 'expr::aassign::lex_rv1' => { 864 desc => 'lexical ($ref1, $ref2) = ($ref3, $ref4) where ref1,2 are freed', 865 setup => 'my ($r1, $r2);', 866 code => '($r1, $r2) = ([], []);', 867 }, 868 869 'expr::aassign::boolean' => { 870 desc => '!(@a = @b)', 871 setup => 'my ($s,@a, @b); @b = (1,2)', 872 code => '!(@a = @b);', 873 }, 874 'expr::aassign::scalar' => { 875 desc => '$scalar = (@a = @b)', 876 setup => 'my ($s, @a, @b); @b = (1,2)', 877 code => '$s = (@a = @b);', 878 }, 879 880 # array assign of strings 881 882 'expr::aassign::la_3s' => { 883 desc => 'assign 3 strings to empty lexical array', 884 setup => 'my @a', 885 code => '@a = (); @a = qw(abc defg hijkl);', 886 }, 887 'expr::aassign::la_3ts' => { 888 desc => 'assign 3 temp strings to empty lexical array', 889 setup => 'my @a', 890 code => '@a = (); @a = map $_, qw(abc defg hijkl);', 891 }, 892 'expr::aassign::lan_3s' => { 893 desc => 'assign 3 strings to non-empty lexical array', 894 setup => 'my @a = qw(abc defg hijkl)', 895 code => '@a = qw(abc defg hijkl);', 896 }, 897 'expr::aassign::lan_3ts' => { 898 desc => 'assign 3 temp strings to non-empty lexical array', 899 setup => 'my @a = qw(abc defg hijkl)', 900 code => '@a = map $_, qw(abc defg hijkl);', 901 }, 902 903 # hash assign of strings 904 905 'expr::aassign::lh_2s' => { 906 desc => 'assign 2 strings to empty lexical hash', 907 setup => 'my %h', 908 code => '%h = (); %h = qw(k1 abc k2 defg);', 909 }, 910 'expr::aassign::lh_2ts' => { 911 desc => 'assign 2 temp strings to empty lexical hash', 912 setup => 'my %h', 913 code => '%h = (); %h = map $_, qw(k1 abc k2 defg);', 914 }, 915 'expr::aassign::lhn_2s' => { 916 desc => 'assign 2 strings to non-empty lexical hash', 917 setup => 'my %h = qw(k1 abc k2 defg);', 918 code => '%h = qw(k1 abc k2 defg);', 919 }, 920 'expr::aassign::lhn_2ts' => { 921 desc => 'assign 2 temp strings to non-empty lexical hash', 922 setup => 'my %h = qw(k1 abc k2 defg);', 923 code => '%h = map $_, qw(k1 abc k2 defg);', 924 }, 925 926 927 'expr::arith::add_lex_ii' => { 928 desc => 'add two integers and assign to a lexical var', 929 setup => 'my ($x,$y,$z) = 1..3;', 930 code => '$z = $x + $y', 931 }, 932 'expr::arith::add_pkg_ii' => { 933 desc => 'add two integers and assign to a package var', 934 setup => 'my ($x,$y) = 1..2; $z = 3;', 935 code => '$z = $x + $y', 936 }, 937 'expr::arith::add_lex_nn' => { 938 desc => 'add two NVs and assign to a lexical var', 939 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 940 code => '$z = $x + $y', 941 }, 942 'expr::arith::add_pkg_nn' => { 943 desc => 'add two NVs and assign to a package var', 944 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 945 code => '$z = $x + $y', 946 }, 947 'expr::arith::add_lex_ni' => { 948 desc => 'add an int and an NV and assign to a lexical var', 949 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 950 code => '$z = $x + $y', 951 }, 952 'expr::arith::add_pkg_ni' => { 953 desc => 'add an int and an NV and assign to a package var', 954 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 955 code => '$z = $x + $y', 956 }, 957 'expr::arith::add_lex_ss' => { 958 desc => 'add two short strings and assign to a lexical var', 959 setup => 'my ($x,$y,$z) = ("1", "2", 1);', 960 code => '$z = $x + $y; $x = "1"; ', 961 }, 962 963 'expr::arith::add_lex_ll' => { 964 desc => 'add two long strings and assign to a lexical var', 965 setup => 'my ($x,$y,$z) = ("12345", "23456", 1);', 966 code => '$z = $x + $y; $x = "12345"; ', 967 }, 968 969 'expr::arith::sub_lex_ii' => { 970 desc => 'subtract two integers and assign to a lexical var', 971 setup => 'my ($x,$y,$z) = 1..3;', 972 code => '$z = $x - $y', 973 }, 974 'expr::arith::sub_pkg_ii' => { 975 desc => 'subtract two integers and assign to a package var', 976 setup => 'my ($x,$y) = 1..2; $z = 3;', 977 code => '$z = $x - $y', 978 }, 979 'expr::arith::sub_lex_nn' => { 980 desc => 'subtract two NVs and assign to a lexical var', 981 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 982 code => '$z = $x - $y', 983 }, 984 'expr::arith::sub_pkg_nn' => { 985 desc => 'subtract two NVs and assign to a package var', 986 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 987 code => '$z = $x - $y', 988 }, 989 'expr::arith::sub_lex_ni' => { 990 desc => 'subtract an int and an NV and assign to a lexical var', 991 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 992 code => '$z = $x - $y', 993 }, 994 'expr::arith::sub_pkg_ni' => { 995 desc => 'subtract an int and an NV and assign to a package var', 996 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 997 code => '$z = $x - $y', 998 }, 999 1000 'expr::arith::mult_lex_ii' => { 1001 desc => 'multiply two integers and assign to a lexical var', 1002 setup => 'my ($x,$y,$z) = 1..3;', 1003 code => '$z = $x * $y', 1004 }, 1005 'expr::arith::mult_pkg_ii' => { 1006 desc => 'multiply two integers and assign to a package var', 1007 setup => 'my ($x,$y) = 1..2; $z = 3;', 1008 code => '$z = $x * $y', 1009 }, 1010 'expr::arith::mult_lex_nn' => { 1011 desc => 'multiply two NVs and assign to a lexical var', 1012 setup => 'my ($x,$y,$z) = (1.1, 2.2, 3.3);', 1013 code => '$z = $x * $y', 1014 }, 1015 'expr::arith::mult_pkg_nn' => { 1016 desc => 'multiply two NVs and assign to a package var', 1017 setup => 'my ($x,$y); ($x,$y,$z) = (1.1, 2.2, 3.3);', 1018 code => '$z = $x * $y', 1019 }, 1020 'expr::arith::mult_lex_ni' => { 1021 desc => 'multiply an int and an NV and assign to a lexical var', 1022 setup => 'my ($x,$y,$z) = (1, 2.2, 3.3);', 1023 code => '$z = $x * $y', 1024 }, 1025 'expr::arith::mult_pkg_ni' => { 1026 desc => 'multiply an int and an NV and assign to a package var', 1027 setup => 'my ($x,$y); ($x,$y,$z) = (1, 2.2, 3.3);', 1028 code => '$z = $x * $y', 1029 }, 1030 1031 # use '!' to test SvTRUE on various classes of value 1032 1033 'expr::arith::not_PL_undef' => { 1034 desc => '!undef (using PL_sv_undef)', 1035 setup => 'my $x', 1036 code => '$x = !undef', 1037 }, 1038 'expr::arith::not_PL_no' => { 1039 desc => '!($x == $y) (using PL_sv_no)', 1040 setup => 'my ($x, $y) = (1,2); my $z;', 1041 code => '$z = !($x == $y)', 1042 }, 1043 'expr::arith::not_PL_zero' => { 1044 desc => '!%h (using PL_sv_zero)', 1045 setup => 'my ($x, %h)', 1046 code => '$x = !%h', 1047 }, 1048 'expr::arith::not_PL_yes' => { 1049 desc => '!($x == $y) (using PL_sv_yes)', 1050 setup => 'my ($x, $y) = (1,1); my $z;', 1051 code => '$z = !($x == $y)', 1052 }, 1053 'expr::arith::not_undef' => { 1054 desc => '!$y where $y is undef', 1055 setup => 'my ($x, $y)', 1056 code => '$x = !$y', 1057 }, 1058 'expr::arith::not_0' => { 1059 desc => '!$x where $x is 0', 1060 setup => 'my ($x, $y) = (0, 0)', 1061 code => '$y = !$x', 1062 }, 1063 'expr::arith::not_1' => { 1064 desc => '!$x where $x is 1', 1065 setup => 'my ($x, $y) = (1, 0)', 1066 code => '$y = !$x', 1067 }, 1068 'expr::arith::not_string' => { 1069 desc => '!$x where $x is "foo"', 1070 setup => 'my ($x, $y) = ("foo", 0)', 1071 code => '$y = !$x', 1072 }, 1073 'expr::arith::not_ref' => { 1074 desc => '!$x where $s is an array ref', 1075 setup => 'my ($x, $y) = ([], 0)', 1076 code => '$y = !$x', 1077 }, 1078 1079 'expr::arith::preinc' => { 1080 setup => 'my $x = 1;', 1081 code => '++$x', 1082 }, 1083 'expr::arith::predec' => { 1084 setup => 'my $x = 1;', 1085 code => '--$x', 1086 }, 1087 'expr::arith::postinc' => { 1088 desc => '$x++', 1089 setup => 'my $x = 1; my $y', 1090 code => '$y = $x++', # scalar context so not optimised to ++$x 1091 }, 1092 'expr::arith::postdec' => { 1093 desc => '$x--', 1094 setup => 'my $x = 1; my $y', 1095 code => '$y = $x--', # scalar context so not optimised to --$x 1096 }, 1097 1098 1099 # concatenation; quite possibly optimised to OP_MULTICONCAT 1100 1101 'expr::concat::cl' => { 1102 setup => 'my $lex = "abcd"', 1103 code => '"foo" . $lex', 1104 }, 1105 'expr::concat::lc' => { 1106 setup => 'my $lex = "abcd"', 1107 code => '$lex . "foo"', 1108 }, 1109 'expr::concat::ll' => { 1110 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1111 code => '$lex1 . $lex2', 1112 }, 1113 1114 'expr::concat::l_append_c' => { 1115 setup => 'my $lex', 1116 pre => '$lex = "abcd"', 1117 code => '$lex .= "foo"', 1118 }, 1119 'expr::concat::l_append_l' => { 1120 setup => 'my $lex1; my $lex2 = "wxyz"', 1121 pre => '$lex1 = "abcd"', 1122 code => '$lex1 .= $lex2', 1123 }, 1124 'expr::concat::l_append_ll' => { 1125 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1126 pre => '$lex1 = "abcd"', 1127 code => '$lex1 .= $lex2 . $lex3', 1128 }, 1129 'expr::concat::l_append_clclc' => { 1130 setup => 'my $lex1; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1131 pre => '$lex1 = "abcd"', 1132 code => '$lex1 .= "-foo-$lex2-foo-$lex3-foo"', 1133 }, 1134 'expr::concat::l_append_lll' => { 1135 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(pqrs wxyz 1234)', 1136 pre => '$lex1 = "abcd"', 1137 code => '$lex1 .= $lex2 . $lex3 . $lex4', 1138 }, 1139 1140 'expr::concat::m_ll' => { 1141 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1142 code => 'my $lex = $lex1 . $lex2', 1143 }, 1144 'expr::concat::m_lll' => { 1145 setup => 'my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1146 code => 'my $lex = $lex1 . $lex2 . $lex3', 1147 }, 1148 'expr::concat::m_cl' => { 1149 setup => 'my $lex1 = "abcd"', 1150 code => 'my $lex = "const$lex1"', 1151 }, 1152 'expr::concat::m_clclc' => { 1153 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1154 code => 'my $lex = "foo=$lex1 bar=$lex2\n"', 1155 }, 1156 'expr::concat::m_clclc_long' => { 1157 desc => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1158 setup => 'my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1159 code => 'my $lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1160 }, 1161 1162 'expr::concat::l_ll' => { 1163 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1164 code => '$lex = $lex1 . $lex2', 1165 }, 1166 'expr::concat::l_ll_ldup' => { 1167 setup => 'my $lex1; my $lex2 = "wxyz"', 1168 pre => '$lex1 = "abcd"', 1169 code => '$lex1 = $lex1 . $lex2', 1170 }, 1171 'expr::concat::l_ll_rdup' => { 1172 setup => 'my $lex1; my $lex2 = "wxyz"', 1173 pre => '$lex1 = "abcd"', 1174 code => '$lex1 = $lex2 . $lex1', 1175 }, 1176 'expr::concat::l_ll_lrdup' => { 1177 setup => 'my $lex1', 1178 pre => '$lex1 = "abcd"', 1179 code => '$lex1 = $lex1 . $lex1', 1180 }, 1181 'expr::concat::l_lll' => { 1182 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1183 code => '$lex = $lex1 . $lex2 . $lex3', 1184 }, 1185 'expr::concat::l_lllll' => { 1186 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..."', 1187 code => '$lex = $lex1 . $lex2 . $lex3 . $lex4 . $lex5', 1188 }, 1189 'expr::concat::l_cl' => { 1190 setup => 'my $lex; my $lex1 = "abcd"', 1191 code => '$lex = "const$lex1"', 1192 }, 1193 'expr::concat::l_clclc' => { 1194 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1195 code => '$lex = "foo=$lex1 bar=$lex2\n"', 1196 }, 1197 'expr::concat::l_clclc_long' => { 1198 desc => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1199 setup => 'my $lex; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1200 code => '$lex = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1201 }, 1202 'expr::concat::l_clclclclclc' => { 1203 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "the quick brown fox"; my $lex4 = "to be, or not to be..."', 1204 code => '$lex = "foo1=$lex1 foo2=$lex2 foo3=$lex3 foo4=$lex4\n"', 1205 }, 1206 1207 'expr::concat::g_append_c' => { 1208 setup => 'our $pkg', 1209 pre => '$pkg = "abcd"', 1210 code => '$pkg .= "foo"', 1211 }, 1212 'expr::concat::g_append_l' => { 1213 setup => 'our $pkg; my $lex1 = "wxyz"', 1214 pre => '$pkg = "abcd"', 1215 code => '$pkg .= $lex1', 1216 }, 1217 'expr::concat::g_append_ll' => { 1218 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1219 pre => '$pkg = "abcd"', 1220 code => '$pkg .= $lex1 . $lex2', 1221 }, 1222 'expr::concat::g_append_clclc' => { 1223 setup => 'our $pkg; my $lex1 = "pqrs"; my $lex2 = "wxyz"', 1224 pre => '$pkg = "abcd"', 1225 code => '$pkg .= "-foo-$lex1-foo-$lex2-foo-"', 1226 }, 1227 1228 'expr::concat::g_ll' => { 1229 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1230 code => '$pkg = $lex1 . $lex2', 1231 }, 1232 'expr::concat::g_gl_ldup' => { 1233 setup => 'our $pkg; my $lex2 = "wxyz"', 1234 pre => '$pkg = "abcd"', 1235 code => '$pkg = $pkg . $lex2', 1236 }, 1237 'expr::concat::g_lg_rdup' => { 1238 setup => 'our $pkg; my $lex1 = "wxyz"', 1239 pre => '$pkg = "abcd"', 1240 code => '$pkg = $lex1 . $pkg', 1241 }, 1242 'expr::concat::g_gg_lrdup' => { 1243 setup => 'our $pkg', 1244 pre => '$pkg = "abcd"', 1245 code => '$pkg = $pkg . $pkg', 1246 }, 1247 'expr::concat::g_lll' => { 1248 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "pqrs"; my $lex3 = "wxyz"', 1249 code => '$pkg = $lex1 . $lex2 . $lex3', 1250 }, 1251 'expr::concat::g_cl' => { 1252 setup => 'our $pkg; my $lex1 = "abcd"', 1253 code => '$pkg = "const$lex1"', 1254 }, 1255 'expr::concat::g_clclc' => { 1256 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1257 code => '$pkg = "foo=$lex1 bar=$lex2\n"', 1258 }, 1259 'expr::concat::g_clclc_long' => { 1260 desc => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n" where lex1/2 are 400 chars', 1261 setup => 'our $pkg; my $lex1 = "abcd" x 100; my $lex2 = "wxyz" x 100', 1262 code => '$pkg = "foooooooooo=$lex1 baaaaaaaaar=$lex2\n"', 1263 }, 1264 1265 'expr::concat::utf8_uuu' => { 1266 desc => 'my $s = $a.$b.$c where all args are utf8', 1267 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1268 code => '$s = $a.$b.$c', 1269 }, 1270 'expr::concat::utf8_suu' => { 1271 desc => 'my $s = "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1272 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1273 code => '$s = "foo=$a bar=$b baz=$c"', 1274 }, 1275 'expr::concat::utf8_usu' => { 1276 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1277 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1278 code => '$s = "foo=$a bar=$b baz=$c"', 1279 }, 1280 'expr::concat::utf8_usx' => { 1281 desc => 'my $s = "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1282 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1283 code => '$s = "foo=$a bar=$b baz=$c"', 1284 }, 1285 1286 'expr::concat::utf8_s_append_uuu' => { 1287 desc => '$s .= $a.$b.$c where all RH args are utf8', 1288 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1289 pre => '$s = "abcd"', 1290 code => '$s .= $a.$b.$c', 1291 }, 1292 'expr::concat::utf8_s_append_suu' => { 1293 desc => '$s .= "foo=$a bar=$b baz=$c" where $b,$c are utf8', 1294 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1295 pre => '$s = "abcd"', 1296 code => '$s .= "foo=$a bar=$b baz=$c"', 1297 }, 1298 'expr::concat::utf8_s_append_usu' => { 1299 desc => '$s .= "foo=$a bar=$b baz=$c" where $a,$c are utf8', 1300 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "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_usx' => { 1305 desc => '$s .= "foo=$a bar=$b baz=$c" where $a is utf8, $c has 0x80', 1306 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1307 pre => '$s = "abcd"', 1308 code => '$s .= "foo=$a bar=$b baz=$c"', 1309 }, 1310 1311 'expr::concat::utf8_u_append_uuu' => { 1312 desc => '$s .= $a.$b.$c where all args are utf8', 1313 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "\x{101}fghij"; my $c = "\x{102}klmn"', 1314 pre => '$s = "\x{100}wxyz"', 1315 code => '$s .= $a.$b.$c', 1316 }, 1317 'expr::concat::utf8_u_append_suu' => { 1318 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$b,$c are utf8', 1319 setup => 'my $s; my $a = "abcde"; my $b = "\x{100}fghij"; my $c = "\x{101}klmn"', 1320 pre => '$s = "\x{100}wxyz"', 1321 code => '$s .= "foo=$a bar=$b baz=$c"', 1322 }, 1323 'expr::concat::utf8_u_append_usu' => { 1324 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a,$c are utf8', 1325 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "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_usx' => { 1330 desc => '$s .= "foo=$a bar=$b baz=$c" where $s,$a are utf8, $c has 0x80', 1331 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x80\x81klmn"', 1332 pre => '$s = "\x{100}wxyz"', 1333 code => '$s .= "foo=$a bar=$b baz=$c"', 1334 }, 1335 1336 'expr::concat::nested_mutator' => { 1337 setup => 'my $lex1; my ($lex2, $lex3, $lex4) = qw(abcd pqrs wxyz)', 1338 pre => '$lex1 = "QPR"', 1339 code => '(($lex1 .= $lex2) .= $lex3) .= $lex4', 1340 }, 1341 1342 1343 # scalar assign, OP_SASSIGN 1344 1345 1346 'expr::sassign::my_conststr' => { 1347 setup => '', 1348 code => 'my $x = "abc"', 1349 }, 1350 'expr::sassign::scalar_lex_int' => { 1351 desc => 'lexical $x = 1', 1352 setup => 'my $x', 1353 code => '$x = 1', 1354 }, 1355 'expr::sassign::scalar_lex_str' => { 1356 desc => 'lexical $x = "abc"', 1357 setup => 'my $x', 1358 code => '$x = "abc"', 1359 }, 1360 'expr::sassign::scalar_lex_strint' => { 1361 desc => 'lexical $x = 1 where $x was previously a string', 1362 setup => 'my $x = "abc"', 1363 code => '$x = 1', 1364 }, 1365 'expr::sassign::scalar_lex_intstr' => { 1366 desc => 'lexical $x = "abc" where $x was previously an int', 1367 setup => 'my $x = 1;', 1368 code => '$x = "abc"', 1369 }, 1370 'expr::sassign::lex_rv' => { 1371 desc => 'lexical $ref1 = $ref2;', 1372 setup => 'my $r1 = []; my $r = $r1;', 1373 code => '$r = $r1;', 1374 }, 1375 'expr::sassign::lex_rv1' => { 1376 desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', 1377 setup => 'my $r1 = []; my $r', 1378 code => '$r = []; $r = $r1;', 1379 }, 1380 1381 1382 'func::grep::bool0' => { 1383 desc => 'grep returning 0 items in boolean context', 1384 setup => 'my @a;', 1385 code => '!grep $_, @a;', 1386 }, 1387 'func::grep::bool1' => { 1388 desc => 'grep returning 1 item in boolean context', 1389 setup => 'my @a =(1);', 1390 code => '!grep $_, @a;', 1391 }, 1392 'func::grep::scalar0' => { 1393 desc => 'returning 0 items in scalar context', 1394 setup => 'my $g; my @a;', 1395 code => '$g = grep $_, @a;', 1396 }, 1397 'func::grep::scalar1' => { 1398 desc => 'returning 1 item in scalar context', 1399 setup => 'my $g; my @a =(1);', 1400 code => '$g = grep $_, @a;', 1401 }, 1402 1403 # (index() == -1) and variants optimise away the op_const and op_eq 1404 # and any assignment to a lexical var 1405 'func::index::bool' => { 1406 desc => '(index() == -1) for match', 1407 setup => 'my $x = "aaaab"', 1408 code => 'index($x, "b") == -1', 1409 }, 1410 'func::index::bool_fail' => { 1411 desc => '(index() == -1) for no match', 1412 setup => 'my $x = "aaaab"', 1413 code => 'index($x, "c") == -1', 1414 }, 1415 'func::index::lex_bool' => { 1416 desc => '$lex = (index() == -1) for match', 1417 setup => 'my $r; my $x = "aaaab"', 1418 code => '$r = index($x, "b") == -1', 1419 }, 1420 'func::index::lex_bool_fail' => { 1421 desc => '$lex = (index() == -1) for no match', 1422 setup => 'my $r; my $x = "aaaab"', 1423 code => '$r = index($x, "c") == -1', 1424 }, 1425 1426 # using a const string as second arg to index triggers using FBM. 1427 # the FBM matcher special-cases 1,2-byte strings. 1428 # 1429 'func::index::short_const1' => { 1430 desc => 'index of a short string against a 1 char const substr', 1431 setup => 'my $x = "aaaab"', 1432 code => 'index $x, "b"', 1433 }, 1434 'func::index::long_const1' => { 1435 desc => 'index of a long string against a 1 char const substr', 1436 setup => 'my $x = "a" x 1000 . "b"', 1437 code => 'index $x, "b"', 1438 }, 1439 'func::index::short_const2aabc_bc' => { 1440 desc => 'index of a short string against a 2 char const substr', 1441 setup => 'my $x = "aaaabc"', 1442 code => 'index $x, "bc"', 1443 }, 1444 'func::index::long_const2aabc_bc' => { 1445 desc => 'index of a long string against a 2 char const substr', 1446 setup => 'my $x = "a" x 1000 . "bc"', 1447 code => 'index $x, "bc"', 1448 }, 1449 'func::index::long_const2aa_ab' => { 1450 desc => 'index of a long string aaa.. against const substr "ab"', 1451 setup => 'my $x = "a" x 1000', 1452 code => 'index $x, "ab"', 1453 }, 1454 'func::index::long_const2bb_ab' => { 1455 desc => 'index of a long string bbb.. against const substr "ab"', 1456 setup => 'my $x = "b" x 1000', 1457 code => 'index $x, "ab"', 1458 }, 1459 'func::index::long_const2aa_bb' => { 1460 desc => 'index of a long string aaa.. against const substr "bb"', 1461 setup => 'my $x = "a" x 1000', 1462 code => 'index $x, "bb"', 1463 }, 1464 # this one is designed to be pathological 1465 'func::index::long_const2ab_aa' => { 1466 desc => 'index of a long string abab.. against const substr "aa"', 1467 setup => 'my $x = "ab" x 500', 1468 code => 'index $x, "aa"', 1469 }, 1470 # near misses with gaps, 1st letter 1471 'func::index::long_const2aaxx_xy' => { 1472 desc => 'index of a long string with "xx"s against const substr "xy"', 1473 setup => 'my $x = "aaaaaaaaxx" x 100', 1474 code => 'index $x, "xy"', 1475 }, 1476 # near misses with gaps, 2nd letter 1477 'func::index::long_const2aayy_xy' => { 1478 desc => 'index of a long string with "yy"s against const substr "xy"', 1479 setup => 'my $x = "aaaaaaaayy" x 100', 1480 code => 'index $x, "xy"', 1481 }, 1482 # near misses with gaps, duplicate letter 1483 'func::index::long_const2aaxy_xx' => { 1484 desc => 'index of a long string with "xy"s against const substr "xx"', 1485 setup => 'my $x = "aaaaaaaaxy" x 100', 1486 code => 'index $x, "xx"', 1487 }, 1488 # alternating near misses with gaps 1489 'func::index::long_const2aaxxaayy_xy' => { 1490 desc => 'index of a long string with "xx/yy"s against const substr "xy"', 1491 setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', 1492 code => 'index $x, "xy"', 1493 }, 1494 'func::index::short_const3aabcd_bcd' => { 1495 desc => 'index of a short string against a 3 char const substr', 1496 setup => 'my $x = "aaaabcd"', 1497 code => 'index $x, "bcd"', 1498 }, 1499 'func::index::long_const3aabcd_bcd' => { 1500 desc => 'index of a long string against a 3 char const substr', 1501 setup => 'my $x = "a" x 1000 . "bcd"', 1502 code => 'index $x, "bcd"', 1503 }, 1504 'func::index::long_const3ab_abc' => { 1505 desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', 1506 setup => 'my $x = "ab" x 500', 1507 code => 'index $x, "abc"', 1508 }, 1509 'func::index::long_const3bc_abc' => { 1510 desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', 1511 setup => 'my $x = "bc" x 500', 1512 code => 'index $x, "abc"', 1513 }, 1514 'func::index::utf8_position_1' => { 1515 desc => 'index of a utf8 string, matching at position 1', 1516 setup => 'my $x = "abc". chr(0x100); chop $x', 1517 code => 'index $x, "b"', 1518 }, 1519 1520 1521 # JOIN 1522 1523 1524 'func::join::empty_l_ll' => { 1525 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1526 code => '$lex = join "", $lex1, $lex2', 1527 }, 1528 1529 1530 # KEYS 1531 1532 1533 'func::keys::lex::void_cxt_empty' => { 1534 desc => ' keys() on an empty lexical hash in void context', 1535 setup => 'my %h = ()', 1536 code => 'keys %h', 1537 }, 1538 'func::keys::lex::void_cxt' => { 1539 desc => ' keys() on a non-empty lexical hash in void context', 1540 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1541 code => 'keys %h', 1542 }, 1543 'func::keys::lex::bool_cxt_empty' => { 1544 desc => ' keys() on an empty lexical hash in bool context', 1545 setup => 'my %h = ()', 1546 code => '!keys %h', 1547 }, 1548 'func::keys::lex::bool_cxt' => { 1549 desc => ' keys() on a non-empty lexical hash in bool context', 1550 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1551 code => '!keys %h', 1552 }, 1553 'func::keys::lex::scalar_cxt_empty' => { 1554 desc => ' keys() on an empty lexical hash in scalar context', 1555 setup => 'my $k; my %h = ()', 1556 code => '$k = keys %h', 1557 }, 1558 'func::keys::lex::scalar_cxt' => { 1559 desc => ' keys() on a non-empty lexical hash in scalar context', 1560 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1561 code => '$k = keys %h', 1562 }, 1563 'func::keys::lex::list_cxt_empty' => { 1564 desc => ' keys() on an empty lexical hash in list context', 1565 setup => 'my %h = ()', 1566 code => '() = keys %h', 1567 }, 1568 'func::keys::lex::list_cxt' => { 1569 desc => ' keys() on a non-empty lexical hash in list context', 1570 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1571 code => '() = keys %h', 1572 }, 1573 1574 'func::keys::pkg::void_cxt_empty' => { 1575 desc => ' keys() on an empty package hash in void context', 1576 setup => 'our %h = ()', 1577 code => 'keys %h', 1578 }, 1579 'func::keys::pkg::void_cxt' => { 1580 desc => ' keys() on a non-empty package hash in void context', 1581 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1582 code => 'keys %h', 1583 }, 1584 'func::keys::pkg::bool_cxt_empty' => { 1585 desc => ' keys() on an empty package hash in bool context', 1586 setup => 'our %h = ()', 1587 code => '!keys %h', 1588 }, 1589 'func::keys::pkg::bool_cxt' => { 1590 desc => ' keys() on a non-empty package hash in bool context', 1591 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1592 code => '!keys %h', 1593 }, 1594 'func::keys::pkg::scalar_cxt_empty' => { 1595 desc => ' keys() on an empty package hash in scalar context', 1596 setup => 'my $k; our %h = ()', 1597 code => '$k = keys %h', 1598 }, 1599 'func::keys::pkg::scalar_cxt' => { 1600 desc => ' keys() on a non-empty package hash in scalar context', 1601 setup => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)', 1602 code => '$k = keys %h', 1603 }, 1604 'func::keys::pkg::list_cxt_empty' => { 1605 desc => ' keys() on an empty package hash in list context', 1606 setup => 'our %h = ()', 1607 code => '() = keys %h', 1608 }, 1609 'func::keys::pkg::list_cxt' => { 1610 desc => ' keys() on a non-empty package hash in list context', 1611 setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)', 1612 code => '() = keys %h', 1613 }, 1614 1615 1616 'func::length::bool0' => { 1617 desc => 'length==0 in boolean context', 1618 setup => 'my $s = "";', 1619 code => '!length($s);', 1620 }, 1621 'func::length::bool10' => { 1622 desc => 'length==10 in boolean context', 1623 setup => 'my $s = "abcdefghijk";', 1624 code => '!length($s);', 1625 }, 1626 'func::length::scalar10' => { 1627 desc => 'length==10 in scalar context', 1628 setup => 'my $p; my $s = "abcdefghijk";', 1629 code => '$p = length($s);', 1630 }, 1631 'func::length::bool0_utf8' => { 1632 desc => 'utf8 string length==0 in boolean context', 1633 setup => 'my $s = "\x{100}"; chop $s;', 1634 code => '!length($s);', 1635 }, 1636 'func::length::bool10_utf8' => { 1637 desc => 'utf8 string length==10 in boolean context', 1638 setup => 'my $s = "abcdefghij\x{100}";', 1639 code => '!length($s);', 1640 }, 1641 'func::length::scalar10_utf8' => { 1642 desc => 'utf8 string length==10 in scalar context', 1643 setup => 'my $p; my $s = "abcdefghij\x{100}";', 1644 code => '$p = length($s);', 1645 }, 1646 1647 'func::pos::bool0' => { 1648 desc => 'pos==0 in boolean context', 1649 setup => 'my $s = "abc"; pos($s) = 0', 1650 code => '!pos($s);', 1651 }, 1652 'func::pos::bool10' => { 1653 desc => 'pos==10 in boolean context', 1654 setup => 'my $s = "abcdefghijk"; pos($s) = 10', 1655 code => '!pos($s);', 1656 }, 1657 'func::pos::scalar10' => { 1658 desc => 'pos==10 in scalar context', 1659 setup => 'my $p; my $s = "abcdefghijk"; pos($s) = 10', 1660 code => '$p = pos($s);', 1661 }, 1662 1663 'func::ref::notaref_bool' => { 1664 desc => 'ref($notaref) in boolean context', 1665 setup => 'my $r = "boo"', 1666 code => '!ref $r', 1667 }, 1668 'func::ref::ref_bool' => { 1669 desc => 'ref($ref) in boolean context', 1670 setup => 'my $r = []', 1671 code => '!ref $r', 1672 }, 1673 'func::ref::blessedref_bool' => { 1674 desc => 'ref($blessed_ref) in boolean context', 1675 setup => 'my $r = bless []', 1676 code => '!ref $r', 1677 }, 1678 1679 'func::ref::notaref' => { 1680 desc => 'ref($notaref) in scalar context', 1681 setup => 'my $x; my $r = "boo"', 1682 code => '$x = ref $r', 1683 }, 1684 'func::ref::ref' => { 1685 desc => 'ref($ref) in scalar context', 1686 setup => 'my $x; my $r = []', 1687 code => '$x = ref $r', 1688 }, 1689 'func::ref::blessedref' => { 1690 desc => 'ref($blessed_ref) in scalar context', 1691 setup => 'my $x; my $r = bless []', 1692 code => '$x = ref $r', 1693 }, 1694 1695 1696 1697 'func::sort::num' => { 1698 desc => 'plain numeric sort', 1699 setup => 'my (@a, @b); @a = reverse 1..10;', 1700 code => '@b = sort { $a <=> $b } @a', 1701 }, 1702 'func::sort::num_block' => { 1703 desc => 'codeblock numeric sort', 1704 setup => 'my (@a, @b); @a = reverse 1..10;', 1705 code => '@b = sort { $a + 1 <=> $b + 1 } @a', 1706 }, 1707 'func::sort::num_fn' => { 1708 desc => 'function numeric sort', 1709 setup => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;', 1710 code => '@b = sort f @a', 1711 }, 1712 'func::sort::str' => { 1713 desc => 'plain string sort', 1714 setup => 'my (@a, @b); @a = reverse "a".."j";', 1715 code => '@b = sort { $a cmp $b } @a', 1716 }, 1717 'func::sort::str_block' => { 1718 desc => 'codeblock string sort', 1719 setup => 'my (@a, @b); @a = reverse "a".."j";', 1720 code => '@b = sort { ($a . "") cmp ($b . "") } @a', 1721 }, 1722 'func::sort::str_fn' => { 1723 desc => 'function string sort', 1724 setup => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse "a".."j";', 1725 code => '@b = sort f @a', 1726 }, 1727 1728 'func::sort::num_inplace' => { 1729 desc => 'plain numeric sort in-place', 1730 setup => 'my @a = reverse 1..10;', 1731 code => '@a = sort { $a <=> $b } @a', 1732 }, 1733 'func::sort::num_block_inplace' => { 1734 desc => 'codeblock numeric sort in-place', 1735 setup => 'my @a = reverse 1..10;', 1736 code => '@a = sort { $a + 1 <=> $b + 1 } @a', 1737 }, 1738 'func::sort::num_fn_inplace' => { 1739 desc => 'function numeric sort in-place', 1740 setup => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;', 1741 code => '@a = sort f @a', 1742 }, 1743 'func::sort::str_inplace' => { 1744 desc => 'plain string sort in-place', 1745 setup => 'my @a = reverse "a".."j";', 1746 code => '@a = sort { $a cmp $b } @a', 1747 }, 1748 'func::sort::str_block_inplace' => { 1749 desc => 'codeblock string sort in-place', 1750 setup => 'my @a = reverse "a".."j";', 1751 code => '@a = sort { ($a . "") cmp ($b . "") } @a', 1752 }, 1753 'func::sort::str_fn_inplace' => { 1754 desc => 'function string sort in-place', 1755 setup => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse "a".."j";', 1756 code => '@a = sort f @a', 1757 }, 1758 1759 1760 'func::split::vars' => { 1761 desc => 'split into two lexical vars', 1762 setup => 'my $s = "abc:def";', 1763 code => 'my ($x, $y) = split /:/, $s, 2;', 1764 }, 1765 1766 'func::split::array' => { 1767 desc => 'split into a lexical array', 1768 setup => 'my @a; my $s = "abc:def";', 1769 code => '@a = split /:/, $s, 2;', 1770 }, 1771 'func::split::myarray' => { 1772 desc => 'split into a lexical array declared in the assign', 1773 setup => 'my $s = "abc:def";', 1774 code => 'my @a = split /:/, $s, 2;', 1775 }, 1776 'func::split::arrayexpr' => { 1777 desc => 'split into an @{$expr} ', 1778 setup => 'my $s = "abc:def"; my $r = []', 1779 code => '@$r = split /:/, $s, 2;', 1780 }, 1781 'func::split::arraylist' => { 1782 desc => 'split into an array with extra arg', 1783 setup => 'my @a; my $s = "abc:def";', 1784 code => '@a = (split(/:/, $s, 2), 1);', 1785 }, 1786 1787 # SPRINTF 1788 1789 1790 'func::sprintf::d' => { 1791 desc => '%d', 1792 setup => 'my $s; my $a1 = 1234;', 1793 code => '$s = sprintf "%d", $a1', 1794 }, 1795 'func::sprintf::d8' => { 1796 desc => '%8d', 1797 setup => 'my $s; my $a1 = 1234;', 1798 code => '$s = sprintf "%8d", $a1', 1799 }, 1800 'func::sprintf::foo_d8' => { 1801 desc => 'foo=%8d', 1802 setup => 'my $s; my $a1 = 1234;', 1803 code => '$s = sprintf "foo=%8d", $a1', 1804 }, 1805 1806 'func::sprintf::f0' => { 1807 # "%.0f" is very special-cased 1808 desc => 'sprintf "%.0f"', 1809 setup => 'my $s; my $a1 = 123.456;', 1810 code => '$s = sprintf "%.0f", $a1', 1811 }, 1812 'func::sprintf::foo_f0' => { 1813 # "...%.0f..." is special-cased 1814 desc => 'sprintf "foo=%.0f"', 1815 setup => 'my $s; my $a1 = 123.456;', 1816 code => '$s = sprintf "foo=%.0f\n", $a1', 1817 }, 1818 'func::sprintf::foo_f93' => { 1819 desc => 'foo=%9.3f', 1820 setup => 'my $s; my $a1 = 123.456;', 1821 code => '$s = sprintf "foo=%9.3f\n", $a1', 1822 }, 1823 1824 'func::sprintf::g9' => { 1825 # "...%.NNNg..." is special-cased 1826 desc => '%.9g', 1827 setup => 'my $s; my $a1 = 123.456;', 1828 code => '$s = sprintf "%.9g", $a1', 1829 }, 1830 'func::sprintf::foo_g9' => { 1831 # "...%.NNNg..." is special-cased 1832 desc => 'foo=%.9g', 1833 setup => 'my $s; my $a1 = 123.456;', 1834 code => '$s = sprintf "foo=%.9g\n", $a1', 1835 }, 1836 'func::sprintf::foo_g93' => { 1837 desc => 'foo=%9.3g', 1838 setup => 'my $s; my $a1 = 123.456;', 1839 code => '$s = sprintf "foo=%9.3g\n", $a1', 1840 }, 1841 1842 'func::sprintf::s' => { 1843 desc => '%s', 1844 setup => 'my $s; my $a1 = "abcd";', 1845 code => '$s = sprintf "%s", $a1', 1846 }, 1847 'func::sprintf::foo_s' => { 1848 desc => 'foo=%s', 1849 setup => 'my $s; my $a1 = "abcd";', 1850 code => '$s = sprintf "foo=%s", $a1', 1851 }, 1852 'func::sprintf::mixed_utf8_sss' => { 1853 desc => 'foo=%s bar=%s baz=%s', 1854 setup => 'my $s;my $a = "ab\x{100}cd"; my $b = "efg"; my $c = "h\x{101}ij"', 1855 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 1856 }, 1857 1858 # sprint that's likely to be optimised to an OP_MULTICONCAT 1859 1860 'func::sprintf::l' => { 1861 setup => 'my $lex1 = "abcd"', 1862 code => 'sprintf "%s", $lex1', 1863 }, 1864 'func::sprintf::g_l' => { 1865 setup => 'our $pkg; my $lex1 = "abcd"', 1866 code => '$pkg = sprintf "%s", $lex1', 1867 }, 1868 'func::sprintf::g_append_l' => { 1869 setup => 'our $pkg; my $lex1 = "abcd"', 1870 pre => '$pkg = "pqrs"', 1871 code => '$pkg .= sprintf "%s", $lex1', 1872 }, 1873 'func::sprintf::g_ll' => { 1874 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1875 code => '$pkg = sprintf "%s%s", $lex1, $lex2', 1876 }, 1877 'func::sprintf::g_append_ll' => { 1878 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1879 pre => '$pkg = "pqrs"', 1880 code => '$pkg .= sprintf "%s%s", $lex1, $lex2', 1881 }, 1882 'func::sprintf::g_cl' => { 1883 setup => 'our $pkg; my $lex1 = "abcd"', 1884 code => '$pkg = sprintf "foo=%s", $lex1', 1885 }, 1886 'func::sprintf::g_clclc' => { 1887 setup => 'our $pkg; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1888 code => '$pkg = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1889 }, 1890 1891 'func::sprintf::l_l' => { 1892 setup => 'my $lex; my $lex1 = "abcd"', 1893 code => '$lex = sprintf "%s", $lex1', 1894 }, 1895 'func::sprintf::l_append_l' => { 1896 setup => 'my $lex; my $lex1 = "abcd"', 1897 pre => '$lex = "pqrs"', 1898 code => '$lex .= sprintf "%s", $lex1', 1899 }, 1900 'func::sprintf::ll' => { 1901 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1902 code => 'sprintf "%s%s", $lex1, $lex2', 1903 }, 1904 'func::sprintf::l_ll' => { 1905 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1906 code => '$lex = sprintf "%s%s", $lex1, $lex2', 1907 }, 1908 'func::sprintf::l_append_ll' => { 1909 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1910 pre => '$lex = "pqrs"', 1911 code => '$lex .= sprintf "%s%s", $lex1, $lex2', 1912 }, 1913 'func::sprintf::l_cl' => { 1914 setup => 'my $lex; my $lex1 = "abcd"', 1915 code => '$lex = sprintf "foo=%s", $lex1', 1916 }, 1917 'func::sprintf::l_clclc' => { 1918 setup => 'my $lex; my $lex1 = "abcd"; my $lex2 = "wxyz"', 1919 code => '$lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1920 }, 1921 1922 'func::sprintf::m_l' => { 1923 setup => 'my $lex1 = "abcd"', 1924 code => 'my $lex = sprintf "%s", $lex1', 1925 }, 1926 'func::sprintf::m_ll' => { 1927 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1928 code => 'my $lex = sprintf "%s%s", $lex1, $lex2', 1929 }, 1930 'func::sprintf::m_cl' => { 1931 setup => 'my $lex1 = "abcd"', 1932 code => 'my $lex = sprintf "foo=%s", $lex1', 1933 }, 1934 'func::sprintf::m_clclc' => { 1935 setup => 'my $lex1 = "abcd"; my $lex2 = "wxyz"', 1936 code => 'my $lex = sprintf "foo=%s bar=%s\n", $lex1, $lex2', 1937 }, 1938 1939 'func::sprintf::utf8__l_lll' => { 1940 desc => '$s = sprintf("foo=%s bar=%s baz=%s", $a, $b, $c) where $a,$c are utf8', 1941 setup => 'my $s; my $a = "ab\x{100}cde"; my $b = "fghij"; my $c = "\x{101}klmn"', 1942 code => '$s = sprintf "foo=%s bar=%s baz=%s", $a, $b, $c', 1943 }, 1944 1945 1946 # S/// 1947 1948 'func::subst::bool' => { 1949 desc => 's/// in boolean context', 1950 setup => '', 1951 code => '$_ = "aaa"; !s/./x/g;' 1952 }, 1953 1954 1955 'func::values::scalar_cxt_empty' => { 1956 desc => ' values() on an empty hash in scalar context', 1957 setup => 'my $k; my %h = ()', 1958 code => '$k = values %h', 1959 }, 1960 'func::values::scalar_cxt' => { 1961 desc => ' values() on a non-empty hash in scalar context', 1962 setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)', 1963 code => '$k = values %h', 1964 }, 1965 'func::values::list_cxt_empty' => { 1966 desc => ' values() on an empty hash in list context', 1967 setup => 'my %h = ()', 1968 code => '() = values %h', 1969 }, 1970 'func::values::list_cxt' => { 1971 desc => ' values() on a non-empty hash in list context', 1972 setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)', 1973 code => '() = values %h', 1974 }, 1975 1976 1977 1978 'loop::block' => { 1979 desc => 'empty basic loop', 1980 setup => '', 1981 code => '{1;}', 1982 }, 1983 1984 'loop::do' => { 1985 desc => 'basic do block', 1986 setup => 'my $x; my $y = 2;', 1987 code => '$x = do {1; $y}', # the ';' stops the do being optimised 1988 }, 1989 1990 'loop::for::my_range1' => { 1991 desc => 'empty for loop with my var and 1 integer range', 1992 setup => '', 1993 code => 'for my $x (1..1) {}', 1994 }, 1995 'loop::for::lex_range1' => { 1996 desc => 'empty for loop with lexical var and 1 integer range', 1997 setup => 'my $x;', 1998 code => 'for $x (1..1) {}', 1999 }, 2000 'loop::for::pkg_range1' => { 2001 desc => 'empty for loop with package var and 1 integer range', 2002 setup => '$x = 1;', 2003 code => 'for $x (1..1) {}', 2004 }, 2005 'loop::for::defsv_range1' => { 2006 desc => 'empty for loop with $_ and integer 1 range', 2007 setup => ';', 2008 code => 'for (1..1) {}', 2009 }, 2010 'loop::for::my_range4' => { 2011 desc => 'empty for loop with my var and 4 integer range', 2012 setup => '', 2013 code => 'for my $x (1..4) {}', 2014 }, 2015 'loop::for::lex_range4' => { 2016 desc => 'empty for loop with lexical var and 4 integer range', 2017 setup => 'my $x;', 2018 code => 'for $x (1..4) {}', 2019 }, 2020 'loop::for::pkg_range4' => { 2021 desc => 'empty for loop with package var and 4 integer range', 2022 setup => '$x = 1;', 2023 code => 'for $x (1..4) {}', 2024 }, 2025 'loop::for::defsv_range4' => { 2026 desc => 'empty for loop with $_ and integer 4 range', 2027 setup => ';', 2028 code => 'for (1..4) {}', 2029 }, 2030 2031 'loop::for::my_list1' => { 2032 desc => 'empty for loop with my var and 1 integer list', 2033 setup => '', 2034 code => 'for my $x (1) {}', 2035 }, 2036 'loop::for::lex_list1' => { 2037 desc => 'empty for loop with lexical var and 1 integer list', 2038 setup => 'my $x;', 2039 code => 'for $x (1) {}', 2040 }, 2041 'loop::for::pkg_list1' => { 2042 desc => 'empty for loop with package var and 1 integer list', 2043 setup => '$x = 1;', 2044 code => 'for $x (1) {}', 2045 }, 2046 'loop::for::defsv_list1' => { 2047 desc => 'empty for loop with $_ and integer 1 list', 2048 setup => ';', 2049 code => 'for (1) {}', 2050 }, 2051 'loop::for::my_list4' => { 2052 desc => 'empty for loop with my var and 4 integer list', 2053 setup => '', 2054 code => 'for my $x (1,2,3,4) {}', 2055 }, 2056 'loop::for::lex_list4' => { 2057 desc => 'empty for loop with lexical var and 4 integer list', 2058 setup => 'my $x;', 2059 code => 'for $x (1,2,3,4) {}', 2060 }, 2061 'loop::for::pkg_list4' => { 2062 desc => 'empty for loop with package var and 4 integer list', 2063 setup => '$x = 1;', 2064 code => 'for $x (1,2,3,4) {}', 2065 }, 2066 'loop::for::defsv_list4' => { 2067 desc => 'empty for loop with $_ and integer 4 list', 2068 setup => '', 2069 code => 'for (1,2,3,4) {}', 2070 }, 2071 2072 'loop::for::my_array1' => { 2073 desc => 'empty for loop with my var and 1 integer array', 2074 setup => 'my @a = (1);', 2075 code => 'for my $x (@a) {}', 2076 }, 2077 'loop::for::lex_array1' => { 2078 desc => 'empty for loop with lexical var and 1 integer array', 2079 setup => 'my $x; my @a = (1);', 2080 code => 'for $x (@a) {}', 2081 }, 2082 'loop::for::pkg_array1' => { 2083 desc => 'empty for loop with package var and 1 integer array', 2084 setup => '$x = 1; my @a = (1);', 2085 code => 'for $x (@a) {}', 2086 }, 2087 'loop::for::defsv_array1' => { 2088 desc => 'empty for loop with $_ and integer 1 array', 2089 setup => 'my @a = (@a);', 2090 code => 'for (1) {}', 2091 }, 2092 'loop::for::my_array4' => { 2093 desc => 'empty for loop with my var and 4 integer array', 2094 setup => 'my @a = (1..4);', 2095 code => 'for my $x (@a) {}', 2096 }, 2097 'loop::for::lex_array4' => { 2098 desc => 'empty for loop with lexical var and 4 integer array', 2099 setup => 'my $x; my @a = (1..4);', 2100 code => 'for $x (@a) {}', 2101 }, 2102 'loop::for::pkg_array4' => { 2103 desc => 'empty for loop with package var and 4 integer array', 2104 setup => '$x = 1; my @a = (1..4);', 2105 code => 'for $x (@a) {}', 2106 }, 2107 'loop::for::defsv_array4' => { 2108 desc => 'empty for loop with $_ and integer 4 array', 2109 setup => 'my @a = (1..4);', 2110 code => 'for (@a) {}', 2111 }, 2112 2113 'loop::for::next4' => { 2114 desc => 'for loop containing only next with my var and integer 4 array', 2115 setup => 'my @a = (1..4);', 2116 code => 'for my $x (@a) {next}', 2117 }, 2118 2119 'loop::grep::expr_3int' => { 2120 desc => 'grep $_ > 0, 1,2,3', 2121 setup => 'my @a', 2122 code => '@a = grep $_ > 0, 1,2,3', 2123 }, 2124 2125 'loop::grep::block_3int' => { 2126 desc => 'grep { 1; $_ > 0} 1,2,3', 2127 setup => 'my @a', 2128 code => '@a = grep { 1; $_ > 0} 1,2,3', 2129 }, 2130 2131 'loop::map::expr_3int' => { 2132 desc => 'map $_+1, 1,2,3', 2133 setup => 'my @a', 2134 code => '@a = map $_+1, 1,2,3', 2135 }, 2136 2137 'loop::map::block_3int' => { 2138 desc => 'map { 1; $_+1} 1,2,3', 2139 setup => 'my @a', 2140 code => '@a = map { 1; $_+1} 1,2,3', 2141 }, 2142 2143 'loop::while::i1' => { 2144 desc => 'empty while loop 1 iteration', 2145 setup => 'my $i = 0;', 2146 code => 'while (++$i % 2) {}', 2147 }, 2148 'loop::while::i4' => { 2149 desc => 'empty while loop 4 iterations', 2150 setup => 'my $i = 0;', 2151 code => 'while (++$i % 4) {}', 2152 }, 2153 2154 2155 'regex::anyof_plus::anchored' => { 2156 setup => '$_ = "a" x 100;', 2157 code => '/^[acgt]+/', 2158 }, 2159 'regex::anyof_plus::floating' => { 2160 desc => '/[acgt]+where match starts at position 0 for 100 chars/', 2161 setup => '$_ = "a" x 100;', 2162 code => '/[acgt]+/', 2163 }, 2164 'regex::anyof_plus::floating_away' => { 2165 desc => '/[acgt]+/ where match starts at position 100 for 100 chars', 2166 setup => '$_ = ("0" x 100) . ("a" x 100);', 2167 code => '/[acgt]+/', 2168 }, 2169 2170 'regex::whilem::min_captures_fail' => { 2171 desc => '/WHILEM with anon-greedy match and captures that fails', 2172 setup => '$_ = ("a" x 20)', 2173 code => '/^(?:(.)(.))*?[XY]/', 2174 }, 2175 'regex::whilem::max_captures_fail' => { 2176 desc => '/WHILEM with a greedy match and captures that fails', 2177 setup => '$_ = ("a" x 20)', 2178 code => '/^(?:(.)(.))*[XY]/', 2179 }, 2180]; 2181