Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package Benchmark; |
2 | ||
f06db76b AD |
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($dt),"\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 < 0. | |
150 | ||
151 | More documentation is needed :-( especially for styles and formats. | |
152 | ||
153 | =head1 AUTHORS | |
154 | ||
155 | Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>, | |
156 | Tim Bunce <Tim.Bunce@ig.co.uk> | |
157 | ||
158 | =head1 MODIFICATION HISTORY | |
159 | ||
160 | September 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 | 245 | use Carp; |
a0d0e21e LW |
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) = @_; | |
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 | ||
332 | my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; | |
333 | my $subref = eval $subcode; | |
4aa0a1f7 | 334 | croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; |
a0d0e21e LW |
335 | print STDERR "runloop $n '$subcode'\n" if ($debug); |
336 | ||
337 | $t0 = &new; | |
338 | &$subref; | |
339 | $t1 = &new; | |
340 | $td = &timediff($t1, $t0); | |
341 | ||
342 | timedebug("runloop:",$td); | |
343 | $td; | |
344 | } | |
345 | ||
346 | ||
347 | sub timeit { | |
348 | my($n, $code) = @_; | |
349 | my($wn, $wc, $wd); | |
350 | ||
351 | printf STDERR "timeit $n $code\n" if $debug; | |
352 | ||
353 | if ($cache && exists $cache{$n}){ | |
354 | $wn = $cache{$n}; | |
355 | }else{ | |
356 | $wn = &runloop($n, ''); | |
357 | $cache{$n} = $wn; | |
358 | } | |
359 | ||
360 | $wc = &runloop($n, $code); | |
361 | ||
362 | $wd = timediff($wc, $wn); | |
363 | ||
364 | timedebug("timeit: ",$wc); | |
365 | timedebug(" - ",$wn); | |
366 | timedebug(" = ",$wd); | |
367 | ||
368 | $wd; | |
369 | } | |
370 | ||
371 | ||
372 | # --- Functions implementing high-level time-then-print utilities | |
373 | ||
374 | sub timethis{ | |
375 | my($n, $code, $title, $style) = @_; | |
376 | my($t) = timeit($n, $code); | |
377 | local($|) = 1; | |
378 | $title = "timethis $n" unless $title; | |
379 | $style = "" unless $style; | |
380 | printf("%10s: ", $title); | |
381 | print timestr($t, $style),"\n"; | |
382 | # A conservative warning to spot very silly tests. | |
383 | # Don't assume that your benchmark is ok simply because | |
384 | # you don't get this warning! | |
385 | print " (warning: too few iterations for a reliable count)\n" | |
386 | if ( $n < $min_count | |
387 | || ($t->real < 1 && $n < 1000) | |
388 | || $t->cpu_a < $min_cpu); | |
389 | $t; | |
390 | } | |
391 | ||
392 | ||
393 | sub timethese{ | |
394 | my($n, $alt, $style) = @_; | |
395 | die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" | |
396 | unless ref $alt eq HASH; | |
397 | my(@all); | |
398 | my(@names) = sort keys %$alt; | |
399 | $style = "" unless $style; | |
400 | print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; | |
401 | foreach(@names){ | |
402 | $t = timethis($n, $alt->{$_}, $_, $style); | |
403 | push(@all, $t); | |
404 | } | |
405 | # we could produce a summary from @all here | |
406 | # sum, min, max, avg etc etc | |
407 | @all; | |
408 | } | |
409 | ||
410 | ||
411 | 1; |