sv_2pv_flags and ROK and UTF8 flags
[p5sagit/p5-mst-13.2.git] / lib / Benchmark.pm
index f4a8149..5ba9190 100644 (file)
@@ -2,16 +2,12 @@ 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
-
-timeit - run a chunk of code and see how long it goes
+Benchmark - benchmark running times of Perl code
 
 =head1 SYNOPSIS
 
+    use Benchmark qw(:all) ;
+
     timethis ($count, "code");
 
     # Use Perl code in strings...
@@ -26,14 +22,50 @@ timeit - run a chunk of code and see how long it goes
        'Name2' => sub { ...code2... },
     });
 
+    # cmpthese can be used both ways as well
+    cmpthese($count, {
+       'Name1' => '...code1...',
+       'Name2' => '...code2...',
+    });
+
+    cmpthese($count, {
+       'Name1' => sub { ...code1... },
+       'Name2' => sub { ...code2... },
+    });
+
+    # ...or in two stages
+    $results = timethese($count, 
+        {
+           'Name1' => sub { ...code1... },
+           'Name2' => sub { ...code2... },
+        },
+       'none'
+    );
+    cmpthese( $results ) ;
+
     $t = timeit($count, '...other code...')
     print "$count loops of other code took:",timestr($t),"\n";
 
+    $t = countit($time, '...other code...')
+    $count = $t->iters ;
+    print "$count loops of other code took:",timestr($t),"\n";
+
 =head1 DESCRIPTION
 
 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
@@ -57,6 +89,10 @@ Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
     $t = timeit(10, ' 5 ** $Global ');
     debug Benchmark 0;
 
+=item iters
+
+Returns the number of iterations.
+
 =back
 
 =head2 Standard Exports
@@ -126,11 +162,6 @@ Returns a hash of Benchmark objects, keyed by name.
 Returns the difference between two Benchmark times as a Benchmark
 object suitable for passing to timestr().
 
-=item timesum ( T1, T2 )
-
-Returns the sum of two Benchmark times as a Benchmark object suitable
-for passing to timestr().
-
 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
 
 Returns a string that formats the times in the TIMEDIFF object in
@@ -165,19 +196,64 @@ Clear the cached time for COUNT rounds of the null loop.
 
 Clear all cached times.
 
-=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
+=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
+
+=item cmpthese ( RESULTSHASHREF, [ STYLE ] )
+
+Optionally calls timethese(), then outputs comparison chart.  This:
+
+    cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
 
-=item cmpthese ( RESULTSHASHREF )
+outputs a chart like:
 
-Optionally calls timethese(), then outputs comparison chart.  This 
-chart is sorted from slowest to highest, and shows the percent 
-speed difference between each pair of tests.  Can also be passed 
-the data structure that timethese() returns:
+           Rate    b    a
+    b 2831802/s   -- -61%
+    a 7208959/s 155%   --
 
-    $results = timethese( .... );
+This chart is sorted from slowest to fastest, and shows the percent speed
+difference between each pair of tests.
+
+c<cmpthese> can also be passed the data structure that timethese() returns:
+
+    $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
     cmpthese( $results );
 
-Returns the data structure returned by timethese().
+in case you want to see both sets of results.
+
+Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
+above chart, including labels. This:
+
+    my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
+
+returns a data structure like:
+
+    [
+        [ '',       'Rate',   'b',    'a' ],
+        [ 'b', '2885232/s',  '--', '-59%' ],
+        [ 'a', '7099126/s', '146%',  '--' ],
+    ]
+
+B<NOTE>: This result value differs from previous versions, which returned
+the C<timethese()> result structure.  If you want that, just use the two
+statement C<timethese>...C<cmpthese> idiom shown above.
+
+Incidently, note the variance in the result values between the two examples;
+this is typical of benchmarking.  If this were a real benchmark, you would
+probably want to run a lot more iterations.
+
+=item countit(TIME, CODE)
+
+Arguments: TIME is the minimum length of time to run CODE for, and CODE is
+the code to run.  CODE may be either a code reference or a string to
+be eval'd; either way it will be run in the caller's package.
+
+TIME is I<not> negative.  countit() will run the loop many times to
+calculate the speed of CODE before running it for TIME.  The actual
+time run for will usually be greater than TIME due to system clock
+resolution, so it's best to look at the number of iterations divided
+by the times that you are concerned with, not just the iterations.
+
+Returns: a Benchmark object.
 
 =item disablecache ( )
 
@@ -190,6 +266,11 @@ Enable caching of timings for the null loop. The time taken for COUNT
 rounds of the null loop will be calculated only once for each
 different COUNT used.
 
+=item timesum ( T1, T2 )
+
+Returns the sum of two Benchmark times as a Benchmark object suitable
+for passing to timestr().
+
 =back
 
 =head1 NOTES
@@ -197,7 +278,7 @@ different COUNT used.
 The data is stored as a list of values from the time and times
 functions:
 
-      ($real, $user, $system, $children_user, $children_system)
+      ($real, $user, $system, $children_user, $children_system, $iters)
 
 in seconds for the whole loop (not divided by the number of rounds).
 
