This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regenerate Configure.
[perl5.git] / lib / Benchmark.pm
CommitLineData
a0d0e21e
LW
1package Benchmark;
2
f06db76b
AD
3=head1 NAME
4
5Benchmark - benchmark running times of code
6
7timethis - run a chunk of code several times
8
9timethese - run several chunks of code several times
10
11timeit - run a chunk of code and see how long it goes
12
13=head1 SYNOPSIS
14
15 timethis ($count, "code");
16
523cc92b 17 # Use Perl code in strings...
f06db76b
AD
18 timethese($count, {
19 'Name1' => '...code1...',
20 'Name2' => '...code2...',
21 });
22
523cc92b
CS
23 # ... or use subroutine references.
24 timethese($count, {
25 'Name1' => sub { ...code1... },
26 'Name2' => sub { ...code2... },
27 });
28
f06db76b
AD
29 $t = timeit($count, '...other code...')
30 print "$count loops of other code took:",timestr($t),"\n";
31
32=head1 DESCRIPTION
33
34The Benchmark module encapsulates a number of routines to help you
35figure out how long it takes to execute some code.
36
37=head2 Methods
38
39=over 10
40
41=item new
42
43Returns 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);
a24a9dfe 50 print "the code took:",timestr($td),"\n";
f06db76b
AD
51
52=item debug
53
54Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
55
523cc92b 56 debug Benchmark 1;
f06db76b 57 $t = timeit(10, ' 5 ** $Global ');
523cc92b 58 debug Benchmark 0;
f06db76b
AD
59
60=back
61
62=head2 Standard Exports
63
523cc92b 64The following routines will be exported into your namespace
f06db76b
AD
65if you use the Benchmark module:
66
67=over 10
68
69=item timeit(COUNT, CODE)
70
523cc92b
CS
71Arguments: COUNT is the number of times to run the loop, and CODE is
72the code to run. CODE may be either a code reference or a string to
73be eval'd; either way it will be run in the caller's package.
74
75Returns: a Benchmark object.
76
77=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
78
79Time COUNT iterations of CODE. CODE may be a string to eval or a
80code reference; either way the CODE will run in the caller's package.
81Results will be printed to STDOUT as TITLE followed by the times.
82TITLE defaults to "timethis COUNT" if none is provided. STYLE
83determines the format of the output, as described for timestr() below.
84
6ee623d5
GS
85The COUNT can be zero or negative: this means the I<minimum number of
86CPU seconds> to run. A zero signifies the default of 3 seconds. For
87example to run at least for 10 seconds:
88
89 timethis(-10, $code)
90
91or to run two pieces of code tests for at least 3 seconds:
92
93 timethese(0, { test1 => '...', test2 => '...'})
94
95CPU seconds is, in UNIX terms, the user time plus the system time of
96the process itself, as opposed to the real (wallclock) time and the
97time spent by the child processes. Less than 0.1 seconds is not
98accepted (-0.01 as the count, for example, will cause a fatal runtime
99exception).
100
101Note that the CPU seconds is the B<minimum> time: CPU scheduling and
102other operating system factors may complicate the attempt so that a
103little bit more time is spent. The benchmark output will, however,
104also tell the number of C<$code> runs/second, which should be a more
105interesting number than the actually spent seconds.
106
107Returns a Benchmark object.
108
523cc92b 109=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
f06db76b 110
523cc92b
CS
111The CODEHASHREF is a reference to a hash containing names as keys
112and either a string to eval or a code reference for each value.
113For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
114call
f06db76b 115
523cc92b 116 timethis(COUNT, VALUE, KEY, STYLE)
f06db76b 117
1d2dff63
GS
118The routines are called in string comparison order of KEY.
119
120The COUNT can be zero or negative, see timethis().
6ee623d5 121
523cc92b 122=item timediff ( T1, T2 )
f06db76b 123
523cc92b
CS
124Returns the difference between two Benchmark times as a Benchmark
125object suitable for passing to timestr().
f06db76b 126
705cc255
TB
127=item timesum ( T1, T2 )
128
129Returns the sum of two Benchmark times as a Benchmark object suitable
130for passing to timestr().
131
6ee623d5 132=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
f06db76b 133
523cc92b
CS
134Returns a string that formats the times in the TIMEDIFF object in
135the requested STYLE. TIMEDIFF is expected to be a Benchmark object
136similar to that returned by timediff().
137
138STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
139of the 5 times available ('wallclock' time, user time, system time,
140user time of children, and system time of children). 'noc' shows all
141except the two children times. 'nop' shows only wallclock and the
142two children times. 'auto' (the default) will act as 'all' unless
143the children times are both zero, in which case it acts as 'noc'.
144
145FORMAT is the L<printf(3)>-style format specifier (without the
146leading '%') to use to print the times. It defaults to '5.2f'.
f06db76b
AD
147
148=back
149
150=head2 Optional Exports
151
152The following routines will be exported into your namespace
153if you specifically ask that they be imported:
154
155=over 10
156
523cc92b
CS
157=item clearcache ( COUNT )
158
159Clear the cached time for COUNT rounds of the null loop.
160
161=item clearallcache ( )
f06db76b 162
523cc92b 163Clear all cached times.
f06db76b 164
523cc92b 165=item disablecache ( )
f06db76b 166
523cc92b
CS
167Disable caching of timings for the null loop. This will force Benchmark
168to recalculate these timings for each new piece of code timed.
169
170=item enablecache ( )
171
172Enable caching of timings for the null loop. The time taken for COUNT
173rounds of the null loop will be calculated only once for each
174different COUNT used.
f06db76b
AD
175
176=back
177
178=head1 NOTES
179
180The data is stored as a list of values from the time and times
523cc92b 181functions:
f06db76b
AD
182
183 ($real, $user, $system, $children_user, $children_system)
184
185in seconds for the whole loop (not divided by the number of rounds).
186
187The timing is done using time(3) and times(3).
188
189Code is executed in the caller's package.
190
f06db76b
AD
191The time of the null loop (a loop with the same
192number of rounds but empty loop body) is subtracted
193from the time of the real loop.
194
195The null loop times are cached, the key being the
196number of rounds. The caching can be controlled using
197calls like these:
198
523cc92b 199 clearcache($key);
f06db76b
AD
200 clearallcache();
201
523cc92b 202 disablecache();
f06db76b
AD
203 enablecache();
204
205=head1 INHERITANCE
206
207Benchmark inherits from no other class, except of course
208for Exporter.
209
210=head1 CAVEATS
211
80eab818
CS
212Comparing eval'd strings with code references will give you
213inaccurate results: a code reference will show a slower
214execution time than the equivalent eval'd string.
215
f06db76b
AD
216The real time timing is done using time(2) and
217the granularity is therefore only one second.
218
219Short tests may produce negative figures because perl
523cc92b
CS
220can appear to take longer to execute the empty loop
221than a short test; try:
f06db76b
AD
222
223 timethis(100,'1');
224
225The system time of the null loop might be slightly
226more than the system time of the loop with the actual
a24a9dfe 227code and therefore the difference might end up being E<lt> 0.
f06db76b 228
f06db76b
AD
229=head1 AUTHORS
230
5aabfad6 231Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
f06db76b
AD
232
233=head1 MODIFICATION HISTORY
234
235September 8th, 1994; by Tim Bunce.
236
523cc92b
CS
237March 28th, 1997; by Hugo van der Sanden: added support for code
238references and the already documented 'debug' method; revamped
239documentation.
f06db76b 240
6ee623d5
GS
241April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
242functionality.
243
523cc92b 244=cut
a0d0e21e 245
3f943bd9
GS
246# evaluate something in a clean lexical environment
247sub _doeval { eval shift }
248
249#
250# put any lexicals at file scope AFTER here
251#
252
4aa0a1f7 253use Carp;
a0d0e21e
LW
254use Exporter;
255@ISA=(Exporter);
33841f1e 256@EXPORT=qw(timeit timethis timethese timediff timesum timestr);
a0d0e21e
LW
257@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
258
259&init;
260
261sub init {
262 $debug = 0;
263 $min_count = 4;
264 $min_cpu = 0.4;
265 $defaultfmt = '5.2f';
266 $defaultstyle = 'auto';
267 # The cache can cause a slight loss of sys time accuracy. If a
268 # user does many tests (>10) with *very* large counts (>10000)
269 # or works on a very slow machine the cache may be useful.
270 &disablecache;
271 &clearallcache;
272}
273
523cc92b
CS
274sub debug { $debug = ($_[1] != 0); }
275
bba8fca5
BS
276# The cache needs two branches: 's' for strings and 'c' for code. The
277# emtpy loop is different in these two cases.
278sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
a0d0e21e
LW
279sub clearallcache { %cache = (); }
280sub enablecache { $cache = 1; }
281sub disablecache { $cache = 0; }
282
a0d0e21e
LW
283# --- Functions to process the 'time' data type
284
6ee623d5
GS
285sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
286 print "new=@t\n" if $debug;
287 bless \@t; }
a0d0e21e
LW
288
289sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
290sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
291sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
292sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
293
523cc92b 294sub timediff {
a0d0e21e 295 my($a, $b) = @_;
523cc92b 296 my @r;
3f943bd9 297 for (my $i=0; $i < @$a; ++$i) {
a0d0e21e
LW
298 push(@r, $a->[$i] - $b->[$i]);
299 }
300 bless \@r;
301}
302
705cc255
TB
303sub timesum {
304 my($a, $b) = @_;
305 my @r;
306 for (my $i=0; $i < @$a; ++$i) {
307 push(@r, $a->[$i] + $b->[$i]);
308 }
309 bless \@r;
310}
311
523cc92b 312sub timestr {
a0d0e21e 313 my($tr, $style, $f) = @_;
523cc92b 314 my @t = @$tr;
6ee623d5
GS
315 warn "bad time value (@t)" unless @t==6;
316 my($r, $pu, $ps, $cu, $cs, $n) = @t;
a0d0e21e 317 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
523cc92b 318 $f = $defaultfmt unless defined $f;
a0d0e21e 319 # format a time in the required style, other formats may be added here
80eab818 320 $style ||= $defaultstyle;
523cc92b
CS
321 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
322 my $s = "@t $style"; # default for unknown style
7be077a2 323 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
523cc92b 324 @t,$t) if $style eq 'all';
7be077a2
GS
325 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
326 $r,$pu,$ps,$pt) if $style eq 'noc';
327 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
328 $r,$cu,$cs,$ct) if $style eq 'nop';
6ee623d5 329 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
a0d0e21e
LW
330 $s;
331}
523cc92b
CS
332
333sub timedebug {
a0d0e21e 334 my($msg, $t) = @_;
523cc92b 335 print STDERR "$msg",timestr($t),"\n" if $debug;
a0d0e21e
LW
336}
337
a0d0e21e
LW
338# --- Functions implementing low-level support for timing loops
339
340sub runloop {
341 my($n, $c) = @_;
4aa0a1f7
AD
342
343 $n+=0; # force numeric now, so garbage won't creep into the eval
523cc92b
CS
344 croak "negative loopcount $n" if $n<0;
345 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
a0d0e21e
LW
346 my($t0, $t1, $td); # before, after, difference
347
348 # find package of caller so we can execute code there
523cc92b
CS
349 my($curpack) = caller(0);
350 my($i, $pack)= 0;
a0d0e21e
LW
351 while (($pack) = caller(++$i)) {
352 last if $pack ne $curpack;
353 }
354
3f943bd9
GS
355 my ($subcode, $subref);
356 if (ref $c eq 'CODE') {
357 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
358 $subref = eval $subcode;
359 }
360 else {
361 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
362 $subref = _doeval($subcode);
363 }
4aa0a1f7 364 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
523cc92b 365 print STDERR "runloop $n '$subcode'\n" if $debug;
a0d0e21e 366
bba8fca5
BS
367 # Wait for the user timer to tick. This makes the error range more like -0.01, +0. If
368 # we don't wait, then it's more like -0.01, +0.01. This may not seem important, but it
369 # significantly reduces the chances of getting too low initial $n in the initial, 'find
370 # the minimum' loop in &runfor. This, in turn, can reduce the number of calls to
371 # &runloop a lot, and thus reduce additive errors.
372 my $tbase = Benchmark->new(0)->[1];
373 do {
374 $t0 = Benchmark->new(0);
375 } while ( $t0->[1] == $tbase ) ;
a0d0e21e 376 &$subref;
6ee623d5 377 $t1 = Benchmark->new($n);
a0d0e21e 378 $td = &timediff($t1, $t0);
a0d0e21e
LW
379 timedebug("runloop:",$td);
380 $td;
381}
382
383
384sub timeit {
385 my($n, $code) = @_;
386 my($wn, $wc, $wd);
387
388 printf STDERR "timeit $n $code\n" if $debug;
bba8fca5
BS
389 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ) ;
390 if ($cache && exists $cache{$cache_key} ) {
391 $wn = $cache{$cache_key};
523cc92b 392 } else {
bba8fca5
BS
393 $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
394 $cache{$cache_key} = $wn;
a0d0e21e
LW
395 }
396
397 $wc = &runloop($n, $code);
398
399 $wd = timediff($wc, $wn);
400
401 timedebug("timeit: ",$wc);
402 timedebug(" - ",$wn);
403 timedebug(" = ",$wd);
404
405 $wd;
406}
407
6ee623d5
GS
408
409my $default_for = 3;
410my $min_for = 0.1;
411
412sub runfor {
413 my ($code, $tmax) = @_;
414
415 if ( not defined $tmax or $tmax == 0 ) {
416 $tmax = $default_for;
417 } elsif ( $tmax < 0 ) {
418 $tmax = -$tmax;
419 }
420
421 die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
422 if $tmax < $min_for;
423
424 my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
425
bba8fca5 426 # First find the minimum $n that gives a significant timing.
6ee623d5
GS
427
428 my $nmin;
429
bba8fca5 430 for ($n = 1, $tc = 0; ; $n *= 2 ) {
6ee623d5
GS
431 $td = timeit($n, $code);
432 $tc = $td->[1] + $td->[2];
bba8fca5 433 last if $tc > 0.1 ;
6ee623d5
GS
434 }
435
436 $nmin = $n;
437
438 my $ttot = 0;
439 my $tpra = 0.05 * $tmax; # Target/time practice.
6ee623d5 440 # Double $n until we have think we have practiced enough.
bba8fca5 441 for ( ; $ttot < $tpra; $n *= 2 ) {
6ee623d5 442 $td = timeit($n, $code);
6ee623d5
GS
443 $ntot += $n;
444 $rtot += $td->[0];
445 $utot += $td->[1];
446 $stot += $td->[2];
447 $ttot = $utot + $stot;
448 $cutot += $td->[3];
449 $cstot += $td->[4];
450 }
451
452 my $r;
453
454 # Then iterate towards the $tmax.
455 while ( $ttot < $tmax ) {
456 $r = $tmax / $ttot - 1; # Linear approximation.
bba8fca5 457 $n = int( $r * $ntot );
6ee623d5
GS
458 $n = $nmin if $n < $nmin;
459 $td = timeit($n, $code);
460 $ntot += $n;
461 $rtot += $td->[0];
462 $utot += $td->[1];
463 $stot += $td->[2];
464 $ttot = $utot + $stot;
465 $cutot += $td->[3];
466 $cstot += $td->[4];
467 }
468
469 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
470}
471
a0d0e21e
LW
472# --- Functions implementing high-level time-then-print utilities
473
6ee623d5
GS
474sub n_to_for {
475 my $n = shift;
476 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
477}
478
a0d0e21e
LW
479sub timethis{
480 my($n, $code, $title, $style) = @_;
6ee623d5
GS
481 my($t, $for, $forn);
482
483 if ( $n > 0 ) {
484 croak "non-integer loopcount $n, stopped" if int($n)<$n;
485 $t = timeit($n, $code);
486 $title = "timethis $n" unless defined $title;
487 } else {
488 $fort = n_to_for( $n );
489 $t = runfor($code, $fort);
490 $title = "timethis for $fort" unless defined $title;
491 $forn = $t->[-1];
492 }
523cc92b 493 local $| = 1;
523cc92b 494 $style = "" unless defined $style;
a0d0e21e 495 printf("%10s: ", $title);
6ee623d5
GS
496 print timestr($t, $style, $defaultfmt),"\n";
497
498 $n = $forn if defined $forn;
523cc92b 499
a0d0e21e
LW
500 # A conservative warning to spot very silly tests.
501 # Don't assume that your benchmark is ok simply because
502 # you don't get this warning!
503 print " (warning: too few iterations for a reliable count)\n"
523cc92b 504 if $n < $min_count
a0d0e21e 505 || ($t->real < 1 && $n < 1000)
523cc92b 506 || $t->cpu_a < $min_cpu;
a0d0e21e
LW
507 $t;
508}
509
a0d0e21e
LW
510sub timethese{
511 my($n, $alt, $style) = @_;
512 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
513 unless ref $alt eq HASH;
523cc92b
CS
514 my @names = sort keys %$alt;
515 $style = "" unless defined $style;
6ee623d5
GS
516 print "Benchmark: ";
517 if ( $n > 0 ) {
518 croak "non-integer loopcount $n, stopped" if int($n)<$n;
519 print "timing $n iterations of";
520 } else {
521 print "running";
522 }
523 print " ", join(', ',@names);
524 unless ( $n > 0 ) {
525 my $for = n_to_for( $n );
526 print ", each for at least $for CPU seconds";
527 }
528 print "...\n";
523cc92b
CS
529
530 # we could save the results in an array and produce a summary here
a0d0e21e 531 # sum, min, max, avg etc etc
4dbb2df9
A
532 foreach my $name (@names) {
533 timethis ($n, $alt -> {$name}, $name, $style);
534 }
a0d0e21e
LW
535}
536
a0d0e21e 5371;