This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Benchmark notes (from Barrie Slaymaker <barries@slaysys.com>)
[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
431d98c2
BS
11cmpthese - print results of timethese as a comparison chart
12
f06db76b
AD
13timeit - run a chunk of code and see how long it goes
14
431d98c2
BS
15countit - see how many times a chunk of code runs in a given time
16
f06db76b
AD
17=head1 SYNOPSIS
18
19 timethis ($count, "code");
20
523cc92b 21 # Use Perl code in strings...
f06db76b
AD
22 timethese($count, {
23 'Name1' => '...code1...',
24 'Name2' => '...code2...',
25 });
26
523cc92b
CS
27 # ... or use subroutine references.
28 timethese($count, {
29 'Name1' => sub { ...code1... },
30 'Name2' => sub { ...code2... },
31 });
32
431d98c2
BS
33 # cmpthese can be used both ways as well
34 cmpthese($count, {
35 'Name1' => '...code1...',
36 'Name2' => '...code2...',
37 });
38
39 cmpthese($count, {
40 'Name1' => sub { ...code1... },
41 'Name2' => sub { ...code2... },
42 });
43
44 # ...or in two stages
45 $results = timethese($count,
46 {
47 'Name1' => sub { ...code1... },
48 'Name2' => sub { ...code2... },
49 },
50 'none'
51 );
52 cmpthese( $results ) ;
53
f06db76b
AD
54 $t = timeit($count, '...other code...')
55 print "$count loops of other code took:",timestr($t),"\n";
56
431d98c2
BS
57 $t = countit($time, '...other code...')
58 $count = $t->iters ;
59 print "$count loops of other code took:",timestr($t),"\n";
60
f06db76b
AD
61=head1 DESCRIPTION
62
63The Benchmark module encapsulates a number of routines to help you
64figure out how long it takes to execute some code.
65
66=head2 Methods
67
68=over 10
69
70=item new
71
72Returns the current time. Example:
73
74 use Benchmark;
75 $t0 = new Benchmark;
76 # ... your code here ...
77 $t1 = new Benchmark;
78 $td = timediff($t1, $t0);
a24a9dfe 79 print "the code took:",timestr($td),"\n";
f06db76b
AD
80
81=item debug
82
83Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
84
523cc92b 85 debug Benchmark 1;
f06db76b 86 $t = timeit(10, ' 5 ** $Global ');
523cc92b 87 debug Benchmark 0;
f06db76b 88
431d98c2
BS
89=item iters
90
91Returns the number of iterations.
92
f06db76b
AD
93=back
94
95=head2 Standard Exports
96
523cc92b 97The following routines will be exported into your namespace
f06db76b
AD
98if you use the Benchmark module:
99
100=over 10
101
102=item timeit(COUNT, CODE)
103
523cc92b
CS
104Arguments: COUNT is the number of times to run the loop, and CODE is
105the code to run. CODE may be either a code reference or a string to
106be eval'd; either way it will be run in the caller's package.
107
108Returns: a Benchmark object.
109
110=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
111
112Time COUNT iterations of CODE. CODE may be a string to eval or a
113code reference; either way the CODE will run in the caller's package.
114Results will be printed to STDOUT as TITLE followed by the times.
115TITLE defaults to "timethis COUNT" if none is provided. STYLE
116determines the format of the output, as described for timestr() below.
117
6ee623d5
GS
118The COUNT can be zero or negative: this means the I<minimum number of
119CPU seconds> to run. A zero signifies the default of 3 seconds. For
120example to run at least for 10 seconds:
121
122 timethis(-10, $code)
123
124or to run two pieces of code tests for at least 3 seconds:
125
126 timethese(0, { test1 => '...', test2 => '...'})
127
128CPU seconds is, in UNIX terms, the user time plus the system time of
129the process itself, as opposed to the real (wallclock) time and the
130time spent by the child processes. Less than 0.1 seconds is not
131accepted (-0.01 as the count, for example, will cause a fatal runtime
132exception).
133
134Note that the CPU seconds is the B<minimum> time: CPU scheduling and
135other operating system factors may complicate the attempt so that a
136little bit more time is spent. The benchmark output will, however,
137also tell the number of C<$code> runs/second, which should be a more
138interesting number than the actually spent seconds.
139
140Returns a Benchmark object.
141
523cc92b 142=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
f06db76b 143
523cc92b
CS
144The CODEHASHREF is a reference to a hash containing names as keys
145and either a string to eval or a code reference for each value.
146For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
147call
f06db76b 148
523cc92b 149 timethis(COUNT, VALUE, KEY, STYLE)
f06db76b 150
1d2dff63
GS
151The routines are called in string comparison order of KEY.
152
153The COUNT can be zero or negative, see timethis().
6ee623d5 154
3c6312e9
BS
155Returns a hash of Benchmark objects, keyed by name.
156
523cc92b 157=item timediff ( T1, T2 )
f06db76b 158
523cc92b
CS
159Returns the difference between two Benchmark times as a Benchmark
160object suitable for passing to timestr().
f06db76b 161
6ee623d5 162=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
f06db76b 163
523cc92b
CS
164Returns a string that formats the times in the TIMEDIFF object in
165the requested STYLE. TIMEDIFF is expected to be a Benchmark object
166similar to that returned by timediff().
167
3c6312e9
BS
168STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
169each of the 5 times available ('wallclock' time, user time, system time,
523cc92b
CS
170user time of children, and system time of children). 'noc' shows all
171except the two children times. 'nop' shows only wallclock and the
172two children times. 'auto' (the default) will act as 'all' unless
173the children times are both zero, in which case it acts as 'noc'.
3c6312e9 174'none' prevents output.
523cc92b
CS
175
176FORMAT is the L<printf(3)>-style format specifier (without the
177leading '%') to use to print the times. It defaults to '5.2f'.
f06db76b
AD
178
179=back
180
181=head2 Optional Exports
182
183The following routines will be exported into your namespace
184if you specifically ask that they be imported:
185
186=over 10
187
523cc92b
CS
188=item clearcache ( COUNT )
189
190Clear the cached time for COUNT rounds of the null loop.
191
192=item clearallcache ( )
f06db76b 193
523cc92b 194Clear all cached times.
f06db76b 195
ac8eabc1
JH
196=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
197
198=item cmpthese ( RESULTSHASHREF )
199
200Optionally calls timethese(), then outputs comparison chart. This
277427cf 201chart is sorted from slowest to fastest, and shows the percent
ac8eabc1
JH
202speed difference between each pair of tests. Can also be passed
203the data structure that timethese() returns:
204
205 $results = timethese( .... );
206 cmpthese( $results );
207
277427cf 208Returns the data structure returned by timethese() (or passed in).
ac8eabc1
JH
209
210=item countit(TIME, CODE)
211
212Arguments: TIME is the minimum length of time to run CODE for, and CODE is
213the code to run. CODE may be either a code reference or a string to
214be eval'd; either way it will be run in the caller's package.
215
216TIME is I<not> negative. countit() will run the loop many times to
217calculate the speed of CODE before running it for TIME. The actual
218time run for will usually be greater than TIME due to system clock
219resolution, so it's best to look at the number of iterations divided
220by the times that you are concerned with, not just the iterations.
221
222Returns: a Benchmark object.
223
523cc92b 224=item disablecache ( )
f06db76b 225
523cc92b
CS
226Disable caching of timings for the null loop. This will force Benchmark
227to recalculate these timings for each new piece of code timed.
228
229=item enablecache ( )
230
231Enable caching of timings for the null loop. The time taken for COUNT
232rounds of the null loop will be calculated only once for each
233different COUNT used.
f06db76b 234
ac8eabc1
JH
235=item timesum ( T1, T2 )
236
237Returns the sum of two Benchmark times as a Benchmark object suitable
238for passing to timestr().
239
f06db76b
AD
240=back
241
242=head1 NOTES
243
244The data is stored as a list of values from the time and times
523cc92b 245functions:
f06db76b 246
431d98c2 247 ($real, $user, $system, $children_user, $children_system, $iters)
f06db76b
AD
248
249in seconds for the whole loop (not divided by the number of rounds).
250
251The timing is done using time(3) and times(3).
252
253Code is executed in the caller's package.
254
f06db76b
AD
255The time of the null loop (a loop with the same
256number of rounds but empty loop body) is subtracted
257from the time of the real loop.
258
3c6312e9 259The null loop times can be cached, the key being the
f06db76b
AD
260number of rounds. The caching can be controlled using
261calls like these:
262
523cc92b 263 clearcache($key);
f06db76b
AD
264 clearallcache();
265
523cc92b 266 disablecache();
f06db76b
AD
267 enablecache();
268
3c6312e9
BS
269Caching is off by default, as it can (usually slightly) decrease
270accuracy and does not usually noticably affect runtimes.
271
54e82ce5
GS
272=head1 EXAMPLES
273
274For example,
275
276 use Benchmark;$x=3;cmpthese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
277
278outputs something like this:
279
280 Benchmark: running a, b, each for at least 5 CPU seconds...
281 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
282 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
283 Rate b a
284 b 1574945/s -- -59%
285 a 3835056/s 144% --
286
287while
288
289 use Benchmark;
290 $x=3;
291 $r=timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}},'none');
292 cmpthese($r);
293
294outputs something like this:
295
296 Rate b a
297 b 1559428/s -- -62%
298 a 4152037/s 166% --
299
300
f06db76b
AD
301=head1 INHERITANCE
302
303Benchmark inherits from no other class, except of course
304for Exporter.
305
306=head1 CAVEATS
307
80eab818 308Comparing eval'd strings with code references will give you
431d98c2 309inaccurate results: a code reference will show a slightly slower
80eab818
CS
310execution time than the equivalent eval'd string.
311
f06db76b
AD
312The real time timing is done using time(2) and
313the granularity is therefore only one second.
314
315Short tests may produce negative figures because perl
523cc92b
CS
316can appear to take longer to execute the empty loop
317than a short test; try:
f06db76b
AD
318
319 timethis(100,'1');
320
321The system time of the null loop might be slightly
322more than the system time of the loop with the actual
a24a9dfe 323code and therefore the difference might end up being E<lt> 0.
f06db76b 324
f06db76b
AD
325=head1 AUTHORS
326
5aabfad6 327Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
f06db76b
AD
328
329=head1 MODIFICATION HISTORY
330
331September 8th, 1994; by Tim Bunce.
332
523cc92b
CS
333March 28th, 1997; by Hugo van der Sanden: added support for code
334references and the already documented 'debug' method; revamped
335documentation.
f06db76b 336
6ee623d5
GS
337April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
338functionality.
339
3c6312e9
BS
340September, 1999; by Barrie Slaymaker: math fixes and accuracy and
341efficiency tweaks. Added cmpthese(). A result is now returned from
431d98c2 342timethese(). Exposed countit() (was runfor()).
3c6312e9 343
523cc92b 344=cut
a0d0e21e 345
3f943bd9
GS
346# evaluate something in a clean lexical environment
347sub _doeval { eval shift }
348
349#
350# put any lexicals at file scope AFTER here
351#
352
4aa0a1f7 353use Carp;
a0d0e21e
LW
354use Exporter;
355@ISA=(Exporter);
ac8eabc1
JH
356@EXPORT=qw(timeit timethis timethese timediff timestr);
357@EXPORT_OK=qw(timesum cmpthese countit
358 clearcache clearallcache disablecache enablecache);
a0d0e21e
LW
359
360&init;
361
362sub init {
363 $debug = 0;
364 $min_count = 4;
365 $min_cpu = 0.4;
366 $defaultfmt = '5.2f';
367 $defaultstyle = 'auto';
368 # The cache can cause a slight loss of sys time accuracy. If a
369 # user does many tests (>10) with *very* large counts (>10000)
370 # or works on a very slow machine the cache may be useful.
371 &disablecache;
372 &clearallcache;
373}
374
523cc92b
CS
375sub debug { $debug = ($_[1] != 0); }
376
bba8fca5
BS
377# The cache needs two branches: 's' for strings and 'c' for code. The
378# emtpy loop is different in these two cases.
379sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
a0d0e21e
LW
380sub clearallcache { %cache = (); }
381sub enablecache { $cache = 1; }
382sub disablecache { $cache = 0; }
383
a0d0e21e
LW
384# --- Functions to process the 'time' data type
385
6ee623d5
GS
386sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
387 print "new=@t\n" if $debug;
388 bless \@t; }
a0d0e21e
LW
389
390sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
391sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
392sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
393sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
431d98c2 394sub iters { $_[0]->[5] ; }
a0d0e21e 395
523cc92b 396sub timediff {
a0d0e21e 397 my($a, $b) = @_;
523cc92b 398 my @r;
3f943bd9 399 for (my $i=0; $i < @$a; ++$i) {
a0d0e21e
LW
400 push(@r, $a->[$i] - $b->[$i]);
401 }
402 bless \@r;
403}
404
705cc255
TB
405sub timesum {
406 my($a, $b) = @_;
407 my @r;
408 for (my $i=0; $i < @$a; ++$i) {
409 push(@r, $a->[$i] + $b->[$i]);
410 }
411 bless \@r;
412}
413
523cc92b 414sub timestr {
a0d0e21e 415 my($tr, $style, $f) = @_;
523cc92b 416 my @t = @$tr;
6ee623d5
GS
417 warn "bad time value (@t)" unless @t==6;
418 my($r, $pu, $ps, $cu, $cs, $n) = @t;
a0d0e21e 419 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
523cc92b 420 $f = $defaultfmt unless defined $f;
a0d0e21e 421 # format a time in the required style, other formats may be added here
80eab818 422 $style ||= $defaultstyle;
523cc92b
CS
423 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
424 my $s = "@t $style"; # default for unknown style
7be077a2 425 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
523cc92b 426 @t,$t) if $style eq 'all';
7be077a2
GS
427 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
428 $r,$pu,$ps,$pt) if $style eq 'noc';
429 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
430 $r,$cu,$cs,$ct) if $style eq 'nop';
6ee623d5 431 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
a0d0e21e
LW
432 $s;
433}
523cc92b
CS
434
435sub timedebug {
a0d0e21e 436 my($msg, $t) = @_;
523cc92b 437 print STDERR "$msg",timestr($t),"\n" if $debug;
a0d0e21e
LW
438}
439
a0d0e21e
LW
440# --- Functions implementing low-level support for timing loops
441
442sub runloop {
443 my($n, $c) = @_;
4aa0a1f7
AD
444
445 $n+=0; # force numeric now, so garbage won't creep into the eval
523cc92b
CS
446 croak "negative loopcount $n" if $n<0;
447 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
a0d0e21e
LW
448 my($t0, $t1, $td); # before, after, difference
449
450 # find package of caller so we can execute code there
523cc92b
CS
451 my($curpack) = caller(0);
452 my($i, $pack)= 0;
a0d0e21e
LW
453 while (($pack) = caller(++$i)) {
454 last if $pack ne $curpack;
455 }
456
3f943bd9
GS
457 my ($subcode, $subref);
458 if (ref $c eq 'CODE') {
459 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
460 $subref = eval $subcode;
461 }
462 else {
463 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
464 $subref = _doeval($subcode);
465 }
4aa0a1f7 466 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
523cc92b 467 print STDERR "runloop $n '$subcode'\n" if $debug;
a0d0e21e 468
3c6312e9
BS
469 # Wait for the user timer to tick. This makes the error range more like
470 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
471 # may not seem important, but it significantly reduces the chances of
472 # getting a too low initial $n in the initial, 'find the minimum' loop
431d98c2 473 # in &countit. This, in turn, can reduce the number of calls to
bba8fca5
BS
474 # &runloop a lot, and thus reduce additive errors.
475 my $tbase = Benchmark->new(0)->[1];
277427cf 476 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
a0d0e21e 477 &$subref;
6ee623d5 478 $t1 = Benchmark->new($n);
a0d0e21e 479 $td = &timediff($t1, $t0);
a0d0e21e
LW
480 timedebug("runloop:",$td);
481 $td;
482}
483
484
485sub timeit {
486 my($n, $code) = @_;
487 my($wn, $wc, $wd);
488
489 printf STDERR "timeit $n $code\n" if $debug;
3c6312e9 490 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
bba8fca5
BS
491 if ($cache && exists $cache{$cache_key} ) {
492 $wn = $cache{$cache_key};
523cc92b 493 } else {
bba8fca5 494 $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
3c6312e9
BS
495 # Can't let our baseline have any iterations, or they get subtracted
496 # out of the result.
497 $wn->[5] = 0;
bba8fca5 498 $cache{$cache_key} = $wn;
a0d0e21e
LW
499 }
500
501 $wc = &runloop($n, $code);
502
503 $wd = timediff($wc, $wn);
a0d0e21e
LW
504 timedebug("timeit: ",$wc);
505 timedebug(" - ",$wn);
506 timedebug(" = ",$wd);
507
508 $wd;
509}
510
6ee623d5
GS
511
512my $default_for = 3;
513my $min_for = 0.1;
514
3c6312e9 515
431d98c2
BS
516sub countit {
517 my ( $tmax, $code ) = @_;
6ee623d5
GS
518
519 if ( not defined $tmax or $tmax == 0 ) {
520 $tmax = $default_for;
521 } elsif ( $tmax < 0 ) {
522 $tmax = -$tmax;
523 }
524
431d98c2 525 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
6ee623d5
GS
526 if $tmax < $min_for;
527
3c6312e9 528 my ($n, $tc);
6ee623d5 529
bba8fca5 530 # First find the minimum $n that gives a significant timing.
3c6312e9
BS
531 for ($n = 1; ; $n *= 2 ) {
532 my $td = timeit($n, $code);
533 $tc = $td->[1] + $td->[2];
534 last if $tc > 0.1;
535 }
6ee623d5 536
3c6312e9
BS
537 my $nmin = $n;
538
539 # Get $n high enough that we can guess the final $n with some accuracy.
540 my $tpra = 0.1 * $tmax; # Target/time practice.
541 while ( $tc < $tpra ) {
542 # The 5% fudge is to keep us from iterating again all
543 # that often (this speeds overall responsiveness when $tmax is big
544 # and we guess a little low). This does not noticably affect
545 # accuracy since we're not couting these times.
546 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
547 my $td = timeit($n, $code);
6ee623d5
GS
548 $tc = $td->[1] + $td->[2];
549 }
550
3c6312e9
BS
551 # Now, do the 'for real' timing(s), repeating until we exceed
552 # the max.
553 my $ntot = 0;
554 my $rtot = 0;
555 my $utot = 0.0;
556 my $stot = 0.0;
557 my $cutot = 0.0;
558 my $cstot = 0.0;
559 my $ttot = 0.0;
560
561 # The 5% fudge is because $n is often a few % low even for routines
562 # with stable times and avoiding extra timeit()s is nice for
563 # accuracy's sake.
564 $n = int( $n * ( 1.05 * $tmax / $tc ) );
565
566 while () {
567 my $td = timeit($n, $code);
568 $ntot += $n;
569 $rtot += $td->[0];
570 $utot += $td->[1];
571 $stot += $td->[2];
6ee623d5
GS
572 $cutot += $td->[3];
573 $cstot += $td->[4];
3c6312e9
BS
574 $ttot = $utot + $stot;
575 last if $ttot >= $tmax;
6ee623d5 576
3c6312e9 577 my $r = $tmax / $ttot - 1; # Linear approximation.
bba8fca5 578 $n = int( $r * $ntot );
6ee623d5 579 $n = $nmin if $n < $nmin;
6ee623d5
GS
580 }
581
582 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
583}
584
a0d0e21e
LW
585# --- Functions implementing high-level time-then-print utilities
586
6ee623d5
GS
587sub n_to_for {
588 my $n = shift;
589 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
590}
591
a0d0e21e
LW
592sub timethis{
593 my($n, $code, $title, $style) = @_;
6ee623d5
GS
594 my($t, $for, $forn);
595
596 if ( $n > 0 ) {
597 croak "non-integer loopcount $n, stopped" if int($n)<$n;
598 $t = timeit($n, $code);
599 $title = "timethis $n" unless defined $title;
600 } else {
601 $fort = n_to_for( $n );
431d98c2 602 $t = countit( $fort, $code );
6ee623d5
GS
603 $title = "timethis for $fort" unless defined $title;
604 $forn = $t->[-1];
605 }
523cc92b 606 local $| = 1;
523cc92b 607 $style = "" unless defined $style;
3c6312e9
BS
608 printf("%10s: ", $title) unless $style eq 'none';
609 print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
6ee623d5
GS
610
611 $n = $forn if defined $forn;
523cc92b 612
a0d0e21e
LW
613 # A conservative warning to spot very silly tests.
614 # Don't assume that your benchmark is ok simply because
615 # you don't get this warning!
616 print " (warning: too few iterations for a reliable count)\n"
523cc92b 617 if $n < $min_count
a0d0e21e 618 || ($t->real < 1 && $n < 1000)
523cc92b 619 || $t->cpu_a < $min_cpu;
a0d0e21e
LW
620 $t;
621}
622
a0d0e21e
LW
623sub timethese{
624 my($n, $alt, $style) = @_;
625 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
626 unless ref $alt eq HASH;
523cc92b
CS
627 my @names = sort keys %$alt;
628 $style = "" unless defined $style;
3c6312e9 629 print "Benchmark: " unless $style eq 'none';
6ee623d5
GS
630 if ( $n > 0 ) {
631 croak "non-integer loopcount $n, stopped" if int($n)<$n;
3c6312e9 632 print "timing $n iterations of" unless $style eq 'none';
6ee623d5 633 } else {
3c6312e9 634 print "running" unless $style eq 'none';
6ee623d5 635 }
3c6312e9 636 print " ", join(', ',@names) unless $style eq 'none';
6ee623d5
GS
637 unless ( $n > 0 ) {
638 my $for = n_to_for( $n );
3c6312e9 639 print ", each for at least $for CPU seconds" unless $style eq 'none';
6ee623d5 640 }
3c6312e9 641 print "...\n" unless $style eq 'none';
523cc92b
CS
642
643 # we could save the results in an array and produce a summary here
a0d0e21e 644 # sum, min, max, avg etc etc
3c6312e9 645 my %results;
4dbb2df9 646 foreach my $name (@names) {
3c6312e9 647 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
4dbb2df9 648 }
3c6312e9
BS
649
650 return \%results;
a0d0e21e
LW
651}
652
3c6312e9
BS
653sub cmpthese{
654 my $results = ref $_[0] ? $_[0] : timethese( @_ );
655
656 return $results
657 if defined $_[2] && $_[2] eq 'none';
658
659 # Flatten in to an array of arrays with the name as the first field
660 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
661
662 for (@vals) {
663 # The epsilon fudge here is to prevent div by 0. Since clock
664 # resolutions are much larger, it's below the noise floor.
665 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
666 $_->[7] = $rate;
667 }
668
669 # Sort by rate
670 @vals = sort { $a->[7] <=> $b->[7] } @vals;
671
672 # If more than half of the rates are greater than one...
673 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
674
675 my @rows;
676 my @col_widths;
677
678 my @top_row = (
679 '',
680 $display_as_rate ? 'Rate' : 's/iter',
681 map { $_->[0] } @vals
682 );
683
684 push @rows, \@top_row;
685 @col_widths = map { length( $_ ) } @top_row;
686
687 # Build the data rows
688 # We leave the last column in even though it never has any data. Perhaps
689 # it should go away. Also, perhaps a style for a single column of
690 # percentages might be nice.
691 for my $row_val ( @vals ) {
692 my @row;
693
694 # Column 0 = test name
695 push @row, $row_val->[0];
696 $col_widths[0] = length( $row_val->[0] )
697 if length( $row_val->[0] ) > $col_widths[0];
698
699 # Column 1 = performance
700 my $row_rate = $row_val->[7];
701
702 # We assume that we'll never get a 0 rate.
703 my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
704
705 # Only give a few decimal places before switching to sci. notation,
706 # since the results aren't usually that accurate anyway.
707 my $format =
708 $a >= 100 ?
709 "%0.0f" :
710 $a >= 10 ?
711 "%0.1f" :
712 $a >= 1 ?
713 "%0.2f" :
714 $a >= 0.1 ?
715 "%0.3f" :
716 "%0.2e";
717
718 $format .= "/s"
719 if $display_as_rate;
720 # Using $b here due to optimizing bug in _58 through _61
721 my $b = sprintf( $format, $a );
722 push @row, $b;
723 $col_widths[1] = length( $b )
724 if length( $b ) > $col_widths[1];
725
726 # Columns 2..N = performance ratios
727 my $skip_rest = 0;
728 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
729 my $col_val = $vals[$col_num];
730 my $out;
731 if ( $skip_rest ) {
732 $out = '';
733 }
734 elsif ( $col_val->[0] eq $row_val->[0] ) {
735 $out = "--";
736 # $skip_rest = 1;
737 }
738 else {
739 my $col_rate = $col_val->[7];
740 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
741 }
742 push @row, $out;
743 $col_widths[$col_num+2] = length( $out )
744 if length( $out ) > $col_widths[$col_num+2];
745
746 # A little wierdness to set the first column width properly
747 $col_widths[$col_num+2] = length( $col_val->[0] )
748 if length( $col_val->[0] ) > $col_widths[$col_num+2];
749 }
750 push @rows, \@row;
751 }
752
753 # Equalize column widths in the chart as much as possible without
754 # exceeding 80 characters. This does not use or affect cols 0 or 1.
755 my @sorted_width_refs =
756 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
757 my $max_width = ${$sorted_width_refs[-1]};
758
277427cf 759 my $total = @col_widths - 1 ;
3c6312e9
BS
760 for ( @col_widths ) { $total += $_ }
761
762 STRETCHER:
763 while ( $total < 80 ) {
764 my $min_width = ${$sorted_width_refs[0]};
765 last
766 if $min_width == $max_width;
767 for ( @sorted_width_refs ) {
768 last
769 if $$_ > $min_width;
770 ++$$_;
771 ++$total;
772 last STRETCHER
773 if $total >= 80;
774 }
775 }
776
777 # Dump the output
778 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
779 substr( $format, 1, 0 ) = '-';
780 for ( @rows ) {
781 printf $format, @$_;
782 }
783
784 return $results;
785}
786
787
a0d0e21e 7881;