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