The ${"\cTAINT"} raises the ire of 'use strict'.

[perl5.git] / lib / Benchmark.pm

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index 83331aa..4d3b3e2 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
@@ -322,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>>
@@ -357,6 +362,8 @@ use Exporter;
 @EXPORT_OK=qw(timesum cmpthese countit
              clearcache clearallcache disablecache enablecache);
 
+$VERSION = 1.01;
+
 &init;
 
 sub init {
@@ -416,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;
 }
 
@@ -545,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
@@ -574,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;