[perl #61520] Segfault in debugger with tr// and UTF8

[perl5.git] / lib / Benchmark.pm

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index cda764f..269674c 100644 (file)
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -1,5 +1,8 @@
 package Benchmark;
 
 package Benchmark;
 

+use strict;
+
+

 =head1 NAME
 
 Benchmark - benchmark running times of Perl code
 =head1 NAME
 
 Benchmark - benchmark running times of Perl code


@@ -50,6 +53,9 @@ Benchmark - benchmark running times of Perl code
     $count = $t->iters ;
     print "$count loops of other code took:",timestr($t),"\n";
 
     $count = $t->iters ;
     print "$count loops of other code took:",timestr($t),"\n";
 

+    # enable hires wallclock timing if possible
+    use Benchmark ':hireswallclock';
+

 =head1 DESCRIPTION
 
 The Benchmark module encapsulates a number of routines to help you
 =head1 DESCRIPTION
 
 The Benchmark module encapsulates a number of routines to help you


@@ -75,9 +81,9 @@ countit - see how many times a chunk of code runs in a given time
 Returns the current time.   Example:
 
     use Benchmark;
 Returns the current time.   Example:
 
     use Benchmark;

-    $t0 = new Benchmark;
+    $t0 = Benchmark->new;

     # ... your code here ...
     # ... your code here ...

-    $t1 = new Benchmark;
+    $t1 = Benchmark->new;

     $td = timediff($t1, $t0);
     print "the code took:",timestr($td),"\n";
 
     $td = timediff($t1, $t0);
     print "the code took:",timestr($td),"\n";
 


@@ -85,9 +91,9 @@ Returns the current time.   Example:
 
 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
 
 
 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
 

-    debug Benchmark 1;
+    Benchmark->debug(1);

     $t = timeit(10, ' 5 ** $Global ');
     $t = timeit(10, ' 5 ** $Global ');

-    debug Benchmark 0;
+    Benchmark->debug(0);

 
 =item iters
 
 
 =item iters
 


@@ -155,7 +161,7 @@ The routines are called in string comparison order of KEY.
 
 The COUNT can be zero or negative, see timethis().
 
 
 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 )
 
 
 =item timediff ( T1, T2 )
 


@@ -196,7 +202,7 @@ Clear the cached time for COUNT rounds of the null loop.
 
 Clear all cached times.
 
 
 Clear all cached times.
 

-=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
+=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )

 
 =item cmpthese ( RESULTSHASHREF, [ STYLE ] )
 
 
 =item cmpthese ( RESULTSHASHREF, [ STYLE ] )
 


@@ -213,12 +219,14 @@ outputs a chart like:
 This chart is sorted from slowest to fastest, and shows the percent speed
 difference between each pair of tests.
 
 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:
+C<cmpthese> can also be passed the data structure that timethese() returns:

 
     $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
     cmpthese( $results );
 
 in case you want to see both sets of results.
 
     $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
     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:
 
 Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
 above chart, including labels. This:


@@ -273,6 +281,15 @@ for passing to timestr().
 
 =back
 
 
 =back
 

+=head2 :hireswallclock
+
+If the Time::HiRes module has been installed, you can specify the
+special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not
+available, the tag will be silently ignored).  This tag will cause the
+wallclock time to be measured in microseconds, instead of integer
+seconds.  Note though that the speed computations are still conducted
+in CPU time, not wallclock time.
+

 =head1 NOTES
 
 The data is stored as a list of values from the time and times
 =head1 NOTES
 
 The data is stored as a list of values from the time and times


@@ -395,10 +412,18 @@ 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.
 
 debugging output to STDERR, to be consistent with everything else.
 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
 =cut
 
 # evaluate something in a clean lexical environment

-sub _doeval { eval shift }
+sub _doeval { no strict;  eval shift }

 
 #
 # put any lexicals at file scope AFTER here
 
 #
 # put any lexicals at file scope AFTER here


@@ -406,42 +431,110 @@ sub _doeval { eval shift }
 
 use Carp;
 use Exporter;
 
 use Carp;
 use Exporter;

