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