lib/Benchmark.pm

   1 package Benchmark;
   2
   3 =head1 NAME
   4
   5 Benchmark - benchmark running times of code
   6
   7 timethis - run a chunk of code several times
   8
   9 timethese - run several chunks of code several times
  10
  11 timeit - run a chunk of code and see how long it goes
  12
  13 =head1 SYNOPSIS
  14
  15     timethis ($count, "code");
  16
  17     # Use Perl code in strings...
  18     timethese($count, {
  19         'Name1' => '...code1...',
  20         'Name2' => '...code2...',
  21     });
  22
  23     # ... or use subroutine references.
  24     timethese($count, {
  25         'Name1' => sub { ...code1... },
  26         'Name2' => sub { ...code2... },
  27     });
  28
  29     $t = timeit($count, '...other code...')
  30     print "$count loops of other code took:",timestr($t),"\n";
  31
  32 =head1 DESCRIPTION
  33
  34 The Benchmark module encapsulates a number of routines to help you
  35 figure out how long it takes to execute some code.
  36
  37 =head2 Methods
  38
  39 =over 10
  40
  41 =item new
  42
  43 Returns the current time.   Example:
  44
  45     use Benchmark;
  46     $t0 = new Benchmark;
  47     # ... your code here ...
  48     $t1 = new Benchmark;
  49     $td = timediff($t1, $t0);
  50     print "the code took:",timestr($td),"\n";
  51
  52 =item debug
  53
  54 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
  55
  56     debug Benchmark 1;
  57     $t = timeit(10, ' 5 ** $Global ');
  58     debug Benchmark 0;
  59
  60 =back
  61
  62 =head2 Standard Exports
  63
  64 The following routines will be exported into your namespace
  65 if you use the Benchmark module:
  66
  67 =over 10
  68
  69 =item timeit(COUNT, CODE)
  70
  71 Arguments: COUNT is the number of times to run the loop, and CODE is
  72 the code to run.  CODE may be either a code reference or a string to
  73 be eval'd; either way it will be run in the caller's package.
  74
  75 Returns: a Benchmark object.
  76
  77 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
  78
  79 Time COUNT iterations of CODE. CODE may be a string to eval or a
  80 code reference; either way the CODE will run in the caller's package.
  81 Results will be printed to STDOUT as TITLE followed by the times.
  82 TITLE defaults to "timethis COUNT" if none is provided. STYLE
  83 determines the format of the output, as described for timestr() below.
  84
  85 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
  86
  87 The CODEHASHREF is a reference to a hash containing names as keys
  88 and either a string to eval or a code reference for each value.
  89 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
  90 call
  91
  92         timethis(COUNT, VALUE, KEY, STYLE)
  93
  94 =item timediff ( T1, T2 )
  95
  96 Returns the difference between two Benchmark times as a Benchmark
  97 object suitable for passing to timestr().
  98
  99 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] )
 100
 101 Returns a string that formats the times in the TIMEDIFF object in
 102 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
 103 similar to that returned by timediff().
 104
 105 STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
 106 of the 5 times available ('wallclock' time, user time, system time,
 107 user time of children, and system time of children). 'noc' shows all
 108 except the two children times. 'nop' shows only wallclock and the
 109 two children times. 'auto' (the default) will act as 'all' unless
 110 the children times are both zero, in which case it acts as 'noc'.
 111
 112 FORMAT is the L<printf(3)>-style format specifier (without the
 113 leading '%') to use to print the times. It defaults to '5.2f'.
 114
 115 =back
 116
 117 =head2 Optional Exports
 118
 119 The following routines will be exported into your namespace
 120 if you specifically ask that they be imported:
 121
 122 =over 10
 123
 124 =item clearcache ( COUNT )
 125
 126 Clear the cached time for COUNT rounds of the null loop.
 127
 128 =item clearallcache ( )
 129
 130 Clear all cached times.
 131
 132 =item disablecache ( )
 133
 134 Disable caching of timings for the null loop. This will force Benchmark
 135 to recalculate these timings for each new piece of code timed.
 136
 137 =item enablecache ( )
 138
 139 Enable caching of timings for the null loop. The time taken for COUNT
 140 rounds of the null loop will be calculated only once for each
 141 different COUNT used.
 142
 143 =back
 144
 145 =head1 NOTES
 146
 147 The data is stored as a list of values from the time and times
 148 functions:
 149
 150       ($real, $user, $system, $children_user, $children_system)
 151
 152 in seconds for the whole loop (not divided by the number of rounds).
 153
 154 The timing is done using time(3) and times(3).
 155
 156 Code is executed in the caller's package.
 157
 158 The time of the null loop (a loop with the same
 159 number of rounds but empty loop body) is subtracted
 160 from the time of the real loop.
 161
 162 The null loop times are cached, the key being the
 163 number of rounds. The caching can be controlled using
 164 calls like these:
 165
 166     clearcache($key);
 167     clearallcache();
 168
 169     disablecache();
 170     enablecache();
 171
 172 =head1 INHERITANCE
 173
 174 Benchmark inherits from no other class, except of course
 175 for Exporter.
 176
 177 =head1 CAVEATS
 178
 179 Comparing eval'd strings with code references will give you
 180 inaccurate results: a code reference will show a slower
 181 execution time than the equivalent eval'd string.
 182
 183 The real time timing is done using time(2) and
 184 the granularity is therefore only one second.
 185
 186 Short tests may produce negative figures because perl
 187 can appear to take longer to execute the empty loop
 188 than a short test; try:
 189
 190     timethis(100,'1');
 191
 192 The system time of the null loop might be slightly
 193 more than the system time of the loop with the actual
 194 code and therefore the difference might end up being E<lt> 0.
 195
 196 =head1 AUTHORS
 197
 198 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 199
 200 =head1 MODIFICATION HISTORY
 201
 202 September 8th, 1994; by Tim Bunce.
 203
 204 March 28th, 1997; by Hugo van der Sanden: added support for code
 205 references and the already documented 'debug' method; revamped
 206 documentation.
 207
 208 =cut
 209
 210 use Carp;
 211 use Exporter;
 212 @ISA=(Exporter);
 213 @EXPORT=qw(timeit timethis timethese timediff timestr);
 214 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
 215
 216 &init;
 217
 218 sub init {
 219     $debug = 0;
 220     $min_count = 4;
 221     $min_cpu   = 0.4;
 222     $defaultfmt = '5.2f';
 223     $defaultstyle = 'auto';
 224     # The cache can cause a slight loss of sys time accuracy. If a
 225     # user does many tests (>10) with *very* large counts (>10000)
 226     # or works on a very slow machine the cache may be useful.
 227     &disablecache;
 228     &clearallcache;
 229 }
 230
 231 sub debug { $debug = ($_[1] != 0); }
 232
 233 sub clearcache    { delete $cache{$_[0]}; }
 234 sub clearallcache { %cache = (); }
 235 sub enablecache   { $cache = 1; }
 236 sub disablecache  { $cache = 0; }
 237
 238 # --- Functions to process the 'time' data type
 239
 240 sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; }
 241
 242 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 243 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 244 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 245 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 246
 247 sub timediff {
 248     my($a, $b) = @_;
 249     my @r;
 250     for ($i=0; $i < @$a; ++$i) {
 251         push(@r, $a->[$i] - $b->[$i]);
 252     }
 253     bless \@r;
 254 }
 255
 256 sub timestr {
 257     my($tr, $style, $f) = @_;
 258     my @t = @$tr;
 259     warn "bad time value" unless @t==5;
 260     my($r, $pu, $ps, $cu, $cs) = @t;
 261     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 262     $f = $defaultfmt unless defined $f;
 263     # format a time in the required style, other formats may be added here
 264     $style ||= $defaultstyle;
 265     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 266     my $s = "@t $style"; # default for unknown style
 267     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
 268                             @t,$t) if $style eq 'all';
 269     $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
 270                             $r,$pu,$ps,$pt) if $style eq 'noc';
 271     $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
 272                             $r,$cu,$cs,$ct) if $style eq 'nop';
 273     $s;
 274 }
 275
 276 sub timedebug {
 277     my($msg, $t) = @_;
 278     print STDERR "$msg",timestr($t),"\n" if $debug;
 279 }
 280
 281 # --- Functions implementing low-level support for timing loops
 282
 283 sub runloop {
 284     my($n, $c) = @_;
 285
 286     $n+=0; # force numeric now, so garbage won't creep into the eval
 287     croak "negative loopcount $n" if $n<0;
 288     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 289     my($t0, $t1, $td); # before, after, difference
 290
 291     # find package of caller so we can execute code there
 292     my($curpack) = caller(0);
 293     my($i, $pack)= 0;
 294     while (($pack) = caller(++$i)) {
 295         last if $pack ne $curpack;
 296     }
 297
 298     my $subcode = (ref $c eq 'CODE')
 299         ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }"
 300         : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
 301     my $subref  = eval $subcode;
 302     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 303     print STDERR "runloop $n '$subcode'\n" if $debug;
 304
 305     $t0 = &new;
 306     &$subref;
 307     $t1 = &new;
 308     $td = &timediff($t1, $t0);
 309
 310     timedebug("runloop:",$td);
 311     $td;
 312 }
 313
 314
 315 sub timeit {
 316     my($n, $code) = @_;
 317     my($wn, $wc, $wd);
 318
 319     printf STDERR "timeit $n $code\n" if $debug;
 320
 321     if ($cache && exists $cache{$n}) {
 322         $wn = $cache{$n};
 323     } else {
 324         $wn = &runloop($n, '');
 325         $cache{$n} = $wn;
 326     }
 327
 328     $wc = &runloop($n, $code);
 329
 330     $wd = timediff($wc, $wn);
 331
 332     timedebug("timeit: ",$wc);
 333     timedebug("      - ",$wn);
 334     timedebug("      = ",$wd);
 335
 336     $wd;
 337 }
 338
 339 # --- Functions implementing high-level time-then-print utilities
 340
 341 sub timethis{
 342     my($n, $code, $title, $style) = @_;
 343     my $t = timeit($n, $code);
 344     local $| = 1;
 345     $title = "timethis $n" unless defined $title;
 346     $style = "" unless defined $style;
 347     printf("%10s: ", $title);
 348     print timestr($t, $style),"\n";
 349
 350     # A conservative warning to spot very silly tests.
 351     # Don't assume that your benchmark is ok simply because
 352     # you don't get this warning!
 353     print "            (warning: too few iterations for a reliable count)\n"
 354         if     $n < $min_count
 355             || ($t->real < 1 && $n < 1000)
 356             || $t->cpu_a < $min_cpu;
 357     $t;
 358 }
 359
 360 sub timethese{
 361     my($n, $alt, $style) = @_;
 362     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 363                 unless ref $alt eq HASH;
 364     my @names = sort keys %$alt;
 365     $style = "" unless defined $style;
 366     print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
 367
 368     # we could save the results in an array and produce a summary here
 369     # sum, min, max, avg etc etc
 370     map timethis($n, $alt->{$_}, $_, $style), @names;
 371 }
 372
 373 1;