-@ISA=(Exporter);
+
+our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
+
+@ISA=qw(Exporter);

 @EXPORT=qw(timeit timethis timethese timediff timestr);
 @EXPORT_OK=qw(timesum cmpthese countit
              clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 
 @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.04;
+$VERSION = 1.11;
+
+# --- ':hireswallclock' special handling
+
+my $hirestime;
+
+sub mytime () { time }
+
+init();
+
+sub BEGIN {
+    if (eval 'require Time::HiRes') {
+       import Time::HiRes qw(time);
+       $hirestime = \&Time::HiRes::time;
+    }
+}
+
+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, @_);
+}

 
 

-&init;
+our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style,
+    %_Usage, %Cache, $Do_Cache);

 
 sub init {
 
 sub init {

-    $debug = 0;
-    $min_count = 4;
-    $min_cpu   = 0.4;
-    $defaultfmt = '5.2f';
-    $defaultstyle = 'auto';
+    $Debug = 0;
+    $Min_Count = 4;
+    $Min_CPU   = 0.4;
+    $Default_Format = '5.2f';
+    $Default_Style = 'auto';

     # The cache can cause a slight loss of sys time accuracy. If a
     # user does many tests (>10) with *very* large counts (>10000)
     # or works on a very slow machine the cache may be useful.
     # The cache can cause a slight loss of sys time accuracy. If a
     # user does many tests (>10) with *very* large counts (>10000)
     # or works on a very slow machine the cache may be useful.

-    &disablecache;
-    &clearallcache;
+    disablecache();
+    clearallcache();

 }
 
 }
 

-sub debug { $debug = ($_[1] != 0); }
+sub debug { $Debug = ($_[1] != 0); }
+
+sub usage { 
+    my $calling_sub = (caller(1))[3];
+    $calling_sub =~ s/^Benchmark:://;
+    return $_Usage{$calling_sub} || '';
+}

 
 # The cache needs two branches: 's' for strings and 'c' for code.  The
 
 # The cache needs two branches: 's' for strings and 'c' for code.  The

-# emtpy loop is different in these two cases.
-sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
-sub clearallcache { %cache = (); }
-sub enablecache   { $cache = 1; }
-sub disablecache  { $cache = 0; }
+# empty loop is different in these two cases.
+
+$_Usage{clearcache} = <<'USAGE';
+usage: clearcache($count);
+USAGE
+
+sub clearcache    { 
+    die usage unless @_ == 1;
+    delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"}; 
+}
+
+$_Usage{clearallcache} = <<'USAGE';
+usage: clearallcache();
+USAGE
+
+sub clearallcache { 
+    die usage if @_;
+    %Cache = (); 
+}
+
+$_Usage{enablecache} = <<'USAGE';
+usage: enablecache();
+USAGE
+
+sub enablecache   {
+    die usage if @_;
+    $Do_Cache = 1; 
+}
+
+$_Usage{disablecache} = <<'USAGE';
+usage: disablecache();
+USAGE
+
+sub disablecache  {
+    die usage if @_;
+    $Do_Cache = 0; 
+}
+

 
 # --- Functions to process the 'time' data type
 
 
 # --- Functions to process the 'time' data type
 

-sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
-         print STDERR "new=@t\n" if $debug;
+sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0);
+         print STDERR "new=@t\n" if $Debug;

          bless \@t; }
 
 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
          bless \@t; }
 
 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }


@@ -450,59 +543,94 @@ 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 real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 sub iters { $_[0]->[5] ; }
 

+
+$_Usage{timediff} = <<'USAGE';
+usage: $result_diff = timediff($result1, $result2);
+USAGE
+

 sub timediff {
     my($a, $b) = @_;
 sub timediff {
     my($a, $b) = @_;

+
+    die usage unless ref $a and ref $b;
+

     my @r;
     for (my $i=0; $i < @$a; ++$i) {
        push(@r, $a->[$i] - $b->[$i]);
     }
     my @r;
     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;
 }
 
     bless \@r;
 }
 

