In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/36f9501c266112f8f137cfcf124111695b305b8b?hp=6d17784b921190b24fedff274376615eec2e3733>
- Log ----------------------------------------------------------------- commit 36f9501c266112f8f137cfcf124111695b305b8b Author: Yves Orton <[email protected]> Date: Wed Dec 7 23:40:13 2016 +0100 fixup new hash benchmarks to be lighter Incorperate some changes suggested by Dave. M t/perf/benchmarks commit 5825b6d453f076fd09aa131d141b2bff0fdd9e28 Author: Yves Orton <[email protected]> Date: Wed Dec 7 23:36:38 2016 +0100 bench - fixup some interface issues from allowing two step benchmarks This restores the old behavior of not showing a report if the --write option is used, but now the --show option overrides that behavior. It is an error to use --show with only one perl. This also fixes the error if there are no perls provided, and some other diagnostics. M Porting/bench.pl ----------------------------------------------------------------------- Summary of changes: Porting/bench.pl | 17 ++++++++++++++--- t/perf/benchmarks | 47 ++++++++++++++++++++++++++++++++--------------- 2 files changed, 46 insertions(+), 18 deletions(-) diff --git a/Porting/bench.pl b/Porting/bench.pl index 6cb7a3c7b0..62c6aaff54 100755 --- a/Porting/bench.pl +++ b/Porting/bench.pl @@ -330,6 +330,7 @@ usage: $0 [options] -- perl[=label] ... [default: 0]. --perlargs=foo Optional command-line args to pass to each perl to run. --raw Display raw data counts rather than percentages. + --show Show results even though we are going to write results. --sort=field:perl Sort the tests based on the value of 'field' in the column 'perl'. The perl value is as per --norm. -r|--read=file Read in previously saved data from the specified file. @@ -366,6 +367,7 @@ my %OPTS = ( perlargs => '', raw => 0, read => undef, + show => 0, sort => undef, tests => undef, verbose => 0, @@ -391,6 +393,7 @@ my %OPTS = ( 'perlargs=s' => \$OPTS{perlargs}, 'raw' => \$OPTS{raw}, 'read|r=s' => \$OPTS{read}, + 'show!' => \$OPTS{show}, 'sort=s' => \$OPTS{sort}, 'tests=s' => \$OPTS{tests}, 'verbose' => \$OPTS{verbose}, @@ -523,7 +526,7 @@ sub read_tests_file { sub select_a_perl { my ($perl, $perls, $who) = @_; - + $perls||=[]; if ($perl =~ /^[0-9]$/) { die "Error: $who value $perl outside range 0.." . $#$perls . "\n" unless $perl < @$perls; @@ -709,9 +712,14 @@ sub do_grind { my @run_perls= process_puts($perls, @$perl_args); push @$perls, @run_perls; + die "Error: Not enough perls to run a report, and --write not specified.\n" + if @$perls < 2 and !$OPTS{write}; $results = grind_run($tests, $order, \@run_perls, $loop_counts, $results); } + if (!$perls or !@$perls) { + die "Error: nothing to do: no perls to run, no data to read.\n"; + } # now that we have a list of perls, use it to process the # 'perl' component of the --norm and --sort args @@ -736,11 +744,14 @@ sub do_grind { }); open my $out, '>:encoding(UTF-8)', $OPTS{write} - or die " Error: can't open $OPTS{write} for writing: $!\n"; + or die "Error: can't open '$OPTS{write}' for writing: $!\n"; print $out $json or die "Error: writing to file '$OPTS{write}': $!\n"; close $out or die "Error: closing file '$OPTS{write}': $!\n"; } - if (@$perls>1) { + if (!$OPTS{write} or $OPTS{show}) { + if (@$perls < 2) { + die "Error: need more than one perl to do a report.\n"; + } my ($processed, $averages) = grind_process($results, $perls, $loop_counts); diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 5526f8eeae..4a57175e1d 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -263,7 +263,6 @@ code => '($r||0)->{foo}{bar}{baz}', }, - 'expr::hash::pkg_1const' => { desc => 'package $hash{const}', setup => '%h = ("foo" => 1)', @@ -301,6 +300,38 @@ setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });', code => 'exists $h{$k1}{$k2}', }, + + ( + 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 });', @@ -1317,18 +1348,4 @@ 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, - ) - ), ]; -- Perl5 Master Repository
