});
# ...or in two stages
- $results = timethese($count,
+ $results = timethese($count,
{
'Name1' => sub { ...code1... },
'Name2' => sub { ...code2... },
Returns the current time. Example:
use Benchmark;
- $t0 = new Benchmark;
+ $t0 = Benchmark->new;
# ... your code here ...
- $t1 = new Benchmark;
+ $t1 = Benchmark->new;
$td = timediff($t1, $t0);
print "the code took:",timestr($td),"\n";
Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
- debug Benchmark 1;
+ Benchmark->debug(1);
$t = timeit(10, ' 5 ** $Global ');
- debug Benchmark 0;
+ Benchmark->debug(0);
=item iters
The COUNT can be zero or negative, see timethis().
-Returns a hash of Benchmark objects, keyed by name.
+Returns a hash reference of Benchmark objects, keyed by name.
=item timediff ( T1, T2 )
This chart is sorted from slowest to fastest, and shows the percent speed
difference between each pair of tests.
-c<cmpthese> can also be passed the data structure that timethese() returns:
+C<cmpthese> can also be passed the data structure that timethese() returns:
- $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
+ $results = timethese( -1,
+ { a => "++\$i", b => "\$i *= 2" } ) ;
cmpthese( $results );
in case you want to see both sets of results.
+If the first argument is an unblessed hash reference,
+that is RESULTSHASHREF; otherwise that is COUNT.
Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
above chart, including labels. This:
- my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
+ my $rows = cmpthese( -1,
+ { a => '++$i', b => '$i *= 2' }, "none" );
returns a data structure like:
the C<timethese()> result structure. If you want that, just use the two
statement C<timethese>...C<cmpthese> idiom shown above.
-Incidently, note the variance in the result values between the two examples;
+Incidentally, note the variance in the result values between the two examples;
this is typical of benchmarking. If this were a real benchmark, you would
probably want to run a lot more iterations.
seconds. Note though that the speed computations are still conducted
in CPU time, not wallclock time.
+=head1 Benchmark Object
+
+Many of the functions in this module return a Benchmark object,
+or in the case of C<timethese()>, a reference to a hash, the values of
+which are Benchmark objects. This is useful if you want to store or
+further process results from Benchmark functions.
+
+Internally the Benchmark object holds timing values,
+described in L</"NOTES"> below.
+The following methods can be used to access them:
+
+=over 4
+
+=item cpu_p
+
+Total CPU (User + System) of the main (parent) process.
+
+=item cpu_c
+
+Total CPU (User + System) of any children processes.
+
+=item cpu_a
+
+Total CPU of parent and any children processes.
+
+=item real
+
+Real elapsed time "wallclock seconds".
+
+=item iters
+
+Number of iterations run.
+
+=back
+
+The following illustrates use of the Benchmark object:
+
+ $result = timethis(100000, sub { ... });
+ print "total CPU = ", $result->cpu_a, "\n";
+
=head1 NOTES
The data is stored as a list of values from the time and times
enablecache();
Caching is off by default, as it can (usually slightly) decrease
-accuracy and does not usually noticably affect runtimes.
+accuracy and does not usually noticeably affect runtimes.
=head1 EXAMPLES
a 4152037/s 166% --
-while
+while
use Benchmark qw( timethese cmpthese ) ;
$x = 3;
=head1 INHERITANCE
Benchmark inherits from no other class, except of course
-for Exporter.
+from Exporter.
=head1 CAVEATS
=head1 SEE ALSO
-L<Devel::DProf> - a Perl code profiler
+L<Devel::NYTProf> - a Perl code profiler
=head1 AUTHORS
April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
functionality.
-September, 1999; by Barrie Slaymaker: math fixes and accuracy and
-efficiency tweaks. Added cmpthese(). A result is now returned from
+September, 1999; by Barrie Slaymaker: math fixes and accuracy and
+efficiency tweaks. Added cmpthese(). A result is now returned from
timethese(). Exposed countit() (was runfor()).
December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
+February, 2004; by Chia-liang Kao: make cmpthese and timestr use time
+statistics for children instead of parent when the style is 'nop'.
+
+November, 2007; by Christophe Grosjean: make cmpthese and timestr compute
+time consistently with style argument, default is 'all' not 'noc' any more.
+
=cut
# evaluate something in a clean lexical environment
clearcache clearallcache disablecache enablecache);
%EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
-$VERSION = 1.051;
+$VERSION = 1.23;
# --- ':hireswallclock' special handling
my $class = shift;
if (grep { $_ eq ":hireswallclock" } @_) {
@_ = grep { $_ ne ":hireswallclock" } @_;
+ local $^W=0;
*mytime = $hirestime if defined $hirestime;
}
Benchmark->export_to_level(1, $class, @_);
sub debug { $Debug = ($_[1] != 0); }
-sub usage {
+sub usage {
my $calling_sub = (caller(1))[3];
$calling_sub =~ s/^Benchmark:://;
return $_Usage{$calling_sub} || '';
usage: clearcache($count);
USAGE
-sub clearcache {
+sub clearcache {
die usage unless @_ == 1;
- delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
+ delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
}
$_Usage{clearallcache} = <<'USAGE';
usage: clearallcache();
USAGE
-sub clearallcache {
+sub clearallcache {
die usage if @_;
- %Cache = ();
+ %Cache = ();
}
$_Usage{enablecache} = <<'USAGE';
sub enablecache {
die usage if @_;
- $Do_Cache = 1;
+ $Do_Cache = 1;
}
$_Usage{disablecache} = <<'USAGE';
sub disablecache {
die usage if @_;
- $Do_Cache = 0;
+ $Do_Cache = 0;
}
sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
sub iters { $_[0]->[5] ; }
+# return the sum of various times: which ones depending on $style
+
+sub elapsed {
+ my ($self, $style) = @_;
+ $style = "" unless defined $style;
+
+ return $self->cpu_c if $style eq 'nop';
+ return $self->cpu_p if $style eq 'noc';
+ return $self->cpu_a;
+}
+
$_Usage{timediff} = <<'USAGE';
usage: $result_diff = timediff($result1, $result2);
for (my $i=0; $i < @$a; ++$i) {
push(@r, $a->[$i] - $b->[$i]);
}
+ #die "Bad timediff(): ($r[1] + $r[2]) <= 0 (@$a[1,2]|@$b[1,2])\n"
+ # if ($r[1] + $r[2]) < 0;
bless \@r;
}
$style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
my $s = "@t $style"; # default for unknown style
my $w = $hirestime ? "%2g" : "%2d";
- $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
+ $s = sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
$r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
- $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
+ $s = sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
$r,$pu,$ps,$pt) if $style eq 'noc';
- $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
+ $s = sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
$r,$cu,$cs,$ct) if $style eq 'nop';
- $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
+ my $elapsed = $tr->elapsed($style);
+ $s .= sprintf(" @ %$f/s (n=$n)",$n/($elapsed)) if $n && $elapsed;
$s;
}
croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
print STDERR "runloop $n '$subcode'\n" if $Debug;
- # Wait for the user timer to tick. This makes the error range more like
+ # Wait for the user timer to tick. This makes the error range more like
# -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
# may not seem important, but it significantly reduces the chances of
# getting a too low initial $n in the initial, 'find the minimum' loop
# in &countit. This, in turn, can reduce the number of calls to
# &runloop a lot, and thus reduce additive errors.
+ #
+ # Note that its possible for the act of reading the system clock to
+ # burn lots of system CPU while we burn very little user clock in the
+ # busy loop, which can cause the loop to run for a very long wall time.
+ # So gradually ramp up the duration of the loop. See RT #122003
+ #
my $tbase = Benchmark->new(0)->[1];
- while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
- &$subref;
+ my $limit = 1;
+ while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {
+ for (my $i=0; $i < $limit; $i++) { my $x = $i / 1.5 } # burn user CPU
+ $limit *= 1.1;
+ }
+ $subref->();
$t1 = Benchmark->new($n);
$td = &timediff($t1, $t0);
timedebug("runloop:",$td);
my ($n, $tc);
# First find the minimum $n that gives a significant timing.
+ my $zeros=0;
for ($n = 1; ; $n *= 2 ) {
+ my $t0 = Benchmark->new(0);
my $td = timeit($n, $code);
+ my $t1 = Benchmark->new(0);
$tc = $td->[1] + $td->[2];
+ if ( $tc <= 0 and $n > 1024 ) {
+ my $d = timediff($t1, $t0);
+ # note that $d is the total CPU time taken to call timeit(),
+ # while $tc is the difference in CPU secs between the empty run
+ # and the code run. If the code is trivial, its possible
+ # for $d to get large while $tc is still zero (or slightly
+ # negative). Bail out once timeit() starts taking more than a
+ # few seconds without noticeable difference.
+ if ($d->[1] + $d->[2] > 8
+ || ++$zeros > 16)
+ {
+ die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
+ }
+ } else {
+ $zeros = 0;
+ }
last if $tc > 0.1;
}
while ( $tc < $tpra ) {
# The 5% fudge is to keep us from iterating again all
# that often (this speeds overall responsiveness when $tmax is big
- # and we guess a little low). This does not noticably affect
- # accuracy since we're not couting these times.
+ # and we guess a little low). This does not noticeably affect
+ # accuracy since we're not counting these times.
$n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
my $td = timeit($n, $code);
my $new_tc = $td->[1] + $td->[2];
# with stable times and avoiding extra timeit()s is nice for
# accuracy's sake.
$n = int( $n * ( 1.05 * $tmax / $tc ) );
-
+ $zeros=0;
while () {
my $td = timeit($n, $code);
$ntot += $n;
$cstot += $td->[4];
$ttot = $utot + $stot;
last if $ttot >= $tmax;
-
+ if ( $ttot <= 0 ) {
+ ++$zeros > 16
+ and die "Timing is consistently zero, cannot benchmark. N=$n\n";
+ } else {
+ $zeros = 0;
+ }
$ttot = 0.01 if $ttot < 0.01;
my $r = $tmax / $ttot - 1; # Linear approximation.
$n = int( $r * $ntot );
$n = $forn if defined $forn;
+ if ($t->elapsed($style) < 0) {
+ # due to clock granularity and variable CPU speed and load,
+ # on quick code with a small number of loops, it's possible for
+ # the empty loop to appear to take longer than the real loop
+ # (e.g. 1 tick versus 0 ticks). This leads to a negative elapsed
+ # time. In this case, floor it at zero, to stop bizarre results.
+ print " (warning: too few iterations for a reliable count)\n";
+ $t->[$_] = 0 for 1..4;
+ }
+
# A conservative warning to spot very silly tests.
# Don't assume that your benchmark is ok simply because
# you don't get this warning!
sub cmpthese{
my ($results, $style);
- if( ref $_[0] ) {
+ # $count can be a blessed object.
+ if ( ref $_[0] eq 'HASH' ) {
($results, $style) = @_;
}
else {
my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
for (@vals) {
+ # recreate the pre-flattened Benchmark object
+ my $tmp_bm = bless [ @{$_}[1..$#$_] ];
+ my $elapsed = $tmp_bm->elapsed($style);
# The epsilon fudge here is to prevent div by 0. Since clock
# resolutions are much larger, it's below the noise floor.
- my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
+ my $rate = $_->[6]/(($elapsed)+0.000000000000001);
$_->[7] = $rate;
}
my @rows;
my @col_widths;
- my @top_row = (
- '',
- $display_as_rate ? 'Rate' : 's/iter',
- map { $_->[0] } @vals
+ my @top_row = (
+ '',
+ $display_as_rate ? 'Rate' : 's/iter',
+ map { $_->[0] } @vals
);
push @rows, \@top_row;
# Only give a few decimal places before switching to sci. notation,
# since the results aren't usually that accurate anyway.
- my $format =
- $rate >= 100 ?
- "%0.0f" :
+ my $format =
+ $rate >= 100 ?
+ "%0.0f" :
$rate >= 10 ?
"%0.1f" :
$rate >= 1 ?
$col_widths[$col_num+2] = length( $out )
if length( $out ) > $col_widths[$col_num+2];
- # A little wierdness to set the first column width properly
+ # A little weirdness to set the first column width properly
$col_widths[$col_num+2] = length( $col_val->[0] )
if length( $col_val->[0] ) > $col_widths[$col_num+2];
}
# Equalize column widths in the chart as much as possible without
# exceeding 80 characters. This does not use or affect cols 0 or 1.
- my @sorted_width_refs =
+ my @sorted_width_refs =
sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
my $max_width = ${$sorted_width_refs[-1]};
last
if $min_width == $max_width;
for ( @sorted_width_refs ) {
- last
+ last
if $$_ > $min_width;
++$$_;
++$total;
https://perl5.git.perl.org / perl5.git / blobdiff