X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a0d0e21ea6ea90a22318550944fe6cb09ae10cda..5aabfad66ac77650f584e2f07af91645e19fe296:/lib/Benchmark.pm diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index a19caff..13acf86 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -1,86 +1,213 @@ package Benchmark; -# Purpose: benchmark running times of code. -# -# -# Usage - to time code snippets and print results: -# -# timethis($count, '...code...'); -# -# prints: -# timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu) -# -# -# timethese($count, { -# Name1 => '...code1...', -# Name2 => '...code2...', -# ... }); -# prints: -# Benchmark: timing 100 iterations of Name1, Name2... -# Name1: 2 secs ( 0.50 usr 0.00 sys = 0.50 cpu) -# Name2: 1 secs ( 0.48 usr 0.00 sys = 0.48 cpu) -# -# The default display style will automatically add child process -# values if non-zero. -# -# -# Usage - to time sections of your own code: -# -# use Benchmark; -# $t0 = new Benchmark; -# ... your code here ... -# $t1 = new Benchmark; -# $td = &timediff($t1, $t0); -# print "the code took:",timestr($td),"\n"; -# -# $t = &timeit($count, '...other code...') -# print "$count loops of other code took:",timestr($t),"\n"; -# -# -# Data format: -# The data is stored as a list of values from the time and times -# functions: ($real, $user, $system, $children_user, $children_system) -# in seconds for the whole loop (not divided by the number of rounds). -# -# Internals: -# The timing is done using time(3) and times(3). -# -# Code is executed in the callers package -# -# Enable debugging by: $Benchmark::debug = 1; -# -# The time of the null loop (a loop with the same -# number of rounds but empty loop body) is substracted -# from the time of the real loop. -# -# The null loop times are cached, the key being the -# number of rounds. The caching can be controlled using -# &clearcache($key); &clearallcache; -# &disablecache; &enablecache; -# -# Caveats: -# -# The real time timing is done using time(2) and -# the granularity is therefore only one second. -# -# Short tests may produce negative figures because perl -# can appear to take longer to execute the empty loop -# than a short test: try timethis(100,'1'); -# -# The system time of the null loop might be slightly -# more than the system time of the loop with the actual -# code and therefore the difference might end up being < 0 -# -# More documentation is needed :-( -# Especially for styles and formats. -# -# Authors: Jarkko Hietaniemi -# Tim Bunce -# -# -# Last updated: Sept 8th 94 by Tim Bunce -# +=head1 NAME +Benchmark - benchmark running times of code + +timethis - run a chunk of code several times + +timethese - run several chunks of code several times + +timeit - run a chunk of code and see how long it goes + +=head1 SYNOPSIS + + timethis ($count, "code"); + + # Use Perl code in strings... + timethese($count, { + 'Name1' => '...code1...', + 'Name2' => '...code2...', + }); + + # ... or use subroutine references. + timethese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + + $t = timeit($count, '...other code...') + print "$count loops of other code took:",timestr($t),"\n"; + +=head1 DESCRIPTION + +The Benchmark module encapsulates a number of routines to help you +figure out how long it takes to execute some code. + +=head2 Methods + +=over 10 + +=item new + +Returns the current time. Example: + + use Benchmark; + $t0 = new Benchmark; + # ... your code here ... + $t1 = new Benchmark; + $td = timediff($t1, $t0); + print "the code took:",timestr($td),"\n"; + +=item debug + +Enables or disable debugging by setting the C<$Benchmark::Debug> flag: + + debug Benchmark 1; + $t = timeit(10, ' 5 ** $Global '); + debug Benchmark 0; + +=back + +=head2 Standard Exports + +The following routines will be exported into your namespace +if you use the Benchmark module: + +=over 10 + +=item timeit(COUNT, CODE) + +Arguments: COUNT is the number of times to run the loop, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +Returns: a Benchmark object. + +=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ) + +Time COUNT iterations of CODE. CODE may be a string to eval or a +code reference; either way the CODE will run in the caller's package. +Results will be printed to STDOUT as TITLE followed by the times. +TITLE defaults to "timethis COUNT" if none is provided. STYLE +determines the format of the output, as described for timestr() below. + +=item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) + +The CODEHASHREF is a reference to a hash containing names as keys +and either a string to eval or a code reference for each value. +For each (KEY, VALUE) pair in the CODEHASHREF, this routine will +call + + timethis(COUNT, VALUE, KEY, STYLE) + +=item timediff ( T1, T2 ) + +Returns the difference between two Benchmark times as a Benchmark +object suitable for passing to timestr(). + +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] ) + +Returns a string that formats the times in the TIMEDIFF object in +the requested STYLE. TIMEDIFF is expected to be a Benchmark object +similar to that returned by timediff(). + +STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each +of the 5 times available ('wallclock' time, user time, system time, +user time of children, and system time of children). 'noc' shows all +except the two children times. 'nop' shows only wallclock and the +two children times. 'auto' (the default) will act as 'all' unless +the children times are both zero, in which case it acts as 'noc'. + +FORMAT is the L-style format specifier (without the +leading '%') to use to print the times. It defaults to '5.2f'. + +=back + +=head2 Optional Exports + +The following routines will be exported into your namespace +if you specifically ask that they be imported: + +=over 10 + +=item clearcache ( COUNT ) + +Clear the cached time for COUNT rounds of the null loop. + +=item clearallcache ( ) + +Clear all cached times. + +=item disablecache ( ) + +Disable caching of timings for the null loop. This will force Benchmark +to recalculate these timings for each new piece of code timed. + +=item enablecache ( ) + +Enable caching of timings for the null loop. The time taken for COUNT +rounds of the null loop will be calculated only once for each +different COUNT used. + +=back + +=head1 NOTES + +The data is stored as a list of values from the time and times +functions: + + ($real, $user, $system, $children_user, $children_system) + +in seconds for the whole loop (not divided by the number of rounds). + +The timing is done using time(3) and times(3). + +Code is executed in the caller's package. + +The time of the null loop (a loop with the same +number of rounds but empty loop body) is subtracted +from the time of the real loop. + +The null loop times are cached, the key being the +number of rounds. The caching can be controlled using +calls like these: + + clearcache($key); + clearallcache(); + + disablecache(); + enablecache(); + +=head1 INHERITANCE + +Benchmark inherits from no other class, except of course +for Exporter. + +=head1 CAVEATS + +Comparing eval'd strings with code references will give you +inaccurate results: a code reference will show a slower +execution time than the equivalent eval'd string. + +The real time timing is done using time(2) and +the granularity is therefore only one second. + +Short tests may produce negative figures because perl +can appear to take longer to execute the empty loop +than a short test; try: + + timethis(100,'1'); + +The system time of the null loop might be slightly +more than the system time of the loop with the actual +code and therefore the difference might end up being E 0. + +=head1 AUTHORS + +Jarkko Hietaniemi >, Tim Bunce > + +=head1 MODIFICATION HISTORY + +September 8th, 1994; by Tim Bunce. + +March 28th, 1997; by Hugo van der Sanden: added support for code +references and the already documented 'debug' method; revamped +documentation. + +=cut + +use Carp; use Exporter; @ISA=(Exporter); @EXPORT=qw(timeit timethis timethese timediff timestr); @@ -101,72 +228,79 @@ sub init { &clearallcache; } +sub debug { $debug = ($_[1] != 0); } + sub clearcache { delete $cache{$_[0]}; } sub clearallcache { %cache = (); } sub enablecache { $cache = 1; } sub disablecache { $cache = 0; } - # --- Functions to process the 'time' data type -sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; } +sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; } sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; } sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; } -sub timediff{ +sub timediff { my($a, $b) = @_; - my(@r); - for($i=0; $i < @$a; ++$i){ + my @r; + for ($i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; } -sub timestr{ +sub timestr { my($tr, $style, $f) = @_; - my(@t) = @$tr; + my @t = @$tr; warn "bad time value" unless @t==5; my($r, $pu, $ps, $cu, $cs) = @t; my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); - $f = $defaultfmt unless $f; + $f = $defaultfmt unless defined $f; # format a time in the required style, other formats may be added here - $style = $defaultstyle unless $style; - $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/; - my($s) = "@t $style"; # default for unknown style + $style ||= $defaultstyle; + $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; + my $s = "@t $style"; # default for unknown style $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)", - @t,$t) if $style =~ /^all$/; + @t,$t) if $style eq 'all'; $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)", - $r,$pu,$ps,$pt) if $style =~ /^noc$/; + $r,$pu,$ps,$pt) if $style eq 'noc'; $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)", - $r,$cu,$cs,$ct) if $style =~ /^nop$/; + $r,$cu,$cs,$ct) if $style eq 'nop'; $s; } -sub timedebug{ + +sub timedebug { my($msg, $t) = @_; - print STDERR "$msg",timestr($t),"\n" if ($debug); + print STDERR "$msg",timestr($t),"\n" if $debug; } - # --- Functions implementing low-level support for timing loops sub runloop { my($n, $c) = @_; + + $n+=0; # force numeric now, so garbage won't creep into the eval + croak "negative loopcount $n" if $n<0; + confess "Usage: runloop(number, [string | coderef])" unless defined $c; my($t0, $t1, $td); # before, after, difference # find package of caller so we can execute code there - my ($curpack) = caller(0); - my ($i, $pack)= 0; + my($curpack) = caller(0); + my($i, $pack)= 0; while (($pack) = caller(++$i)) { last if $pack ne $curpack; } - my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; + my $subcode = (ref $c eq 'CODE') + ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }" + : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; my $subref = eval $subcode; - die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; - print STDERR "runloop $n '$subcode'\n" if ($debug); + croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; + print STDERR "runloop $n '$subcode'\n" if $debug; $t0 = &new; &$subref; @@ -184,9 +318,9 @@ sub timeit { printf STDERR "timeit $n $code\n" if $debug; - if ($cache && exists $cache{$n}){ + if ($cache && exists $cache{$n}) { $wn = $cache{$n}; - }else{ + } else { $wn = &runloop($n, ''); $cache{$n} = $wn; } @@ -202,44 +336,38 @@ sub timeit { $wd; } - # --- Functions implementing high-level time-then-print utilities sub timethis{ my($n, $code, $title, $style) = @_; - my($t) = timeit($n, $code); - local($|) = 1; - $title = "timethis $n" unless $title; - $style = "" unless $style; + my $t = timeit($n, $code); + local $| = 1; + $title = "timethis $n" unless defined $title; + $style = "" unless defined $style; printf("%10s: ", $title); print timestr($t, $style),"\n"; + # A conservative warning to spot very silly tests. # Don't assume that your benchmark is ok simply because # you don't get this warning! print " (warning: too few iterations for a reliable count)\n" - if ( $n < $min_count + if $n < $min_count || ($t->real < 1 && $n < 1000) - || $t->cpu_a < $min_cpu); + || $t->cpu_a < $min_cpu; $t; } - sub timethese{ my($n, $alt, $style) = @_; die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" unless ref $alt eq HASH; - my(@all); - my(@names) = sort keys %$alt; - $style = "" unless $style; + my @names = sort keys %$alt; + $style = "" unless defined $style; print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; - foreach(@names){ - $t = timethis($n, $alt->{$_}, $_, $style); - push(@all, $t); - } - # we could produce a summary from @all here + + # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc - @all; + map timethis($n, $alt->{$_}, $_, $style), @names; } - 1;