+$_Usage{timesum} = <<'USAGE';
+usage: $sum = timesum($result1, $result2);
+USAGE
+

 sub timesum {
 sub timesum {

-     my($a, $b) = @_;
-     my @r;
-     for (my $i=0; $i < @$a; ++$i) {
+    my($a, $b) = @_;
+
+    die usage unless ref $a and ref $b;
+
+    my @r;
+    for (my $i=0; $i < @$a; ++$i) {

        push(@r, $a->[$i] + $b->[$i]);
        push(@r, $a->[$i] + $b->[$i]);

-     }
-     bless \@r;
+    }
+    bless \@r;

 }
 
 }
 

+
+$_Usage{timestr} = <<'USAGE';
+usage: $formatted_result = timestr($result1);
+USAGE
+

 sub timestr {
     my($tr, $style, $f) = @_;
 sub timestr {
     my($tr, $style, $f) = @_;

+
+    die usage unless ref $tr;
+

     my @t = @$tr;
     warn "bad time value (@t)" unless @t==6;
     my($r, $pu, $ps, $cu, $cs, $n) = @t;
     my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
     my @t = @$tr;
     warn "bad time value (@t)" unless @t==6;
     my($r, $pu, $ps, $cu, $cs, $n) = @t;
     my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);

-    $f = $defaultfmt unless defined $f;
+    $f = $Default_Format unless defined $f;

     # format a time in the required style, other formats may be added here
     # format a time in the required style, other formats may be added here

-    $style ||= $defaultstyle;
+    $style ||= $Default_Style;

     return '' if $style eq 'none';
     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
     my $s = "@t $style"; # default for unknown style
     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)",
+    my $w = $hirestime ? "%2g" : "%2d";
+    $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';
                            $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';

-    $s=sprintf("%2d 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';
                            $r,$pu,$ps,$pt) if $style eq 'noc';

-    $s=sprintf("%2d 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';
                            $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;
 }
 
 sub timedebug {
     my($msg, $t) = @_;
     $s;
 }
 
 sub timedebug {
     my($msg, $t) = @_;

-    print STDERR "$msg",timestr($t),"\n" if $debug;
+    print STDERR "$msg",timestr($t),"\n" if $Debug;

 }
 
 # --- Functions implementing low-level support for timing loops
 
 }
 
 # --- Functions implementing low-level support for timing loops
 

+$_Usage{runloop} = <<'USAGE';
+usage: runloop($number, [$string | $coderef])
+USAGE
+

 sub runloop {
     my($n, $c) = @_;
 
     $n+=0; # force numeric now, so garbage won't creep into the eval
     croak "negative loopcount $n" if $n<0;
 sub runloop {
     my($n, $c) = @_;
 
     $n+=0; # force numeric now, so garbage won't creep into the eval
     croak "negative loopcount $n" if $n<0;

-    confess "Usage: runloop(number, [string | coderef])" unless defined $c;
+    confess usage unless defined $c;

     my($t0, $t1, $td); # before, after, difference
 
     # find package of caller so we can execute code there
     my($t0, $t1, $td); # before, after, difference
 
     # find package of caller so we can execute code there


@@ -522,7 +650,7 @@ sub runloop {
         $subref  = _doeval($subcode);
     }
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
         $subref  = _doeval($subcode);
     }
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;

-    print STDERR "runloop $n '$subcode'\n" if $debug;
+    print STDERR "runloop $n '$subcode'\n" if $Debug;

 
     # Wait for the user timer to tick.  This makes the error range more like 
     # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This
 
     # Wait for the user timer to tick.  This makes the error range more like 
     # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This


@@ -532,28 +660,35 @@ sub runloop {
     # &runloop a lot, and thus reduce additive errors.
     my $tbase = Benchmark->new(0)->[1];
     while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
     # &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);
     $td;
 }
 
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
     timedebug("runloop:",$td);
     $td;
 }
 

