[win32] integrate mainline

p4raw-id: //depot/win32/perl@973

1 files changed, 141 insertions, 15 deletions

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index e09bc92958..fe77dd0a61 100644
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -82,6 +82,30 @@ Results will be printed to STDOUT as TITLE followed by the times.
 TITLE defaults to "timethis COUNT" if none is provided. STYLE
 determines the format of the output, as described for timestr() below.
 
+The COUNT can be zero or negative: this means the I<minimum number of
+CPU seconds> to run.  A zero signifies the default of 3 seconds.  For
+example to run at least for 10 seconds:
+
+	timethis(-10, $code)
+
+or to run two pieces of code tests for at least 3 seconds:
+
+	timethese(0, { test1 => '...', test2 => '...'})
+
+CPU seconds is, in UNIX terms, the user time plus the system time of
+the process itself, as opposed to the real (wallclock) time and the
+time spent by the child processes.  Less than 0.1 seconds is not
+accepted (-0.01 as the count, for example, will cause a fatal runtime
+exception).
+
+Note that the CPU seconds is the B<minimum> time: CPU scheduling and
+other operating system factors may complicate the attempt so that a
+little bit more time is spent.  The benchmark output will, however,
+also tell the number of C<$code> runs/second, which should be a more
+interesting number than the actually spent seconds.
+
+Returns a Benchmark object.
+
 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
 
 The CODEHASHREF is a reference to a hash containing names as keys
@@ -91,12 +115,14 @@ call
 
 	timethis(COUNT, VALUE, KEY, STYLE)
 
+The Count can be zero or negative, see timethis().
+
 =item timediff ( T1, T2 )
 
 Returns the difference between two Benchmark times as a Benchmark
 object suitable for passing to timestr().
 
-=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] )
+=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
 
 Returns a string that formats the times in the TIMEDIFF object in
 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
@@ -205,6 +231,9 @@ March 28th, 1997; by Hugo van der Sanden: added support for code
 references and the already documented 'debug' method; revamped
 documentation.
 
+April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
+functionality.
+
 =cut
 
 use Carp;
@@ -237,7 +266,9 @@ sub disablecache  { $cache = 0; }
 
 # --- Functions to process the 'time' data type
 
-sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; }
+sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
+	  print "new=@t\n" if $debug;
+	  bless \@t; }
 
 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
@@ -256,20 +287,21 @@ sub timediff {
 sub timestr {
     my($tr, $style, $f) = @_;
     my @t = @$tr;
-    warn "bad time value" unless @t==5;
-    my($r, $pu, $ps, $cu, $cs) = @t;
+    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);
     $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 secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
+    $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU secs)",
 			    @t,$t) if $style eq 'all';
-    $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
-			    $r,$pu,$ps,$pt) if $style eq 'noc';
-    $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
-			    $r,$cu,$cs,$ct) if $style eq 'nop';
+    $s=sprintf("%$f CPU secs (%$f usr + %$f sys)",
+			    $pt,$pu,$ps) if $style eq 'noc';
+    $s=sprintf("%$f CPU secs (%$f cusr %$f csys)",
+			    $ct,$cu,$cs) if $style eq 'nop';
+    $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
     $s;
 }
 
@@ -302,9 +334,9 @@ sub runloop {
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
     print STDERR "runloop $n '$subcode'\n" if $debug;
 
-    $t0 = &new;
+    $t0 = Benchmark->new(0);
     &$subref;
-    $t1 = &new;
+    $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
 
     timedebug("runloop:",$td);
@@ -336,16 +368,98 @@ sub timeit {
     $wd;
 }
 
+
+my $default_for = 3;
+my $min_for     = 0.1;
+
+sub runfor {
+    my ($code, $tmax) = @_;
+
+    if ( not defined $tmax or $tmax == 0 ) {
+	$tmax = $default_for;
+    } elsif ( $tmax < 0 ) {
+	$tmax = -$tmax;
+    }
+
+    die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
+	if $tmax < $min_for;
+
+    my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
+
+    # First find the minimum $n that gives a non-zero timing.
+    
+    my $nmin;
+
+    for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
+	$td = timeit($n, $code);
+	$tc = $td->[1] + $td->[2];
+    }
+
+    $nmin = $n;
+
+    my $ttot = 0;
+    my $tpra = 0.05 * $tmax; # Target/time practice.
+
+    # Double $n until we have think we have practiced enough.
+    for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
+	$td = timeit($n, $code);
+	$tc = $td->cpu_p;
+	$ntot += $n;
+	$rtot += $td->[0];
+	$utot += $td->[1];
+	$stot += $td->[2];
+	$ttot = $utot + $stot;
+	$cutot += $td->[3];
+	$cstot += $td->[4];
+    }
+
+    my $r;
+
+    # Then iterate towards the $tmax.
+    while ( $ttot < $tmax ) {
+	$r = $tmax / $ttot - 1; # Linear approximation.
+	$n = int( $r * $n );
+	$n = $nmin if $n < $nmin;
+	$td = timeit($n, $code);
+	$ntot += $n;
+	$rtot += $td->[0];
+	$utot += $td->[1];
+	$stot += $td->[2];
+	$ttot = $utot + $stot;
+	$cutot += $td->[3];
+	$cstot += $td->[4];
+    }
+
+    return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
+}
+
 # --- Functions implementing high-level time-then-print utilities
 
+sub n_to_for {
+    my $n = shift;
+    return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
+}
+
 sub timethis{
     my($n, $code, $title, $style) = @_;
-    my $t = timeit($n, $code);
+    my($t, $for, $forn);
+
+    if ( $n > 0 ) {
+	croak "non-integer loopcount $n, stopped" if int($n)<$n;
+	$t = timeit($n, $code);
+	$title = "timethis $n" unless defined $title;
+    } else {
+	$fort  = n_to_for( $n );
+	$t     = runfor($code, $fort);
+	$title = "timethis for $fort" unless defined $title;
+	$forn  = $t->[-1];
+    }
     local $| = 1;
-    $title = "timethis $n" unless defined $title;
     $style = "" unless defined $style;
     printf("%10s: ", $title);
-    print timestr($t, $style),"\n";
+    print timestr($t, $style, $defaultfmt),"\n";
+
+    $n = $forn if defined $forn;
 
     # A conservative warning to spot very silly tests.
     # Don't assume that your benchmark is ok simply because
@@ -363,7 +477,19 @@ sub timethese{
 		unless ref $alt eq HASH;
     my @names = sort keys %$alt;
     $style = "" unless defined $style;
-    print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
+    print "Benchmark: ";
+    if ( $n > 0 ) {
+	croak "non-integer loopcount $n, stopped" if int($n)<$n;
+	print "timing $n iterations of";
+    } else {
+	print "running";
+    }
+    print " ", join(', ',@names);
+    unless ( $n > 0 ) {
+	my $for = n_to_for( $n );
+	print ", each for at least $for CPU seconds";
+    }
+    print "...\n";
 
     # we could save the results in an array and produce a summary here
     # sum, min, max, avg etc etc