@@ -222,6 +303,45 @@ 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 qw( cmpthese ) ;
+    $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...
+          Rate    b    a
+   b 1559428/s   -- -62%
+   a 4152037/s 166%   --
+
+
+while 
+
+    use Benchmark qw( timethese cmpthese ) ;
+    $x = 3;
+    $r = timethese( -5, {
+        a => sub{$x*$x},
+        b => sub{$x**2},
+    } );
+    cmpthese $r;
+
+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%   --
+
+
 =head1 INHERITANCE
 
 Benchmark inherits from no other class, except of course
@@ -230,7 +350,7 @@ for Exporter.
 =head1 CAVEATS
 
 Comparing eval'd strings with code references will give you
-inaccurate results: a code reference will show a slower
+inaccurate results: a code reference will show a slightly slower
 execution time than the equivalent eval'd string.
 
 The real time timing is done using time(2) and
@@ -246,6 +366,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>>
@@ -263,7 +387,13 @@ functionality.
 
 September, 1999; by Barrie Slaymaker: math fixes and accuracy and 
 efficiency tweaks.  Added cmpthese().  A result is now returned from 
-timethese().
+timethese().  Exposed countit() (was runfor()).
+
+December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
+and return an empty string. If cmpthese is calling timethese, make it pass the
+style in. (so that 'none' will suppress output). Make sub new dump its
+debugging output to STDERR, to be consistent with everything else.
+All bugs found while writing a regression test.
 
 =cut
 
@@ -277,8 +407,12 @@ sub _doeval { eval shift }
 use Carp;
 use Exporter;
 @ISA=(Exporter);
-@EXPORT=qw(timeit timethis timethese timediff timesum timestr);
-@EXPORT_OK=qw(clearcache clearallcache cmpthese disablecache enablecache);
+@EXPORT=qw(timeit timethis timethese timediff timestr);
+@EXPORT_OK=qw(timesum cmpthese countit
+             clearcache clearallcache disablecache enablecache);
+%EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
+
+$VERSION = 1.05;
 
 &init;
 
@@ -307,13 +441,14 @@ sub disablecache  { $cache = 0; }
 # --- Functions to process the 'time' data type
 
 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
-         print "new=@t\n" if $debug;
+         print STDERR "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 ; }
 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
+sub iters { $_[0]->[5] ; }
 
 sub timediff {
     my($a, $b) = @_;
@@ -338,19 +473,20 @@ 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;
+    return '' if $style eq 'none';
     $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;
 }
 
@@ -392,12 +528,10 @@ sub runloop {
     # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This
     # may not seem important, but it significantly reduces the chances of
     # getting a too low initial $n in the initial, 'find the minimum' loop
-    # in &runfor.  This, in turn, can reduce the number of calls to
+    # 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);
@@ -415,7 +549,7 @@ sub timeit {
     if ($cache && exists $cache{$cache_key} ) {
        $wn = $cache{$cache_key};
     } else {
-       $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
+       $wn = &runloop($n, ref( $code ) ? sub { } : '' );
        # Can't let our baseline have any iterations, or they get subtracted
        # out of the result.
        $wn->[5] = 0;
@@ -437,8 +571,8 @@ my $default_for = 3;
 my $min_for     = 0.1;
 
 
-sub runfor {
-    my ($code, $tmax) = @_;
+sub countit {
+    my ( $tmax, $code ) = @_;
 
     if ( not defined $tmax or $tmax == 0 ) {
        $tmax = $default_for;
@@ -446,7 +580,7 @@ sub runfor {
        $tmax = -$tmax;
     }
 
-    die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
+    die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
        if $tmax < $min_for;
 
     my ($n, $tc);
@@ -469,7 +603,9 @@ sub runfor {
        # 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
@@ -498,6 +634,7 @@ sub runfor {
        $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;
@@ -523,7 +660,7 @@ sub timethis{
        $title = "timethis $n" unless defined $title;
     } else {
        $fort  = n_to_for( $n );
-       $t     = runfor($code, $fort);
+       $t     = countit( $fort, $code );
        $title = "timethis for $fort" unless defined $title;
        $forn  = $t->[-1];
     }
@@ -560,7 +697,8 @@ sub timethese{
     print " ", join(', ',@names) unless $style eq 'none';
     unless ( $n > 0 ) {
        my $for = n_to_for( $n );
-       print ", each for at least $for CPU seconds" unless $style eq 'none';
+       print ", each" if $n > 1 && $style ne 'none';
+       print " for at least $for CPU seconds" unless $style eq 'none';
     }
     print "...\n" unless $style eq 'none';
 
@@ -575,10 +713,11 @@ sub timethese{
 }
 
 sub cmpthese{
-    my $results = ref $_[0] ? $_[0] : timethese( @_ );
+    my ($results, $style) =
+         ref $_ [0] ? @_
+                    : (timethese (@_ [0, 1], @_ > 2 ? $_ [2] : "none"), $_ [2]);
 
-    return $results
-       if defined $_[2] && $_[2] eq 'none';
+    $style = "" unless defined $style;
 
     # Flatten in to an array of arrays with the name as the first field
     my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
@@ -674,13 +813,15 @@ sub cmpthese{
        push @rows, \@row;
     }
 
+    return \@rows if $style eq "none";
+
     # Equalize column widths in the chart as much as possible without
     # exceeding 80 characters.  This does not use or affect cols 0 or 1.
     my @sorted_width_refs = 
        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:
@@ -705,7 +846,7 @@ sub cmpthese{
        printf $format, @$_;
     }
 
-    return $results;
+    return \@rows ;
 }