This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Benchmark: using code refs
[perl5.git] / 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' => '...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 time to run the loop, and 
65 the second is the code to run.  CODE may be a string containing the code,
66 a reference to the function to run, or a reference to a hash containing 
67 keys which are names and values which are more CODE specs.
68
69 Side-effects: prints out noise to standard out.
70
71 Returns: 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
85 The following routines will be exported into your namespace
86 if you specifically ask that they be imported:
87
88 =over 10
89
90 clearcache
91
92 clearallcache
93
94 disablecache
95
96 enablecache
97
98 =back
99
100 =head1 NOTES
101
102 The data is stored as a list of values from the time and times
103 functions: 
104
105       ($real, $user, $system, $children_user, $children_system)
106
107 in seconds for the whole loop (not divided by the number of rounds).
108
109 The timing is done using time(3) and times(3).
110
111 Code is executed in the caller's package.
112
113 Enable debugging by:  
114
115     $Benchmark::debug = 1;
116
117 The time of the null loop (a loop with the same
118 number of rounds but empty loop body) is subtracted
119 from the time of the real loop.
120
121 The null loop times are cached, the key being the
122 number of rounds. The caching can be controlled using
123 calls like these:
124
125     clearcache($key); 
126     clearallcache();
127
128     disablecache(); 
129     enablecache();
130
131 =head1 INHERITANCE
132
133 Benchmark inherits from no other class, except of course
134 for Exporter.
135
136 =head1 CAVEATS
137
138 The real time timing is done using time(2) and
139 the granularity is therefore only one second.
140
141 Short tests may produce negative figures because perl
142 can appear to take longer to execute the empty loop 
143 than a short test; try: 
144
145     timethis(100,'1');
146
147 The system time of the null loop might be slightly
148 more than the system time of the loop with the actual
149 code and therefore the difference might end up being E<lt> 0.
150
151 More documentation is needed :-( especially for styles and formats.
152
153 =head1 AUTHORS
154
155 Jarkko Hietaniemi E<lt>F<Jarkko.Hietaniemi@hut.fi>E<gt>,
156 Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
157
158 =head1 MODIFICATION HISTORY
159
160 September 8th, 1994; by Tim Bunce.
161
162 =cut
163
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
245 use Carp;
246 use Exporter;
247 @ISA=(Exporter);
248 @EXPORT=qw(timeit timethis timethese timediff timestr);
249 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
250
251 &init;
252
253 sub 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
266 sub clearcache    { delete $cache{$_[0]}; }
267 sub clearallcache { %cache = (); }
268 sub enablecache   { $cache = 1; }
269 sub disablecache  { $cache = 0; }
270
271
272 # --- Functions to process the 'time' data type
273
274 sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
275
276 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
277 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
278 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
279 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
280
281 sub 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
290 sub 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 }
309 sub 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
317 sub runloop {
318     my($n, $c) = @_;
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;
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
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;} }";
335     my $subref  = eval $subcode;
336     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
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
349 sub 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
376 sub 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
395 sub 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
413 1;