lib/dumpvar.pl, lib/perl5db.pl - fix warnings

[p5sagit/p5-mst-13.2.git] / lib / Benchmark.pm

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index 08caa48..b557be3 100644 (file)
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -2,17 +2,7 @@ package Benchmark;
 
 =head1 NAME
 
-Benchmark - benchmark running times of code
-
-timethis - run a chunk of code several times
-
-timethese - run several chunks of code several times
-
-cmpthese - print results of timethese as a comparison chart
-
-timeit - run a chunk of code and see how long it goes
-
-countit - see how many times a chunk of code runs in a given time
+Benchmark - benchmark running times of Perl code
 
 =head1 SYNOPSIS
 
@@ -63,6 +53,17 @@ countit - see how many times a chunk of code runs in a given time
 The Benchmark module encapsulates a number of routines to help you
 figure out how long it takes to execute some code.
 
+timethis - run a chunk of code several times
+
+timethese - run several chunks of code several times
+
+cmpthese - print results of timethese as a comparison chart
+
+timeit - run a chunk of code and see how long it goes
+
+countit - see how many times a chunk of code runs in a given time
+
+
 =head2 Methods
 
 =over 10
@@ -198,14 +199,14 @@ Clear all cached times.
 =item cmpthese ( RESULTSHASHREF )
 
 Optionally calls timethese(), then outputs comparison chart.  This 
-chart is sorted from slowest to highest, and shows the percent 
+chart is sorted from slowest to fastest, and shows the percent 
 speed difference between each pair of tests.  Can also be passed 
 the data structure that timethese() returns:
 
     $results = timethese( .... );
     cmpthese( $results );
 
-Returns the data structure returned by timethese().
+Returns the data structure returned by timethese() (or passed in).
 
 =item countit(TIME, CODE)
 
@@ -269,6 +270,35 @@ calls like these:
 Caching is off by default, as it can (usually slightly) decrease
 accuracy and does not usually noticably affect runtimes.
 
+=head1 EXAMPLES
+
+For example,
+
+   use Benchmark;$x=3;cmpthese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
+
+outputs something like this:
+
+   Benchmark: running a, b, each for at least 5 CPU seconds...
+           a: 10 wallclock secs ( 5.14 usr +  0.13 sys =  5.27 CPU) @ 3835055.60/s (n=20210743)
+           b:  5 wallclock secs ( 5.41 usr +  0.00 sys =  5.41 CPU) @ 1574944.92/s (n=8520452)
+         Rate    b    a
+   b 1574945/s   -- -59%
+   a 3835056/s 144%   --
+
+while 
+
+   use Benchmark;
+   $x=3;
+   $r=timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}},'none');
+   cmpthese($r);
+
+outputs something like this:
+
+          Rate    b    a
+   b 1559428/s   -- -62%
+   a 4152037/s 166%   --
+
+
 =head1 INHERITANCE
 
 Benchmark inherits from no other class, except of course
@@ -293,6 +323,10 @@ The system time of the null loop might be slightly
 more than the system time of the loop with the actual
 code and therefore the difference might end up being E<lt> 0.
 
+=head1 SEE ALSO
+
+L<Devel::DProf> - a Perl code profiler
+
 =head1 AUTHORS
 
 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
@@ -328,6 +362,8 @@ use Exporter;
 @EXPORT_OK=qw(timesum cmpthese countit
              clearcache clearallcache disablecache enablecache);
 
+$VERSION = 1.00;
+
 &init;
 
 sub init {
@@ -387,19 +423,19 @@ sub timestr {
     my @t = @$tr;
     warn "bad time value (@t)" unless @t==6;
     my($r, $pu, $ps, $cu, $cs, $n) = @t;
-    my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
+    my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
     $f = $defaultfmt unless defined $f;
     # format a time in the required style, other formats may be added here
     $style ||= $defaultstyle;
     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
     my $s = "@t $style"; # default for unknown style
     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
-                           @t,$t) if $style eq 'all';
+                           $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
     $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
                            $r,$pu,$ps,$pt) if $style eq 'noc';
     $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
                            $r,$cu,$cs,$ct) if $style eq 'nop';
-    $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
+    $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
     $s;
 }
 
@@ -444,9 +480,7 @@ sub runloop {
     # in &countit.  This, in turn, can reduce the number of calls to
     # &runloop a lot, and thus reduce additive errors.
     my $tbase = Benchmark->new(0)->[1];
-    do {
-       $t0 = Benchmark->new(0);
-    } while ( $t0->[1] == $tbase );
+    while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
     &$subref;
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
@@ -518,7 +552,9 @@ sub countit {
        # accuracy since we're not couting these times.
        $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
        my $td = timeit($n, $code);
-       $tc = $td->[1] + $td->[2];
+       my $new_tc = $td->[1] + $td->[2];
+        # Make sure we are making progress.
+        $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
     }
 
     # Now, do the 'for real' timing(s), repeating until we exceed
@@ -547,6 +583,7 @@ sub countit {
        $ttot = $utot + $stot;
        last if $ttot >= $tmax;
 
+        $ttot = 0.01 if $ttot < 0.01;
        my $r = $tmax / $ttot - 1; # Linear approximation.
        $n = int( $r * $ntot );
        $n = $nmin if $n < $nmin;
@@ -729,7 +766,7 @@ sub cmpthese{
        sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
     my $max_width = ${$sorted_width_refs[-1]};
 
-    my $total = 0;
+    my $total = @col_widths - 1 ;
     for ( @col_widths ) { $total += $_ }
 
     STRETCHER: