This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
C<new SelectSaver $fh> doesn't always restore
[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
17 timethese($count, {
18 'Name1' => '...code1...',
19 'Name2' => '...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
27The Benchmark module encapsulates a number of routines to help you
28figure out how long it takes to execute some code.
29
30=head2 Methods
31
32=over 10
33
34=item new
35
36Returns 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);
a24a9dfe 43 print "the code took:",timestr($td),"\n";
f06db76b
AD
44
45=item debug
46
47Enables 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
57The following routines will be exported into your namespace
58if you use the Benchmark module:
59
60=over 10
61
62=item timeit(COUNT, CODE)
63
64Arguments: COUNT is the number of time to run the loop, and
65the second is the code to run. CODE may be a string containing the code,
66a reference to the function to run, or a reference to a hash containing
67keys which are names and values which are more CODE specs.
68
69Side-effects: prints out noise to standard out.
70
71Returns: a Benchmark object.
72
73=item timethis
74
75=item timethese
76
77=item timediff
78
79=item timestr
80
81=back
82
83=head2 Optional Exports
84
85The following routines will be exported into your namespace
86if you specifically ask that they be imported:
87
88=over 10
89
90clearcache
91
92clearallcache
93
94disablecache
95
96enablecache
97
98=back
99
100=head1 NOTES
101
102The data is stored as a list of values from the time and times
103functions:
104
105 ($real, $user, $system, $children_user, $children_system)
106
107in seconds for the whole loop (not divided by the number of rounds).
108
109The timing is done using time(3) and times(3).
110
111Code is executed in the caller's package.
112
113Enable debugging by:
114
115 $Benchmark::debug = 1;
116
117The time of the null loop (a loop with the same
118number of rounds but empty loop body) is subtracted
119from the time of the real loop.
120
121The null loop times are cached, the key being the
122number of rounds. The caching can be controlled using
123calls like these:
124
125 clearcache($key);
126 clearallcache();
127
128 disablecache();
129 enablecache();
130
131=head1 INHERITANCE
132
133Benchmark inherits from no other class, except of course
134for Exporter.
135
136=head1 CAVEATS
137
138The real time timing is done using time(2) and
139the granularity is therefore only one second.
140
141Short tests may produce negative figures because perl
142can appear to take longer to execute the empty loop
143than a short test; try:
144
145 timethis(100,'1');
146
147The system time of the null loop might be slightly
148more than the system time of the loop with the actual
a24a9dfe 149code and therefore the difference might end up being E<lt> 0.
f06db76b
AD
150
151More documentation is needed :-( especially for styles and formats.
152
153=head1 AUTHORS
154
a24a9dfe
PP
155Jarkko Hietaniemi E<lt>F<Jarkko.Hietaniemi@hut.fi>E<gt>,
156Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
f06db76b
AD
157
158=head1 MODIFICATION HISTORY
159
160September 8th, 1994; by Tim Bunce.
161
162=cut
163
a0d0e21e
LW
164# Purpose: benchmark running times of code.
165#
166#
167# Usage - to time code snippets and print results:
168#
169# timethis($count, '...code...');
170#
171# prints:
172# timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu)
173#
174#
175# timethese($count, {
176# Name1 => '...code1...',
177# Name2 => '...code2...',
178# ... });
179# prints:
180# Benchmark: timing 100 iterations of Name1, Name2...
181# Name1: 2 secs ( 0.50 usr 0.00 sys = 0.50 cpu)
182# Name2: 1 secs ( 0.48 usr 0.00 sys = 0.48 cpu)
183#
184# The default display style will automatically add child process
185# values if non-zero.
186#
187#
188# Usage - to time sections of your own code:
189#
190# use Benchmark;
191# $t0 = new Benchmark;
192# ... your code here ...
193# $t1 = new Benchmark;
194# $td = &timediff($t1, $t0);
195# print "the code took:",timestr($td),"\n";
196#
197# $t = &timeit($count, '...other code...')
198# print "$count loops of other code took:",timestr($t),"\n";
199#
200#
201# Data format:
202# The data is stored as a list of values from the time and times
203# functions: ($real, $user, $system, $children_user, $children_system)
204# in seconds for the whole loop (not divided by the number of rounds).
205#
206# Internals:
207# The timing is done using time(3) and times(3).
208#
209# Code is executed in the callers package
210#
211# Enable debugging by: $Benchmark::debug = 1;
212#
213# The time of the null loop (a loop with the same
214# number of rounds but empty loop body) is substracted
215# from the time of the real loop.
216#
217# The null loop times are cached, the key being the
218# number of rounds. The caching can be controlled using
219# &clearcache($key); &clearallcache;
220# &disablecache; &enablecache;
221#
222# Caveats:
223#
224# The real time timing is done using time(2) and
225# the granularity is therefore only one second.
226#
227# Short tests may produce negative figures because perl
228# can appear to take longer to execute the empty loop
229# than a short test: try timethis(100,'1');
230#
231# The system time of the null loop might be slightly
232# more than the system time of the loop with the actual
233# code and therefore the difference might end up being < 0
234#
235# More documentation is needed :-(
236# Especially for styles and formats.
237#
238# Authors: Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
239# Tim Bunce <Tim.Bunce@ig.co.uk>
240#
241#
242# Last updated: Sept 8th 94 by Tim Bunce
243#
244
4aa0a1f7 245use Carp;
a0d0e21e
LW
246use Exporter;
247@ISA=(Exporter);
248@EXPORT=qw(timeit timethis timethese timediff timestr);
249@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
250
251&init;
252
253sub init {
254 $debug = 0;
255 $min_count = 4;
256 $min_cpu = 0.4;
257 $defaultfmt = '5.2f';
258 $defaultstyle = 'auto';
259 # The cache can cause a slight loss of sys time accuracy. If a
260 # user does many tests (>10) with *very* large counts (>10000)
261 # or works on a very slow machine the cache may be useful.
262 &disablecache;
263 &clearallcache;
264}
265
266sub clearcache { delete $cache{$_[0]}; }
267sub clearallcache { %cache = (); }
268sub enablecache { $cache = 1; }
269sub disablecache { $cache = 0; }
270
271
272# --- Functions to process the 'time' data type
273
274sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
275
276sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
277sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
278sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
279sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
280
281sub timediff{
282 my($a, $b) = @_;
283 my(@r);
284 for($i=0; $i < @$a; ++$i){
285 push(@r, $a->[$i] - $b->[$i]);
286 }
287 bless \@r;
288}
289
290sub timestr{
291 my($tr, $style, $f) = @_;
292 my(@t) = @$tr;
293 warn "bad time value" unless @t==5;
294 my($r, $pu, $ps, $cu, $cs) = @t;
295 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
296 $f = $defaultfmt unless $f;
297 # format a time in the required style, other formats may be added here
298 $style = $defaultstyle unless $style;
299 $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
300 my($s) = "@t $style"; # default for unknown style
301 $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
302 @t,$t) if $style =~ /^all$/;
303 $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
304 $r,$pu,$ps,$pt) if $style =~ /^noc$/;
305 $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
306 $r,$cu,$cs,$ct) if $style =~ /^nop$/;
307 $s;
308}
309sub timedebug{
310 my($msg, $t) = @_;
311 print STDERR "$msg",timestr($t),"\n" if ($debug);
312}
313
314
315# --- Functions implementing low-level support for timing loops
316
317sub runloop {
318 my($n, $c) = @_;
4aa0a1f7
AD
319
320 $n+=0; # force numeric now, so garbage won't creep into the eval
321 croak "negativ loopcount $n" if $n<0;
322 confess "Usage: runloop(number, string)" unless defined $c;
a0d0e21e
LW
323 my($t0, $t1, $td); # before, after, difference
324
325 # find package of caller so we can execute code there
326 my ($curpack) = caller(0);
327 my ($i, $pack)= 0;
328 while (($pack) = caller(++$i)) {
329 last if $pack ne $curpack;
330 }
331
0d72c55d
HS
332 my $subcode = (ref $c eq 'CODE')
333 ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }"
334 : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
a0d0e21e 335 my $subref = eval $subcode;
4aa0a1f7 336 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
a0d0e21e
LW
337 print STDERR "runloop $n '$subcode'\n" if ($debug);
338
339 $t0 = &new;
340 &$subref;
341 $t1 = &new;
342 $td = &timediff($t1, $t0);
343
344 timedebug("runloop:",$td);
345 $td;
346}
347
348
349sub timeit {
350 my($n, $code) = @_;
351 my($wn, $wc, $wd);
352
353 printf STDERR "timeit $n $code\n" if $debug;
354
355 if ($cache && exists $cache{$n}){
356 $wn = $cache{$n};
357 }else{
358 $wn = &runloop($n, '');
359 $cache{$n} = $wn;
360 }
361
362 $wc = &runloop($n, $code);
363
364 $wd = timediff($wc, $wn);
365
366 timedebug("timeit: ",$wc);
367 timedebug(" - ",$wn);
368 timedebug(" = ",$wd);
369
370 $wd;
371}
372
373
374# --- Functions implementing high-level time-then-print utilities
375
376sub timethis{
377 my($n, $code, $title, $style) = @_;
378 my($t) = timeit($n, $code);
379 local($|) = 1;
380 $title = "timethis $n" unless $title;
381 $style = "" unless $style;
382 printf("%10s: ", $title);
383 print timestr($t, $style),"\n";
384 # A conservative warning to spot very silly tests.
385 # Don't assume that your benchmark is ok simply because
386 # you don't get this warning!
387 print " (warning: too few iterations for a reliable count)\n"
388 if ( $n < $min_count
389 || ($t->real < 1 && $n < 1000)
390 || $t->cpu_a < $min_cpu);
391 $t;
392}
393
394
395sub timethese{
396 my($n, $alt, $style) = @_;
397 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
398 unless ref $alt eq HASH;
399 my(@all);
400 my(@names) = sort keys %$alt;
401 $style = "" unless $style;
402 print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
403 foreach(@names){
404 $t = timethis($n, $alt->{$_}, $_, $style);
405 push(@all, $t);
406 }
407 # we could produce a summary from @all here
408 # sum, min, max, avg etc etc
409 @all;
410}
411
412
4131;