regcomp.h: Fold 2 ANYOF flags into a single one

[perl5.git] / lib / Benchmark.pm

diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm
index bc40d2d..b301678 100644 (file)
--- a/lib/Benchmark.pm
+++ b/lib/Benchmark.pm
@@ -37,7 +37,7 @@ Benchmark - benchmark running times of Perl code
     });
 
     # ...or in two stages
     });
 
     # ...or in two stages

-    $results = timethese($count, 
+    $results = timethese($count,

         {
            'Name1' => sub { ...code1... },
            'Name2' => sub { ...code2... },
         {
            'Name1' => sub { ...code1... },
            'Name2' => sub { ...code2... },


@@ -81,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";
 


@@ -91,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
 


@@ -219,9 +219,10 @@ 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" } ) ;
+    $results = timethese( -1,
+        { a => "++\$i", b => "\$i *= 2" } ) ;

     cmpthese( $results );
 
 in case you want to see both sets of results.
     cmpthese( $results );
 
 in case you want to see both sets of results.


@@ -231,7 +232,8 @@ 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:
 

-    my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
+    my $rows = cmpthese( -1,
+        { a => '++$i', b => '$i *= 2' }, "none" );

 
 returns a data structure like:
 
 
 returns a data structure like:
 


@@ -245,7 +247,7 @@ 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.
 
 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;
+Incidentally, 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.
 
 this is typical of benchmarking.  If this were a real benchmark, you would
 probably want to run a lot more iterations.
 


@@ -290,6 +292,46 @@ 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.
 
 seconds.  Note though that the speed computations are still conducted
 in CPU time, not wallclock time.
 

+=head1 Benchmark Object
+
+Many of the functions in this module return a Benchmark object,
+or in the case of C<timethese()>, a reference to a hash, the values of
+which are Benchmark objects.  This is useful if you want to store or
+further process results from Benchmark functions.
+
+Internally the Benchmark object holds timing values,
+described in L</"NOTES"> below.
+The following methods can be used to access them:
+
+=over 4
+
+=item cpu_p
+
+Total CPU (User + System) of the main (parent) process.
+
+=item cpu_c
+
+Total CPU (User + System) of any children processes.
+
+=item cpu_a
+
+Total CPU of parent and any children processes.
+
+=item real
+
+Real elapsed time "wallclock seconds".
+
+=item iters
+
+Number of iterations run.
+
+=back
+
+The following illustrates use of the Benchmark object:
+
+    $result = timethis(100000, sub { ... });
+    print "total CPU = ", $result->cpu_a, "\n";
+

 =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


@@ -318,7 +360,7 @@ calls like these:
     enablecache();
 
 Caching is off by default, as it can (usually slightly) decrease
     enablecache();
 
 Caching is off by default, as it can (usually slightly) decrease

-accuracy and does not usually noticably affect runtimes.
+accuracy and does not usually noticeably affect runtimes.

 
 =head1 EXAMPLES
 
 
 =head1 EXAMPLES
 


@@ -339,7 +381,7 @@ outputs something like this:
    a 4152037/s 166%   --
 
 
    a 4152037/s 166%   --
 
 

-while 
+while

 
     use Benchmark qw( timethese cmpthese ) ;
     $x = 3;
 
     use Benchmark qw( timethese cmpthese ) ;
     $x = 3;


@@ -362,7 +404,7 @@ outputs something like this:
 =head1 INHERITANCE
 
 Benchmark inherits from no other class, except of course
 =head1 INHERITANCE
 
 Benchmark inherits from no other class, except of course

-for Exporter.
+from Exporter.

 
 =head1 CAVEATS
 
 
 =head1 CAVEATS
 


@@ -385,7 +427,7 @@ code and therefore the difference might end up being E<lt> 0.
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 

-L<Devel::DProf> - a Perl code profiler
+L<Devel::NYTProf> - a Perl code profiler

 
 =head1 AUTHORS
 
 
 =head1 AUTHORS
 


@@ -402,8 +444,8 @@ documentation.
 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 functionality.
 
 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 functionality.
 

-September, 1999; by Barrie Slaymaker: math fixes and accuracy and 
-efficiency tweaks.  Added cmpthese().  A result is now returned from 
+September, 1999; by Barrie Slaymaker: math fixes and accuracy and
+efficiency tweaks.  Added cmpthese().  A result is now returned from

 timethese().  Exposed countit() (was runfor()).
 
 December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
 timethese().  Exposed countit() (was runfor()).
 
 December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'


@@ -417,6 +459,9 @@ 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'.
 
 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


@@ -437,7 +482,7 @@ our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
              clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 
              clearcache clearallcache disablecache enablecache);
 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
 

-$VERSION = 1.09;
+$VERSION = 1.20;

 
 # --- ':hireswallclock' special handling
 
 
 # --- ':hireswallclock' special handling
 


@@ -482,7 +527,7 @@ sub init {
 
 sub debug { $Debug = ($_[1] != 0); }
 
 
 sub debug { $Debug = ($_[1] != 0); }
 

-sub usage { 
+sub usage {

     my $calling_sub = (caller(1))[3];
     $calling_sub =~ s/^Benchmark:://;
     return $_Usage{$calling_sub} || '';
     my $calling_sub = (caller(1))[3];
     $calling_sub =~ s/^Benchmark:://;
     return $_Usage{$calling_sub} || '';


@@ -495,18 +540,18 @@ $_Usage{clearcache} = <<'USAGE';
 usage: clearcache($count);
 USAGE
 
 usage: clearcache($count);
 USAGE
 

-sub clearcache    { 
+sub clearcache    {

     die usage unless @_ == 1;
     die usage unless @_ == 1;

-    delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"}; 
+    delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};

 }
 
 $_Usage{clearallcache} = <<'USAGE';
 usage: clearallcache();
 USAGE
 
 }
 
 $_Usage{clearallcache} = <<'USAGE';
 usage: clearallcache();
 USAGE
 

-sub clearallcache { 
+sub clearallcache {

     die usage if @_;
     die usage if @_;

-    %Cache = (); 
+    %Cache = ();

 }
 
 $_Usage{enablecache} = <<'USAGE';
 }
 
 $_Usage{enablecache} = <<'USAGE';


@@ -515,7 +560,7 @@ USAGE
 
 sub enablecache   {
     die usage if @_;
 
 sub enablecache   {
     die usage if @_;

-    $Do_Cache = 1; 
+    $Do_Cache = 1;

 }
 
 $_Usage{disablecache} = <<'USAGE';
 }
 
 $_Usage{disablecache} = <<'USAGE';


@@ -524,7 +569,7 @@ USAGE
 
 sub disablecache  {
     die usage if @_;
 
 sub disablecache  {
     die usage if @_;

-    $Do_Cache = 0; 
+    $Do_Cache = 0;

 }
 
 
 }
 
 


@@ -596,14 +641,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";
     $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';
                            $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';
                            $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';
                            $r,$cu,$cs,$ct) if $style eq 'nop';

-    $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $style eq 'nop' ? $cu + $cs : $pu + $ps ))
-       if $n && ($style eq 'nop' ? $cu+$cs : $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;
 }
 
     $s;
 }
 


@@ -645,14 +694,24 @@ sub runloop {
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
     print STDERR "runloop $n '$subcode'\n" if $Debug;
 
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
     print STDERR "runloop $n '$subcode'\n" if $Debug;
 

-    # Wait for the user timer to tick.  This makes the error range more like 
+    # 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
     # 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 &countit.  This, in turn, can reduce the number of calls to
     # &runloop a lot, and thus reduce additive errors.
     # -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 &countit.  This, in turn, can reduce the number of calls to
     # &runloop a lot, and thus reduce additive errors.

+    #
+    # Note that its possible for the act of reading the system clock to
+    # burn lots of system CPU while we burn very little user clock in the
+    # busy loop, which can cause the loop to run for a very long wall time.
+    # So gradually ramp up the duration of the loop. See RT #122003
+    #

     my $tbase = Benchmark->new(0)->[1];
     my $tbase = Benchmark->new(0)->[1];

-    while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
+    my $limit = 1;
+    while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {
+        for (my $i=0; $i < $limit; $i++) { my $x = $i / 1.5 } # burn user CPU
+        $limit *= 1.1;
+    }

     $subref->();
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);
     $subref->();
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);


