v5.8.8: File::Temp.pm (_gettemp): ignore dir -w test on Cygwin

[perl5.git] / lib / Benchmark.pm

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index c472d58..390aa31 100644 (file)
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -161,7 +161,7 @@ The routines are called in string comparison order of KEY.
 
 The COUNT can be zero or negative, see timethis().
 
-Returns a hash of Benchmark objects, keyed by name.
+Returns a hash reference of Benchmark objects, keyed by name.
 
 =item timediff ( T1, T2 )
 
@@ -225,6 +225,8 @@ c<cmpthese> can also be passed the data structure that timethese() returns:
     cmpthese( $results );
 
 in case you want to see both sets of results.
+If the first argument is an unblessed hash reference,
+that is RESULTSHASHREF; otherwise that is COUNT.
 
 Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
 above chart, including labels. This:
@@ -412,6 +414,12 @@ All bugs found while writing a regression test.
 
 September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
 
+February, 2004; by Chia-liang Kao: make cmpthese and timestr use time
+statistics for children instead of parent when the style is 'nop'.
+
+November, 2007; by Christophe Grosjean: make cmpthese and timestr compute
+time consistently with style argument, default is 'all' not 'noc' any more.
+
 =cut
 
 # evaluate something in a clean lexical environment
@@ -432,7 +440,7 @@ our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
              clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 
-$VERSION = 1.051;
+$VERSION = 1.10;
 
 # --- ':hireswallclock' special handling
 
@@ -453,6 +461,7 @@ sub import {
     my $class = shift;
     if (grep { $_ eq ":hireswallclock" } @_) {
        @_ = grep { $_ ne ":hireswallclock" } @_;
+       local $^W=0;
        *mytime = $hirestime if defined $hirestime;
     }
     Benchmark->export_to_level(1, $class, @_);
@@ -548,6 +557,8 @@ sub timediff {
     for (my $i=0; $i < @$a; ++$i) {
        push(@r, $a->[$i] - $b->[$i]);
     }
+    #die "Bad timediff(): ($r[1] + $r[2]) <= 0 (@$a[1,2]|@$b[1,2])\n"
+    #        if ($r[1] + $r[2]) < 0;
     bless \@r;
 }
 
@@ -588,13 +599,18 @@ sub timestr {
     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
     my $s = "@t $style"; # default for unknown style
     my $w = $hirestime ? "%2g" : "%2d";
-    $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
+    $s = sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
                            $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
-    $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
+    $s = sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
                            $r,$pu,$ps,$pt) if $style eq 'noc';
-    $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
+    $s = sprintf("$w 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 && $pu+$ps;
+    my $elapsed = do {
+       if ($style eq 'nop') {$cu+$cs}
+       elsif ($style eq 'noc') {$pu+$ps}
+       else {$cu+$cs+$pu+$ps}
+    };
+    $s .= sprintf(" @ %$f/s (n=$n)",$n/($elapsed)) if $n && $elapsed;
     $s;
 }
 
@@ -644,7 +660,7 @@ sub runloop {
     # &runloop a lot, and thus reduce additive errors.
     my $tbase = Benchmark->new(0)->[1];
     while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
-    &$subref;
+    $subref->();
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
     timedebug("runloop:",$td);
@@ -712,9 +728,16 @@ sub countit {
     my ($n, $tc);
 
     # First find the minimum $n that gives a significant timing.
+    my $zeros=0;
     for ($n = 1; ; $n *= 2 ) {
        my $td = timeit($n, $code);
        $tc = $td->[1] + $td->[2];
+       if ( $tc <= 0 and $n > 1024 ) {
+           ++$zeros > 16
+               and die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
+       } else {
+           $zeros = 0;
+       }
        last if $tc > 0.1;
     }
 
@@ -748,7 +771,7 @@ sub countit {
     # with stable times and avoiding extra timeit()s is nice for
     # accuracy's sake.
     $n = int( $n * ( 1.05 * $tmax / $tc ) );
-
+    $zeros=0;
     while () {
        my $td = timeit($n, $code);
        $ntot  += $n;
@@ -759,7 +782,12 @@ sub countit {
        $cstot += $td->[4];
        $ttot = $utot + $stot;
        last if $ttot >= $tmax;
-
+       if ( $ttot <= 0 ) {
+           ++$zeros > 16
+               and die "Timing is consistently zero, cannot benchmark. N=$n\n";
+       } else {
+           $zeros = 0;
+       }
         $ttot = 0.01 if $ttot < 0.01;
        my $r = $tmax / $ttot - 1; # Linear approximation.
        $n = int( $r * $ntot );
@@ -862,7 +890,8 @@ USAGE
 sub cmpthese{
     my ($results, $style);
 
-    if( ref $_[0] ) {
+    # $count can be a blessed object.
+    if ( ref $_[0] eq 'HASH' ) {
         ($results, $style) = @_;
     }
     else {
@@ -882,7 +911,12 @@ sub cmpthese{
     for (@vals) {
        # The epsilon fudge here is to prevent div by 0.  Since clock
        # resolutions are much larger, it's below the noise floor.
-       my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
+       my $elapsed = do {
+           if ($style eq 'nop') {$_->[4]+$_->[5]}
+           elsif ($style eq 'noc') {$_->[2]+$_->[3]}
+           else {$_->[2]+$_->[3]+$_->[4]+$_->[5]}
+       };
+       my $rate = $_->[6]/(($elapsed)+0.000000000000001);
        $_->[7] = $rate;
     }
 
@@ -890,7 +924,7 @@ sub cmpthese{
     @vals = sort { $a->[7] <=> $b->[7] } @vals;
 
     # If more than half of the rates are greater than one...
-    my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
+    my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;
 
     my @rows;
     my @col_widths;