# string:: string handling
#
#
-# Each hash has three fields:
+# Each hash has up to five fields:
+#
+# desc is a description of the test; if not present, it defaults
+# to the same value as the 'code' field
+#
+# setup is an optional string containing setup code that is run once
#
-# desc is a description of the test
-# setup is a string containing setup code
# code is a string containing the code to run in a loop
#
-# So typically a benchmark tool might do something like
+# pre is an optional string containing setup code which is executed
+# just before 'code' for every iteration, but whose execution
+# time is not included in the result
+#
+# post like pre, but executed just after 'code'.
#
-# eval "package $token; $setup; for (1..1000000) { $code }"
+# So typically a benchmark tool might execute variations on something like
+#
+# eval "package $name; $setup; for (1..1000000) { $pre; $code; $post }"
#
# Currently the only tool that uses this file is Porting/bench.pl;
# try C<perl Porting/bench.pl --help> for more info
# Note: for the cachegrind variant, an entry like
# 'foo::bar' => {
# setup => 'SETUP',
+# pre => 'PRE',
# code => 'CODE',
+# post => 'POST',
# }
# creates two temporary perl sources looking like:
#
# BEGIN { srand(0) }
# SETUP;
# for my $__loop__ (1..$ARGV[0]) {
-# 1;
+# PRE; 1; POST;
# }
#
-# and as above, but with the '1;' in the loop body replaced with:
+# and as above, but with the loop body replaced with:
#
-# CODE;
+# PRE; CODE; POST;
#
# It then pipes each of the two sources into
#
# where N is set to 10 and then 20.
#
# It then uses the result of those four cachegrind runs to subtract out
-# the perl startup and loop overheads. So only what's in SETUP and CODE
-# can affect the benchmark, and if the loop happens to leave some state
-# changed (such as storing a value in a hash), then the final benchmark
-# timing is the result of running CODE with the hash entry populated
-# rather than empty.
+# the perl startup and loop overheads (including SETUP, PRE and POST), leaving
+# (in theory only CODE);
+#
+# Note that misleading results may be obtained if each iteration is
+# not identical. For example with
+#
+# code => '$x .= "foo"',
+#
+# the string $x gets longer on each iteration. Similarly, a hash might be
+# empty on the first iteration, but have entries on subsequent iterations.
+#
+# To avoid this, use 'pre' or 'post', e.g.
+#
+# pre => '$x = ""',
+# code => '$x .= "foo"',
+#
+# Finally, the optional 'compile' key causes the code body to be wrapped
+# in eval qw{ sub { ... }}, so that compile time rather than execution
+# time is measured.
[
code => '($r||0)->[0][0][0]',
},
+ 'expr::array::lex_bool_empty' => {
+ desc => 'empty lexical array in boolean context',
+ setup => 'my @a;',
+ code => '!@a',
+ },
+ 'expr::array::lex_bool_full' => {
+ desc => 'non-empty lexical array in boolean context',
+ setup => 'my @a = 1..10;',
+ code => '!@a',
+ },
+ 'expr::array::lex_scalar_empty' => {
+ desc => 'empty lexical array in scalar context',
+ setup => 'my (@a, $i);',
+ code => '$i = @a',
+ },
+ 'expr::array::lex_scalar_full' => {
+ desc => 'non-empty lexical array in scalar context',
+ setup => 'my @a = 1..10; my $i',
+ code => '$i = @a',
+ },
+ 'expr::array::pkg_bool_empty' => {
+ desc => 'empty lexical array in boolean context',
+ setup => 'our @a;',
+ code => '!@a',
+ },
+ 'expr::array::pkg_bool_full' => {
+ desc => 'non-empty lexical array in boolean context',
+ setup => 'our @a = 1..10;',
+ code => '!@a',
+ },
+ 'expr::array::pkg_scalar_empty' => {
+ desc => 'empty lexical array in scalar context',
+ setup => 'our @a; my $i;',
+ code => '$i = @a',
+ },
+ 'expr::array::pkg_scalar_full' => {
+ desc => 'non-empty lexical array in scalar context',
+ setup => 'our @a = 1..10; my $i',
+ code => '$i = @a',
+ },
'expr::arrayhash::lex_3var' => {
desc => 'lexical $h{$k1}[$i]{$k2}',
code => '($r||0)->{foo}{bar}{baz}',
},
-
'expr::hash::pkg_1const' => {
desc => 'package $hash{const}',
setup => '%h = ("foo" => 1)',
setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });',
code => 'exists $h{$k1}{$k2}',
},
+
+ 'expr::hash::bool_empty' => {
+ desc => 'empty lexical hash in boolean context',
+ setup => 'my %h;',
+ code => '!%h',
+ },
+ 'expr::hash::bool_empty_unknown' => {
+ desc => 'empty lexical hash in unknown context',
+ setup => 'my ($i, %h); sub f { if (%h) { $i++ }}',
+ code => 'f()',
+ },
+ 'expr::hash::bool_full' => {
+ desc => 'non-empty lexical hash in boolean context',
+ setup => 'my %h = 1..10;',
+ code => '!%h',
+ },
+
+
+ (
+ map {
+ sprintf('expr::hash::notexists_lex_keylen%04d',$_) => {
+ desc => 'exists on non-key of length '. $_,
+ setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key."x"} = 1;',
+ code => 'exists $h{$key}',
+ },
+ } (
+ 1 .. 24,
+ # 1,2,3,7,8,9,14,15,16,20,24,
+ 50,
+ 100,
+ 1000,
+ )
+ ),
+ (
+ map {
+ sprintf('expr::hash::exists_lex_keylen%04d',$_) => {
+ desc => 'exists on existing key of length '. $_,
+ setup => 'my %h; my $key = "A" x ' . $_ . '; $h{$key} = 1;',
+ code => 'exists $h{$key}',
+ },
+ } (
+ 1 .. 24,
+ # 1,2,3,7,8,9,14,15,16,20,24,
+ 50,
+ 100,
+ 1000,
+ )
+ ),
+
'expr::hash::delete_lex_2var' => {
desc => 'lexical delete $hash{$k1}{$k2}',
setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });',
code => '($x,$y,$z) = @_',
},
+ # (....) = %lexical
+
+ 'expr::aassign::ma_lh' => {
+ desc => 'my array assigned lexical hash',
+ setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => 'my @a = %h',
+ },
+
# (....) = ($lex1,$lex2,$lex3);
code => '($r1, $r2) = ([], []);',
},
+ 'expr::aassign::boolean' => {
+ desc => '!(@a = @b)',
+ setup => 'my ($s,@a, @b); @b = (1,2)',
+ code => '!(@a = @b);',
+ },
+ 'expr::aassign::scalar' => {
+ desc => '$scalar = (@a = @b)',
+ setup => 'my ($s, @a, @b); @b = (1,2)',
+ code => '$s = (@a = @b);',
+ },
+
# array assign of strings
'expr::aassign::la_3s' => {
code => '$z = $x * $y',
},
+ # use '!' to test SvTRUE on various classes of value
+
+ 'expr::arith::not_PL_undef' => {
+ desc => '!undef (using PL_sv_undef)',
+ setup => 'my $x',
+ code => '$x = !undef',
+ },
+ 'expr::arith::not_PL_no' => {
+ desc => '!($x == $y) (using PL_sv_no)',
+ setup => 'my ($x, $y) = (1,2); my $z;',
+ code => '$z = !($x == $y)',
+ },
+ 'expr::arith::not_PL_zero' => {
+ desc => '!%h (using PL_sv_zero)',
+ setup => 'my ($x, %h)',
+ code => '$x = !%h',
+ },
+ 'expr::arith::not_PL_yes' => {
+ desc => '!($x == $y) (using PL_sv_yes)',
+ setup => 'my ($x, $y) = (1,1); my $z;',
+ code => '$z = !($x == $y)',
+ },
+ 'expr::arith::not_undef' => {
+ desc => '!$y where $y is undef',
+ setup => 'my ($x, $y)',
+ code => '$x = !$y',
+ },
+ 'expr::arith::not_0' => {
+ desc => '!$x where $x is 0',
+ setup => 'my ($x, $y) = (0, 0)',
+ code => '$y = !$x',
+ },
+ 'expr::arith::not_1' => {
+ desc => '!$x where $x is 1',
+ setup => 'my ($x, $y) = (1, 0)',
+ code => '$y = !$x',
+ },
+ 'expr::arith::not_string' => {
+ desc => '!$x where $x is "foo"',
+ setup => 'my ($x, $y) = ("foo", 0)',
+ code => '$y = !$x',
+ },
+ 'expr::arith::not_ref' => {
+ desc => '!$x where $s is an array ref',
+ setup => 'my ($x, $y) = ([], 0)',
+ code => '$y = !$x',
+ },
+
'expr::arith::preinc' => {
- desc => '++$x',
setup => 'my $x = 1;',
code => '++$x',
},
'expr::arith::predec' => {
- desc => '--$x',
setup => 'my $x = 1;',
code => '--$x',
},
},
+ 'func::grep::bool0' => {
+ desc => 'grep returning 0 items in boolean context',
+ setup => 'my @a;',
+ code => '!grep $_, @a;',
+ },
+ 'func::grep::bool1' => {
+ desc => 'grep returning 1 item in boolean context',
+ setup => 'my @a =(1);',
+ code => '!grep $_, @a;',
+ },
+ 'func::grep::scalar0' => {
+ desc => 'returning 0 items in scalar context',
+ setup => 'my $g; my @a;',
+ code => '$g = grep $_, @a;',
+ },
+ 'func::grep::scalar1' => {
+ desc => 'returning 1 item in scalar context',
+ setup => 'my $g; my @a =(1);',
+ code => '$g = grep $_, @a;',
+ },
+
+ # (index() == -1) and variants optimise away the op_const and op_eq
+ # and any assignment to a lexical var
+ 'func::index::bool' => {
+ desc => '(index() == -1) for match',
+ setup => 'my $x = "aaaab"',
+ code => 'index($x, "b") == -1',
+ },
+ 'func::index::bool_fail' => {
+ desc => '(index() == -1) for no match',
+ setup => 'my $x = "aaaab"',
+ code => 'index($x, "c") == -1',
+ },
+ 'func::index::lex_bool' => {
+ desc => '$lex = (index() == -1) for match',
+ setup => 'my $r; my $x = "aaaab"',
+ code => '$r = index($x, "b") == -1',
+ },
+ 'func::index::lex_bool_fail' => {
+ desc => '$lex = (index() == -1) for no match',
+ setup => 'my $r; my $x = "aaaab"',
+ code => '$r = index($x, "c") == -1',
+ },
# using a const string as second arg to index triggers using FBM.
# the FBM matcher special-cases 1,2-byte strings.
},
+ 'func::keys::lex::void_cxt_empty' => {
+ desc => ' keys() on an empty lexical hash in void context',
+ setup => 'my %h = ()',
+ code => 'keys %h',
+ },
+ 'func::keys::lex::void_cxt' => {
+ desc => ' keys() on a non-empty lexical hash in void context',
+ setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => 'keys %h',
+ },
+ 'func::keys::lex::bool_cxt_empty' => {
+ desc => ' keys() on an empty lexical hash in bool context',
+ setup => 'my %h = ()',
+ code => '!keys %h',
+ },
+ 'func::keys::lex::bool_cxt' => {
+ desc => ' keys() on a non-empty lexical hash in bool context',
+ setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '!keys %h',
+ },
+ 'func::keys::lex::scalar_cxt_empty' => {
+ desc => ' keys() on an empty lexical hash in scalar context',
+ setup => 'my $k; my %h = ()',
+ code => '$k = keys %h',
+ },
+ 'func::keys::lex::scalar_cxt' => {
+ desc => ' keys() on a non-empty lexical hash in scalar context',
+ setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '$k = keys %h',
+ },
+ 'func::keys::lex::list_cxt_empty' => {
+ desc => ' keys() on an empty lexical hash in list context',
+ setup => 'my %h = ()',
+ code => '() = keys %h',
+ },
+ 'func::keys::lex::list_cxt' => {
+ desc => ' keys() on a non-empty lexical hash in list context',
+ setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '() = keys %h',
+ },
+
+ 'func::keys::pkg::void_cxt_empty' => {
+ desc => ' keys() on an empty package hash in void context',
+ setup => 'our %h = ()',
+ code => 'keys %h',
+ },
+ 'func::keys::pkg::void_cxt' => {
+ desc => ' keys() on a non-empty package hash in void context',
+ setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => 'keys %h',
+ },
+ 'func::keys::pkg::bool_cxt_empty' => {
+ desc => ' keys() on an empty package hash in bool context',
+ setup => 'our %h = ()',
+ code => '!keys %h',
+ },
+ 'func::keys::pkg::bool_cxt' => {
+ desc => ' keys() on a non-empty package hash in bool context',
+ setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '!keys %h',
+ },
+ 'func::keys::pkg::scalar_cxt_empty' => {
+ desc => ' keys() on an empty package hash in scalar context',
+ setup => 'my $k; our %h = ()',
+ code => '$k = keys %h',
+ },
+ 'func::keys::pkg::scalar_cxt' => {
+ desc => ' keys() on a non-empty package hash in scalar context',
+ setup => 'my $k; our %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '$k = keys %h',
+ },
+ 'func::keys::pkg::list_cxt_empty' => {
+ desc => ' keys() on an empty package hash in list context',
+ setup => 'our %h = ()',
+ code => '() = keys %h',
+ },
+ 'func::keys::pkg::list_cxt' => {
+ desc => ' keys() on a non-empty package hash in list context',
+ setup => 'our %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '() = keys %h',
+ },
+
+
+ 'func::length::bool0' => {
+ desc => 'length==0 in boolean context',
+ setup => 'my $s = "";',
+ code => '!length($s);',
+ },
+ 'func::length::bool10' => {
+ desc => 'length==10 in boolean context',
+ setup => 'my $s = "abcdefghijk";',
+ code => '!length($s);',
+ },
+ 'func::length::scalar10' => {
+ desc => 'length==10 in scalar context',
+ setup => 'my $p; my $s = "abcdefghijk";',
+ code => '$p = length($s);',
+ },
+ 'func::length::bool0_utf8' => {
+ desc => 'utf8 string length==0 in boolean context',
+ setup => 'my $s = "\x{100}"; chop $s;',
+ code => '!length($s);',
+ },
+ 'func::length::bool10_utf8' => {
+ desc => 'utf8 string length==10 in boolean context',
+ setup => 'my $s = "abcdefghij\x{100}";',
+ code => '!length($s);',
+ },
+ 'func::length::scalar10_utf8' => {
+ desc => 'utf8 string length==10 in scalar context',
+ setup => 'my $p; my $s = "abcdefghij\x{100}";',
+ code => '$p = length($s);',
+ },
+
+ 'func::pos::bool0' => {
+ desc => 'pos==0 in boolean context',
+ setup => 'my $s = "abc"; pos($s) = 0',
+ code => '!pos($s);',
+ },
+ 'func::pos::bool10' => {
+ desc => 'pos==10 in boolean context',
+ setup => 'my $s = "abcdefghijk"; pos($s) = 10',
+ code => '!pos($s);',
+ },
+ 'func::pos::scalar10' => {
+ desc => 'pos==10 in scalar context',
+ setup => 'my $p; my $s = "abcdefghijk"; pos($s) = 10',
+ code => '$p = pos($s);',
+ },
+
+ 'func::ref::notaref_bool' => {
+ desc => 'ref($notaref) in boolean context',
+ setup => 'my $r = "boo"',
+ code => '!ref $r',
+ },
+ 'func::ref::ref_bool' => {
+ desc => 'ref($ref) in boolean context',
+ setup => 'my $r = []',
+ code => '!ref $r',
+ },
+ 'func::ref::blessedref_bool' => {
+ desc => 'ref($blessed_ref) in boolean context',
+ setup => 'my $r = bless []',
+ code => '!ref $r',
+ },
+
+ 'func::ref::notaref' => {
+ desc => 'ref($notaref) in scalar context',
+ setup => 'my $x; my $r = "boo"',
+ code => '$x = ref $r',
+ },
+ 'func::ref::ref' => {
+ desc => 'ref($ref) in scalar context',
+ setup => 'my $x; my $r = []',
+ code => '$x = ref $r',
+ },
+ 'func::ref::blessedref' => {
+ desc => 'ref($blessed_ref) in scalar context',
+ setup => 'my $x; my $r = bless []',
+ code => '$x = ref $r',
+ },
+
+
'func::sort::num' => {
desc => 'plain numeric sort',
},
+ 'func::sprintf::d' => {
+ desc => '%d',
+ setup => 'my $s; my $a1 = 1234;',
+ code => '$s = sprintf "%d", $a1',
+ },
+ 'func::sprintf::d8' => {
+ desc => '%8d',
+ setup => 'my $s; my $a1 = 1234;',
+ code => '$s = sprintf "%8d", $a1',
+ },
+ 'func::sprintf::foo_d8' => {
+ desc => 'foo=%8d',
+ setup => 'my $s; my $a1 = 1234;',
+ code => '$s = sprintf "foo=%8d", $a1',
+ },
+
+ 'func::sprintf::f0' => {
+ # "%.0f" is very special-cased
+ desc => 'sprintf "%.0f"',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "%.0f", $a1',
+ },
+ 'func::sprintf::foo_f0' => {
+ # "...%.0f..." is special-cased
+ desc => 'sprintf "foo=%.0f"',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "foo=%.0f\n", $a1',
+ },
+ 'func::sprintf::foo_f93' => {
+ desc => 'foo=%9.3f',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "foo=%9.3f\n", $a1',
+ },
+
+ 'func::sprintf::g9' => {
+ # "...%.NNNg..." is special-cased
+ desc => '%.9g',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "%.9g", $a1',
+ },
+ 'func::sprintf::foo_g9' => {
+ # "...%.NNNg..." is special-cased
+ desc => 'foo=%.9g',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "foo=%.9g\n", $a1',
+ },
+ 'func::sprintf::foo_g93' => {
+ desc => 'foo=%9.3g',
+ setup => 'my $s; my $a1 = 123.456;',
+ code => '$s = sprintf "foo=%9.3g\n", $a1',
+ },
+
+ 'func::sprintf::s' => {
+ desc => '%s',
+ setup => 'my $s; my $a1 = "abcd";',
+ code => '$s = sprintf "%s", $a1',
+ },
+ 'func::sprintf::foo_s' => {
+ desc => 'foo=%s',
+ setup => 'my $s; my $a1 = "abcd";',
+ code => '$s = sprintf "foo=%s", $a1',
+ },
+ 'func::sprintf::mixed_utf8_s' => {
+ desc => 'foo=%s bar=%s baz=%s',
+ setup => 'my $s;',
+ code => '$s = sprintf "foo=%s", "ab\x{100}cd", "efg", "h\x{101}ij"',
+ },
+
+ 'func::subst::bool' => {
+ desc => 's/// in boolean context',
+ setup => '',
+ code => '$_ = "aaa"; !s/./x/g;'
+ },
+
+
+ 'func::values::scalar_cxt_empty' => {
+ desc => ' values() on an empty hash in scalar context',
+ setup => 'my $k; my %h = ()',
+ code => '$k = values %h',
+ },
+ 'func::values::scalar_cxt' => {
+ desc => ' values() on a non-empty hash in scalar context',
+ setup => 'my $k; my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '$k = values %h',
+ },
+ 'func::values::list_cxt_empty' => {
+ desc => ' values() on an empty hash in list context',
+ setup => 'my %h = ()',
+ code => '() = values %h',
+ },
+ 'func::values::list_cxt' => {
+ desc => ' values() on a non-empty hash in list context',
+ setup => 'my %h = qw(aardvark 1 banana 2 cucumber 3)',
+ code => '() = values %h',
+ },
+
+
+
'loop::block' => {
desc => 'empty basic loop',
setup => '',
setup => 'my $i = 0;',
code => 'while (++$i % 4) {}',
},
- (
- map {
- sprintf('hash::set1k::len_%04d',$_) => {
- desc => 'hash keys length '. $_,
- setup => 'my $i = "A" x ' . $_ . '; my @s= map { $i++ } 1..1000;',
- code => 'my %h; @h{@s}=();',
- },
- } (
- 1..24,
- 50,
- 100,
- 1000,
- )
- ),
+
+
+ 'regex::anyof_plus::anchored' => {
+ setup => '$_ = "a" x 100;',
+ code => '/^[acgt]+/',
+ },
+ 'regex::anyof_plus::floating' => {
+ desc => '/[acgt]+where match starts at position 0 for 100 chars/',
+ setup => '$_ = "a" x 100;',
+ code => '/[acgt]+/',
+ },
+ 'regex::anyof_plus::floating_away' => {
+ desc => '/[acgt]+/ where match starts at position 100 for 100 chars',
+ setup => '$_ = ("0" x 100) . ("a" x 100);',
+ code => '/[acgt]+/',
+ },
+
+ 'regex::whilem::min_captures_fail' => {
+ desc => '/WHILEM with anon-greedy match and captures that fails',
+ setup => '$_ = ("a" x 20)',
+ code => '/^(?:(.)(.))*?[XY]/',
+ },
+ 'regex::whilem::max_captures_fail' => {
+ desc => '/WHILEM with a greedy match and captures that fails',
+ setup => '$_ = ("a" x 20)',
+ code => '/^(?:(.)(.))*[XY]/',
+ },
];
https://perl5.git.perl.org / perl5.git / blobdiff