@@ -723,11 +782,23 @@ sub countit {
     # First find the minimum $n that gives a significant timing.
     my $zeros=0;
     for ($n = 1; ; $n *= 2 ) {
     # First find the minimum $n that gives a significant timing.
     my $zeros=0;
     for ($n = 1; ; $n *= 2 ) {

+       my $t0 = Benchmark->new(0);

        my $td = timeit($n, $code);
        my $td = timeit($n, $code);

+       my $t1 = Benchmark->new(0);

        $tc = $td->[1] + $td->[2];
        if ( $tc <= 0 and $n > 1024 ) {
        $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";
+           my $d = timediff($t1, $t0);
+           # note that $d is the total CPU time taken to call timeit(),
+           # while $tc is is difference in CPU secs between the empty run
+           # and the code run. If the code is trivial, its possible
+           # for $d to get large while $tc is still zero (or slightly
+           # negative). Bail out once timeit() starts taking more than a
+           # few seconds without noticeable difference.
+           if ($d->[1] + $d->[2] > 8
+               || ++$zeros > 16)
+           {
+               die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
+            }

        } else {
            $zeros = 0;
        }
        } else {
            $zeros = 0;
        }


@@ -741,8 +812,8 @@ sub countit {
     while ( $tc < $tpra ) {
        # The 5% fudge is to keep us from iterating again all
        # that often (this speeds overall responsiveness when $tmax is big
     while ( $tc < $tpra ) {
        # The 5% fudge is to keep us from iterating again all
        # that often (this speeds overall responsiveness when $tmax is big

-       # and we guess a little low).  This does not noticably affect 
-       # accuracy since we're not couting these times.
+       # and we guess a little low).  This does not noticeably affect
+       # accuracy since we're not counting these times.

        $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
        my $td = timeit($n, $code);
        my $new_tc = $td->[1] + $td->[2];
        $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
        my $td = timeit($n, $code);
        my $new_tc = $td->[1] + $td->[2];


@@ -904,8 +975,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] / (( $style eq 'nop' ? $_->[4] + $_->[5]
-                                               : $_->[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;
     }
 


@@ -918,10 +993,10 @@ sub cmpthese{
     my @rows;
     my @col_widths;
 
     my @rows;
     my @col_widths;
 

-    my @top_row = ( 
-        '', 
-       $display_as_rate ? 'Rate' : 's/iter', 
-       map { $_->[0] } @vals 
+    my @top_row = (
+        '',
+       $display_as_rate ? 'Rate' : 's/iter',
+       map { $_->[0] } @vals

     );
 
     push @rows, \@top_row;
     );
 
     push @rows, \@top_row;


@@ -947,9 +1022,9 @@ sub cmpthese{
 
        # Only give a few decimal places before switching to sci. notation,
        # since the results aren't usually that accurate anyway.
 
        # Only give a few decimal places before switching to sci. notation,
        # since the results aren't usually that accurate anyway.

-       my $format = 
-          $rate >= 100 ? 
-              "%0.0f" : 
+       my $format =
+          $rate >= 100 ?
+              "%0.0f" :

           $rate >= 10 ?
               "%0.1f" :
           $rate >= 1 ?
           $rate >= 10 ?
               "%0.1f" :
           $rate >= 1 ?


@@ -986,7 +1061,7 @@ sub cmpthese{
            $col_widths[$col_num+2] = length( $out )
                if length( $out ) > $col_widths[$col_num+2];
 
            $col_widths[$col_num+2] = length( $out )
                if length( $out ) > $col_widths[$col_num+2];
 

-           # A little wierdness to set the first column width properly
+           # A little weirdness to set the first column width properly

            $col_widths[$col_num+2] = length( $col_val->[0] )
                if length( $col_val->[0] ) > $col_widths[$col_num+2];
        }
            $col_widths[$col_num+2] = length( $col_val->[0] )
                if length( $col_val->[0] ) > $col_widths[$col_num+2];
        }


@@ -997,7 +1072,7 @@ sub cmpthese{
 
     # Equalize column widths in the chart as much as possible without
     # exceeding 80 characters.  This does not use or affect cols 0 or 1.
 
     # 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 = 
+    my @sorted_width_refs =

        sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
     my $max_width = ${$sorted_width_refs[-1]};
 
        sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
     my $max_width = ${$sorted_width_refs[-1]};
 


@@ -1010,7 +1085,7 @@ sub cmpthese{
        last
           if $min_width == $max_width;
        for ( @sorted_width_refs ) {
        last
           if $min_width == $max_width;
        for ( @sorted_width_refs ) {

-           last 
+           last

                if $$_ > $min_width;
            ++$$_;
            ++$total;
                if $$_ > $min_width;
            ++$$_;
            ++$total;