+$_Usage{timeit} = <<'USAGE';
+usage: $result = timeit($count, 'code' );        or
+       $result = timeit($count, sub { code } );
+USAGE

 
 sub timeit {
     my($n, $code) = @_;
     my($wn, $wc, $wd);
 
 
 sub timeit {
     my($n, $code) = @_;
     my($wn, $wc, $wd);
 

-    printf STDERR "timeit $n $code\n" if $debug;
+    die usage unless defined $code and
+                     (!ref $code or ref $code eq 'CODE');
+
+    printf STDERR "timeit $n $code\n" if $Debug;

     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );

-    if ($cache && exists $cache{$cache_key} ) {
-       $wn = $cache{$cache_key};
+    if ($Do_Cache && exists $Cache{$cache_key} ) {
+       $wn = $Cache{$cache_key};

     } else {
        $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;
     } else {
        $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;

-       $cache{$cache_key} = $wn;
+       $Cache{$cache_key} = $wn;

     }
 
     $wc = &runloop($n, $code);
     }
 
     $wc = &runloop($n, $code);


@@ -571,9 +706,16 @@ my $default_for = 3;
 my $min_for     = 0.1;
 
 
 my $min_for     = 0.1;
 
 

+$_Usage{countit} = <<'USAGE';
+usage: $result = countit($time, 'code' );        or
+       $result = countit($time, sub { code } );
+USAGE
+

 sub countit {
     my ( $tmax, $code ) = @_;
 
 sub countit {
     my ( $tmax, $code ) = @_;
 

+    die usage unless @_;
+

     if ( not defined $tmax or $tmax == 0 ) {
        $tmax = $default_for;
     } elsif ( $tmax < 0 ) {
     if ( not defined $tmax or $tmax == 0 ) {
        $tmax = $default_for;
     } elsif ( $tmax < 0 ) {


@@ -586,9 +728,16 @@ sub countit {
     my ($n, $tc);
 
     # First find the minimum $n that gives a significant timing.
     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];
     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;
     }
 
        last if $tc > 0.1;
     }
 


@@ -622,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 ) );
     # 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;
     while () {
        my $td = timeit($n, $code);
        $ntot  += $n;


@@ -633,7 +782,12 @@ sub countit {
        $cstot += $td->[4];
        $ttot = $utot + $stot;
        last if $ttot >= $tmax;
        $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 );
         $ttot = 0.01 if $ttot < 0.01;
        my $r = $tmax / $ttot - 1; # Linear approximation.
        $n = int( $r * $ntot );


@@ -650,16 +804,24 @@ sub n_to_for {
     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 }
 
     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 }
 

+$_Usage{timethis} = <<'USAGE';
+usage: $result = timethis($time, 'code' );        or
+       $result = timethis($time, sub { code } );
+USAGE
+

 sub timethis{
     my($n, $code, $title, $style) = @_;
 sub timethis{
     my($n, $code, $title, $style) = @_;

-    my($t, $for, $forn);
+    my($t, $forn);
+
+    die usage unless defined $code and
+                     (!ref $code or ref $code eq 'CODE');

 
     if ( $n > 0 ) {
        croak "non-integer loopcount $n, stopped" if int($n)<$n;
        $t = timeit($n, $code);
        $title = "timethis $n" unless defined $title;
     } else {
 
     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 );
+       my $fort  = n_to_for( $n );

        $t     = countit( $fort, $code );
        $title = "timethis for $fort" unless defined $title;
        $forn  = $t->[-1];
        $t     = countit( $fort, $code );
        $title = "timethis for $fort" unless defined $title;
        $forn  = $t->[-1];


@@ -667,7 +829,7 @@ sub timethis{
     local $| = 1;
     $style = "" unless defined $style;
     printf("%10s: ", $title) unless $style eq 'none';
     local $| = 1;
     $style = "" unless defined $style;
     printf("%10s: ", $title) unless $style eq 'none';

-    print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
+    print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none';

 
     $n = $forn if defined $forn;
 
 
     $n = $forn if defined $forn;
 


@@ -675,16 +837,22 @@ sub timethis{
     # Don't assume that your benchmark is ok simply because
     # you don't get this warning!
     print "            (warning: too few iterations for a reliable count)\n"
     # Don't assume that your benchmark is ok simply because
     # you don't get this warning!
     print "            (warning: too few iterations for a reliable count)\n"

-       if     $n < $min_count
+       if     $n < $Min_Count

            || ($t->real < 1 && $n < 1000)
            || ($t->real < 1 && $n < 1000)

-           || $t->cpu_a < $min_cpu;
+           || $t->cpu_a < $Min_CPU;

     $t;
 }
 
     $t;
 }
 

+
+$_Usage{timethese} = <<'USAGE';
+usage: timethese($count, { Name1 => 'code1', ... });        or
+       timethese($count, { Name1 => sub { code1 }, ... });
+USAGE
+

 sub timethese{
     my($n, $alt, $style) = @_;
 sub timethese{
     my($n, $alt, $style) = @_;

-    die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
-               unless ref $alt eq HASH;
+    die usage unless ref $alt eq 'HASH';
+

     my @names = sort keys %$alt;
     $style = "" unless defined $style;
     print "Benchmark: " unless $style eq 'none';
     my @names = sort keys %$alt;
     $style = "" unless defined $style;
     print "Benchmark: " unless $style eq 'none';


@@ -712,8 +880,28 @@ sub timethese{
     return \%results;
 }
 
     return \%results;
 }
 

+
+$_Usage{cmpthese} = <<'USAGE';
+usage: cmpthese($count, { Name1 => 'code1', ... });        or
+       cmpthese($count, { Name1 => sub { code1 }, ... });  or
+       cmpthese($result, $style);
+USAGE
+

 sub cmpthese{
 sub cmpthese{

-    my ($results, $style) = ref $_[0] ? @_ : ( timethese( @_[0,1,2] ), $_[2] ) ;
+    my ($results, $style);
+
+    # $count can be a blessed object.
+    if ( ref $_[0] eq 'HASH' ) {
+        ($results, $style) = @_;
+    }
+    else {
+        my($count, $code) = @_[0,1];
+        $style = $_[2] if defined $_[2];
+
+        die usage unless ref $code eq 'HASH';
+
+        $results = timethese($count, $code, ($style || "none"));
+    }

 
     $style = "" unless defined $style;
 
 
     $style = "" unless defined $style;
 


@@ -723,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.
     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;
     }
 
        $_->[7] = $rate;
     }
 


@@ -731,7 +924,7 @@ sub cmpthese{
     @vals = sort { $a->[7] <=> $b->[7] } @vals;
 
     # If more than half of the rates are greater than one...
     @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;
 
     my @rows;
     my @col_widths;


@@ -761,28 +954,28 @@ sub cmpthese{
        my $row_rate = $row_val->[7];
 
        # We assume that we'll never get a 0 rate.
        my $row_rate = $row_val->[7];
 
        # We assume that we'll never get a 0 rate.

-       my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
+       my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;

 
        # Only give a few decimal places before switching to sci. notation,
        # since the results aren't usually that accurate anyway.
        my $format = 
 
        # Only give a few decimal places before switching to sci. notation,
        # since the results aren't usually that accurate anyway.
        my $format = 

-          $a >= 100 ? 
+          $rate >= 100 ? 

               "%0.0f" : 
               "%0.0f" : 

-          $a >= 10 ?
+          $rate >= 10 ?

               "%0.1f" :
               "%0.1f" :

-          $a >= 1 ?
+          $rate >= 1 ?

               "%0.2f" :
               "%0.2f" :

-          $a >= 0.1 ?
+          $rate >= 0.1 ?

               "%0.3f" :
               "%0.2e";
 
        $format .= "/s"
            if $display_as_rate;
               "%0.3f" :
               "%0.2e";
 
        $format .= "/s"
            if $display_as_rate;

-       # Using $b here due to optimizing bug in _58 through _61
-       my $b = sprintf( $format, $a );
-       push @row, $b;
-       $col_widths[1] = length( $b )
-           if length( $b ) > $col_widths[1];
+
+       my $formatted_rate = sprintf( $format, $rate );
+       push @row, $formatted_rate;
+       $col_widths[1] = length( $formatted_rate )
+           if length( $formatted_rate ) > $col_widths[1];

 
         # Columns 2..N = performance ratios
        my $skip_rest = 0;
 
         # Columns 2..N = performance ratios
        my $skip_rest = 0;