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" } ) ;
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:
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.10;
# --- ':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, @_);
# The cache needs two branches: 's' for strings and 'c' for code. The
# empty loop is different in these two cases.
-sub clearcache ($) {
+$_Usage{clearcache} = <<'USAGE';
+usage: clearcache($count);
+USAGE
+
+sub clearcache {
+ die usage unless @_ == 1;
delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
}
-sub clearallcache () {
+$_Usage{clearallcache} = <<'USAGE';
+usage: clearallcache();
+USAGE
+
+sub clearallcache {
+ die usage if @_;
%Cache = ();
}
-sub enablecache () {
+$_Usage{enablecache} = <<'USAGE';
+usage: enablecache();
+USAGE
+
+sub enablecache {
+ die usage if @_;
$Do_Cache = 1;
}
-sub disablecache () {
+$_Usage{disablecache} = <<'USAGE';
+usage: disablecache();
+USAGE
+
+sub disablecache {
+ die usage if @_;
$Do_Cache = 0;
}
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 = do {
+ if ($style eq 'nop') {$cu+$cs}
+ elsif ($style eq 'noc') {$pu+$ps}
+ else {$cu+$cs+$pu+$ps}
+ };
+ $s .= sprintf(" @ %$f/s (n=$n)",$n/($elapsed)) if $n && $elapsed;
$s;
}
# &runloop a lot, and thus reduce additive errors.
my $tbase = Benchmark->new(0)->[1];
while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
- &$subref;
+ $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 $td = timeit($n, $code);
$tc = $td->[1] + $td->[2];
+ if ( $tc <= 0 and $n > 1024 ) {
+ ++$zeros > 16
+ and die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
+ } else {
+ $zeros = 0;
+ }
last if $tc > 0.1;
}
# 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 );
sub cmpthese{
my ($results, $style);
- if( ref $_[0] ) {
+ # $count can be a blessed object.
+ if ( ref $_[0] eq 'HASH' ) {
($results, $style) = @_;
}
else {
for (@vals) {
# 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 $elapsed = do {
+ if ($style eq 'nop') {$_->[4]+$_->[5]}
+ elsif ($style eq 'noc') {$_->[2]+$_->[3]}
+ else {$_->[2]+$_->[3]+$_->[4]+$_->[5]}
+ };
+ my $rate = $_->[6]/(($elapsed)+0.000000000000001);
$_->[7] = $rate;
}
@vals = sort { $a->[7] <=> $b->[7] } @vals;
# If more than half of the rates are greater than one...
- my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
+ my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;
my @rows;
my @col_widths;