X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FBenchmark.pm;h=13acf869bc122d3b081523d8c0037eed76a47c7a;hb=bb9460edf8a898c5bc341b673bfeff1784c574c6;hp=40481f966248ce2a8b9fc28555f21e51691e04d6;hpb=f06db76b9e41859439aeadb79feb6c603ee741ff;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index 40481f9..13acf86 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -14,11 +14,18 @@ timeit - run a chunk of code and see how long it goes 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"; @@ -40,43 +47,70 @@ Returns the current time. Example: # ... your code here ... $t1 = new Benchmark; $td = timediff($t1, $t0); - print "the code took:",timestr($dt),"\n"; + print "the code took:",timestr($td),"\n"; =item debug Enables or disable debugging by setting the C<$Benchmark::Debug> flag: - debug Benchmark 1; + debug Benchmark 1; $t = timeit(10, ' 5 ** $Global '); - debug Benchmark 0; + debug Benchmark 0; =back =head2 Standard Exports -The following routines will be exported into your namespace +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 time to run the loop, and -the second is the code to run. CODE may be a string containing the code, -a reference to the function to run, or a reference to a hash containing -keys which are names and values which are more CODE specs. +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 ] ) -Side-effects: prints out noise to standard out. +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 -Returns: a Benchmark object. + timethis(COUNT, VALUE, KEY, STYLE) -=item timethis +=item timediff ( T1, T2 ) -=item timethese +Returns the difference between two Benchmark times as a Benchmark +object suitable for passing to timestr(). -=item timediff +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] ) -=item timestr +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 @@ -87,20 +121,31 @@ if you specifically ask that they be imported: =over 10 -clearcache +=item clearcache ( COUNT ) + +Clear the cached time for COUNT rounds of the null loop. + +=item clearallcache ( ) -clearallcache +Clear all cached times. -disablecache +=item disablecache ( ) -enablecache +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: +functions: ($real, $user, $system, $children_user, $children_system) @@ -110,10 +155,6 @@ The timing is done using time(3) and times(3). Code is executed in the caller's 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 subtracted from the time of the real loop. @@ -122,10 +163,10 @@ The null loop times are cached, the key being the number of rounds. The caching can be controlled using calls like these: - clearcache($key); + clearcache($key); clearallcache(); - disablecache(); + disablecache(); enablecache(); =head1 INHERITANCE @@ -135,113 +176,38 @@ 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: +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. +code and therefore the difference might end up being E 0. =head1 AUTHORS -Jarkko Hietaniemi , -Tim Bunce +Jarkko Hietaniemi >, Tim Bunce > =head1 MODIFICATION HISTORY September 8th, 1994; by Tim Bunce. -=cut +March 28th, 1997; by Hugo van der Sanden: added support for code +references and the already documented 'debug' method; revamped +documentation. -# 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 -# +=cut +use Carp; use Exporter; @ISA=(Exporter); @EXPORT=qw(timeit timethis timethese timediff timestr); @@ -262,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; @@ -345,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; } @@ -363,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;