This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #40917] Benchmark fails under -Mbignum
[perl5.git] / lib / Benchmark.pm
CommitLineData
a0d0e21e
LW
1package Benchmark;
2
53aa2791
MS
3use strict;
4
5
f06db76b
AD
6=head1 NAME
7
8a4f6ac2 8Benchmark - benchmark running times of Perl code
431d98c2 9
f06db76b
AD
10=head1 SYNOPSIS
11
f36484b0
BS
12 use Benchmark qw(:all) ;
13
f06db76b
AD
14 timethis ($count, "code");
15
523cc92b 16 # Use Perl code in strings...
f06db76b
AD
17 timethese($count, {
18 'Name1' => '...code1...',
19 'Name2' => '...code2...',
20 });
21
523cc92b
CS
22 # ... or use subroutine references.
23 timethese($count, {
24 'Name1' => sub { ...code1... },
25 'Name2' => sub { ...code2... },
26 });
27
431d98c2
BS
28 # cmpthese can be used both ways as well
29 cmpthese($count, {
30 'Name1' => '...code1...',
31 'Name2' => '...code2...',
32 });
33
34 cmpthese($count, {
35 'Name1' => sub { ...code1... },
36 'Name2' => sub { ...code2... },
37 });
38
39 # ...or in two stages
40 $results = timethese($count,
41 {
42 'Name1' => sub { ...code1... },
43 'Name2' => sub { ...code2... },
44 },
45 'none'
46 );
47 cmpthese( $results ) ;
48
f06db76b
AD
49 $t = timeit($count, '...other code...')
50 print "$count loops of other code took:",timestr($t),"\n";
51
431d98c2
BS
52 $t = countit($time, '...other code...')
53 $count = $t->iters ;
54 print "$count loops of other code took:",timestr($t),"\n";
55
e3d6de9a
JH
56 # enable hires wallclock timing if possible
57 use Benchmark ':hireswallclock';
58
f06db76b
AD
59=head1 DESCRIPTION
60
61The Benchmark module encapsulates a number of routines to help you
62figure out how long it takes to execute some code.
63
8a4f6ac2
GS
64timethis - run a chunk of code several times
65
66timethese - run several chunks of code several times
67
68cmpthese - print results of timethese as a comparison chart
69
70timeit - run a chunk of code and see how long it goes
71
72countit - see how many times a chunk of code runs in a given time
73
74
f06db76b
AD
75=head2 Methods
76
77=over 10
78
79=item new
80
81Returns the current time. Example:
82
83 use Benchmark;
84 $t0 = new Benchmark;
85 # ... your code here ...
86 $t1 = new Benchmark;
87 $td = timediff($t1, $t0);
a24a9dfe 88 print "the code took:",timestr($td),"\n";
f06db76b
AD
89
90=item debug
91
92Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
93
523cc92b 94 debug Benchmark 1;
f06db76b 95 $t = timeit(10, ' 5 ** $Global ');
523cc92b 96 debug Benchmark 0;
f06db76b 97
431d98c2
BS
98=item iters
99
100Returns the number of iterations.
101
f06db76b
AD
102=back
103
104=head2 Standard Exports
105
523cc92b 106The following routines will be exported into your namespace
f06db76b
AD
107if you use the Benchmark module:
108
109=over 10
110
111=item timeit(COUNT, CODE)
112
523cc92b
CS
113Arguments: COUNT is the number of times to run the loop, and CODE is
114the code to run. CODE may be either a code reference or a string to
115be eval'd; either way it will be run in the caller's package.
116
117Returns: a Benchmark object.
118
119=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
120
121Time COUNT iterations of CODE. CODE may be a string to eval or a
122code reference; either way the CODE will run in the caller's package.
123Results will be printed to STDOUT as TITLE followed by the times.
124TITLE defaults to "timethis COUNT" if none is provided. STYLE
125determines the format of the output, as described for timestr() below.
126
6ee623d5
GS
127The COUNT can be zero or negative: this means the I<minimum number of
128CPU seconds> to run. A zero signifies the default of 3 seconds. For
129example to run at least for 10 seconds:
130
131 timethis(-10, $code)
132
133or to run two pieces of code tests for at least 3 seconds:
134
135 timethese(0, { test1 => '...', test2 => '...'})
136
137CPU seconds is, in UNIX terms, the user time plus the system time of
138the process itself, as opposed to the real (wallclock) time and the
139time spent by the child processes. Less than 0.1 seconds is not
140accepted (-0.01 as the count, for example, will cause a fatal runtime
141exception).
142
143Note that the CPU seconds is the B<minimum> time: CPU scheduling and
144other operating system factors may complicate the attempt so that a
145little bit more time is spent. The benchmark output will, however,
146also tell the number of C<$code> runs/second, which should be a more
147interesting number than the actually spent seconds.
148
149Returns a Benchmark object.
150
523cc92b 151=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
f06db76b 152
523cc92b
CS
153The CODEHASHREF is a reference to a hash containing names as keys
154and either a string to eval or a code reference for each value.
155For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
156call
f06db76b 157
523cc92b 158 timethis(COUNT, VALUE, KEY, STYLE)
f06db76b 159
1d2dff63
GS
160The routines are called in string comparison order of KEY.
161
162The COUNT can be zero or negative, see timethis().
6ee623d5 163
72372890 164Returns a hash reference of Benchmark objects, keyed by name.
3c6312e9 165
523cc92b 166=item timediff ( T1, T2 )
f06db76b 167
523cc92b
CS
168Returns the difference between two Benchmark times as a Benchmark
169object suitable for passing to timestr().
f06db76b 170
6ee623d5 171=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
f06db76b 172
523cc92b
CS
173Returns a string that formats the times in the TIMEDIFF object in
174the requested STYLE. TIMEDIFF is expected to be a Benchmark object
175similar to that returned by timediff().
176
3c6312e9
BS
177STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
178each of the 5 times available ('wallclock' time, user time, system time,
523cc92b
CS
179user time of children, and system time of children). 'noc' shows all
180except the two children times. 'nop' shows only wallclock and the
181two children times. 'auto' (the default) will act as 'all' unless
182the children times are both zero, in which case it acts as 'noc'.
3c6312e9 183'none' prevents output.
523cc92b
CS
184
185FORMAT is the L<printf(3)>-style format specifier (without the
186leading '%') to use to print the times. It defaults to '5.2f'.
f06db76b
AD
187
188=back
189
190=head2 Optional Exports
191
192The following routines will be exported into your namespace
193if you specifically ask that they be imported:
194
195=over 10
196
523cc92b
CS
197=item clearcache ( COUNT )
198
199Clear the cached time for COUNT rounds of the null loop.
200
201=item clearallcache ( )
f06db76b 202
523cc92b 203Clear all cached times.
f06db76b 204
8962dfd6 205=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
ac8eabc1 206
d1083c7a 207=item cmpthese ( RESULTSHASHREF, [ STYLE ] )
ac8eabc1 208
d1083c7a 209Optionally calls timethese(), then outputs comparison chart. This:
ac8eabc1 210
d1083c7a
BS
211 cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
212
213outputs a chart like:
214
215 Rate b a
216 b 2831802/s -- -61%
217 a 7208959/s 155% --
218
219This chart is sorted from slowest to fastest, and shows the percent speed
220difference between each pair of tests.
221
222c<cmpthese> can also be passed the data structure that timethese() returns:
223
224 $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
ac8eabc1
JH
225 cmpthese( $results );
226
d1083c7a 227in case you want to see both sets of results.
72372890
ST
228If the first argument is an unblessed hash reference,
229that is RESULTSHASHREF; otherwise that is COUNT.
d1083c7a
BS
230
231Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
232above chart, including labels. This:
233
234 my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
235
236returns a data structure like:
237
238 [
239 [ '', 'Rate', 'b', 'a' ],
240 [ 'b', '2885232/s', '--', '-59%' ],
241 [ 'a', '7099126/s', '146%', '--' ],
242 ]
243
244B<NOTE>: This result value differs from previous versions, which returned
245the C<timethese()> result structure. If you want that, just use the two
246statement C<timethese>...C<cmpthese> idiom shown above.
247
248Incidently, note the variance in the result values between the two examples;
249this is typical of benchmarking. If this were a real benchmark, you would
250probably want to run a lot more iterations.
ac8eabc1
JH
251
252=item countit(TIME, CODE)
253
254Arguments: TIME is the minimum length of time to run CODE for, and CODE is
255the code to run. CODE may be either a code reference or a string to
256be eval'd; either way it will be run in the caller's package.
257
258TIME is I<not> negative. countit() will run the loop many times to
259calculate the speed of CODE before running it for TIME. The actual
260time run for will usually be greater than TIME due to system clock
261resolution, so it's best to look at the number of iterations divided
262by the times that you are concerned with, not just the iterations.
263
264Returns: a Benchmark object.
265
523cc92b 266=item disablecache ( )
f06db76b 267
523cc92b
CS
268Disable caching of timings for the null loop. This will force Benchmark
269to recalculate these timings for each new piece of code timed.
270
271=item enablecache ( )
272
273Enable caching of timings for the null loop. The time taken for COUNT
274rounds of the null loop will be calculated only once for each
275different COUNT used.
f06db76b 276
ac8eabc1
JH
277=item timesum ( T1, T2 )
278
279Returns the sum of two Benchmark times as a Benchmark object suitable
280for passing to timestr().
281
f06db76b
AD
282=back
283
e3d6de9a
JH
284=head2 :hireswallclock
285
286If the Time::HiRes module has been installed, you can specify the
287special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not
288available, the tag will be silently ignored). This tag will cause the
289wallclock time to be measured in microseconds, instead of integer
702fa71c
HS
290seconds. Note though that the speed computations are still conducted
291in CPU time, not wallclock time.
e3d6de9a 292
f06db76b
AD
293=head1 NOTES
294
295The data is stored as a list of values from the time and times
523cc92b 296functions:
f06db76b 297
431d98c2 298 ($real, $user, $system, $children_user, $children_system, $iters)
f06db76b
AD
299
300in seconds for the whole loop (not divided by the number of rounds).
301
302The timing is done using time(3) and times(3).
303
304Code is executed in the caller's package.
305
f06db76b
AD
306The time of the null loop (a loop with the same
307number of rounds but empty loop body) is subtracted
308from the time of the real loop.
309
3c6312e9 310The null loop times can be cached, the key being the
f06db76b
AD
311number of rounds. The caching can be controlled using
312calls like these:
313
523cc92b 314 clearcache($key);
f06db76b
AD
315 clearallcache();
316
523cc92b 317 disablecache();
f06db76b
AD
318 enablecache();
319
3c6312e9
BS
320Caching is off by default, as it can (usually slightly) decrease
321accuracy and does not usually noticably affect runtimes.
322
54e82ce5
GS
323=head1 EXAMPLES
324
325For example,
326
14393033
BS
327 use Benchmark qw( cmpthese ) ;
328 $x = 3;
329 cmpthese( -5, {
330 a => sub{$x*$x},
331 b => sub{$x**2},
332 } );
54e82ce5
GS
333
334outputs something like this:
335
336 Benchmark: running a, b, each for at least 5 CPU seconds...
14393033
BS
337 Rate b a
338 b 1559428/s -- -62%
339 a 4152037/s 166% --
340
54e82ce5
GS
341
342while
343
14393033
BS
344 use Benchmark qw( timethese cmpthese ) ;
345 $x = 3;
346 $r = timethese( -5, {
347 a => sub{$x*$x},
348 b => sub{$x**2},
349 } );
350 cmpthese $r;
54e82ce5
GS
351
352outputs something like this:
353
14393033
BS
354 Benchmark: running a, b, each for at least 5 CPU seconds...
355 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
356 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
357 Rate b a
358 b 1574945/s -- -59%
359 a 3835056/s 144% --
54e82ce5
GS
360
361
f06db76b
AD
362=head1 INHERITANCE
363
364Benchmark inherits from no other class, except of course
365for Exporter.
366
367=head1 CAVEATS
368
80eab818 369Comparing eval'd strings with code references will give you
431d98c2 370inaccurate results: a code reference will show a slightly slower
80eab818
CS
371execution time than the equivalent eval'd string.
372
f06db76b
AD
373The real time timing is done using time(2) and
374the granularity is therefore only one second.
375
376Short tests may produce negative figures because perl
523cc92b
CS
377can appear to take longer to execute the empty loop
378than a short test; try:
f06db76b
AD
379
380 timethis(100,'1');
381
382The system time of the null loop might be slightly
383more than the system time of the loop with the actual
a24a9dfe 384code and therefore the difference might end up being E<lt> 0.
f06db76b 385
8a4f6ac2
GS
386=head1 SEE ALSO
387
388L<Devel::DProf> - a Perl code profiler
389
f06db76b
AD
390=head1 AUTHORS
391
5aabfad6 392Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
f06db76b
AD
393
394=head1 MODIFICATION HISTORY
395
396September 8th, 1994; by Tim Bunce.
397
523cc92b
CS
398March 28th, 1997; by Hugo van der Sanden: added support for code
399references and the already documented 'debug' method; revamped
400documentation.
f06db76b 401
6ee623d5
GS
402April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
403functionality.
404
3c6312e9
BS
405September, 1999; by Barrie Slaymaker: math fixes and accuracy and
406efficiency tweaks. Added cmpthese(). A result is now returned from
431d98c2 407timethese(). Exposed countit() (was runfor()).
3c6312e9 408
0e74ff8e
JH
409December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
410and return an empty string. If cmpthese is calling timethese, make it pass the
411style in. (so that 'none' will suppress output). Make sub new dump its
412debugging output to STDERR, to be consistent with everything else.
413All bugs found while writing a regression test.
414
e3d6de9a
JH
415September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
416
33e4b5a9
CK
417February, 2004; by Chia-liang Kao: make cmpthese and timestr use time
418statistics for children instead of parent when the style is 'nop'.
419
523cc92b 420=cut
a0d0e21e 421
3f943bd9 422# evaluate something in a clean lexical environment
53aa2791 423sub _doeval { no strict; eval shift }
3f943bd9
GS
424
425#
426# put any lexicals at file scope AFTER here
427#
428
4aa0a1f7 429use Carp;
a0d0e21e 430use Exporter;
53aa2791
MS
431
432our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
433
434@ISA=qw(Exporter);
ac8eabc1
JH
435@EXPORT=qw(timeit timethis timethese timediff timestr);
436@EXPORT_OK=qw(timesum cmpthese countit
437 clearcache clearallcache disablecache enablecache);
f36484b0 438%EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
a0d0e21e 439
72372890 440$VERSION = 1.09;
e3d6de9a
JH
441
442# --- ':hireswallclock' special handling
443
444my $hirestime;
445
446sub mytime () { time }
8a4f6ac2 447
359218de 448init();
a0d0e21e 449
e3d6de9a
JH
450sub BEGIN {
451 if (eval 'require Time::HiRes') {
452 import Time::HiRes qw(time);
453 $hirestime = \&Time::HiRes::time;
454 }
455}
456
457sub import {
458 my $class = shift;
459 if (grep { $_ eq ":hireswallclock" } @_) {
460 @_ = grep { $_ ne ":hireswallclock" } @_;
92dfaf87 461 local $^W=0;
e3d6de9a
JH
462 *mytime = $hirestime if defined $hirestime;
463 }
464 Benchmark->export_to_level(1, $class, @_);
465}
466
53aa2791
MS
467our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style,
468 %_Usage, %Cache, $Do_Cache);
469
a0d0e21e 470sub init {
53aa2791
MS
471 $Debug = 0;
472 $Min_Count = 4;
473 $Min_CPU = 0.4;
474 $Default_Format = '5.2f';
475 $Default_Style = 'auto';
a0d0e21e
LW
476 # The cache can cause a slight loss of sys time accuracy. If a
477 # user does many tests (>10) with *very* large counts (>10000)
478 # or works on a very slow machine the cache may be useful.
359218de
JH
479 disablecache();
480 clearallcache();
a0d0e21e
LW
481}
482
53aa2791
MS
483sub debug { $Debug = ($_[1] != 0); }
484
485sub usage {
486 my $calling_sub = (caller(1))[3];
487 $calling_sub =~ s/^Benchmark:://;
488 return $_Usage{$calling_sub} || '';
489}
490
bba8fca5 491# The cache needs two branches: 's' for strings and 'c' for code. The
359218de 492# empty loop is different in these two cases.
53aa2791 493
f695f0e6
JH
494$_Usage{clearcache} = <<'USAGE';
495usage: clearcache($count);
496USAGE
497
498sub clearcache {
499 die usage unless @_ == 1;
53aa2791
MS
500 delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
501}
502
f695f0e6
JH
503$_Usage{clearallcache} = <<'USAGE';
504usage: clearallcache();
505USAGE
506
507sub clearallcache {
508 die usage if @_;
53aa2791
MS
509 %Cache = ();
510}
511
f695f0e6
JH
512$_Usage{enablecache} = <<'USAGE';
513usage: enablecache();
514USAGE
515
516sub enablecache {
517 die usage if @_;
53aa2791
MS
518 $Do_Cache = 1;
519}
520
f695f0e6
JH
521$_Usage{disablecache} = <<'USAGE';
522usage: disablecache();
523USAGE
524
525sub disablecache {
526 die usage if @_;
53aa2791
MS
527 $Do_Cache = 0;
528}
529
a0d0e21e 530
a0d0e21e
LW
531# --- Functions to process the 'time' data type
532
e3d6de9a 533sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0);
53aa2791 534 print STDERR "new=@t\n" if $Debug;
6ee623d5 535 bless \@t; }
a0d0e21e
LW
536
537sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
538sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
539sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
540sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
431d98c2 541sub iters { $_[0]->[5] ; }
a0d0e21e 542
53aa2791
MS
543
544$_Usage{timediff} = <<'USAGE';
545usage: $result_diff = timediff($result1, $result2);
546USAGE
547
523cc92b 548sub timediff {
a0d0e21e 549 my($a, $b) = @_;
53aa2791
MS
550
551 die usage unless ref $a and ref $b;
552
523cc92b 553 my @r;
3f943bd9 554 for (my $i=0; $i < @$a; ++$i) {
a0d0e21e
LW
555 push(@r, $a->[$i] - $b->[$i]);
556 }
e68ec53f
YO
557 #die "Bad timediff(): ($r[1] + $r[2]) <= 0 (@$a[1,2]|@$b[1,2])\n"
558 # if ($r[1] + $r[2]) < 0;
a0d0e21e
LW
559 bless \@r;
560}
561
53aa2791
MS
562$_Usage{timesum} = <<'USAGE';
563usage: $sum = timesum($result1, $result2);
564USAGE
565
705cc255 566sub timesum {
53aa2791
MS
567 my($a, $b) = @_;
568
569 die usage unless ref $a and ref $b;
570
571 my @r;
572 for (my $i=0; $i < @$a; ++$i) {
705cc255 573 push(@r, $a->[$i] + $b->[$i]);
53aa2791
MS
574 }
575 bless \@r;
705cc255
TB
576}
577
53aa2791
MS
578
579$_Usage{timestr} = <<'USAGE';
580usage: $formatted_result = timestr($result1);
581USAGE
582
523cc92b 583sub timestr {
a0d0e21e 584 my($tr, $style, $f) = @_;
53aa2791
MS
585
586 die usage unless ref $tr;
587
523cc92b 588 my @t = @$tr;
6ee623d5
GS
589 warn "bad time value (@t)" unless @t==6;
590 my($r, $pu, $ps, $cu, $cs, $n) = @t;
ce9550df 591 my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
53aa2791 592 $f = $Default_Format unless defined $f;
a0d0e21e 593 # format a time in the required style, other formats may be added here
53aa2791 594 $style ||= $Default_Style;
0e74ff8e 595 return '' if $style eq 'none';
523cc92b
CS
596 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
597 my $s = "@t $style"; # default for unknown style
e3d6de9a
JH
598 my $w = $hirestime ? "%2g" : "%2d";
599 $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
ce9550df 600 $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
e3d6de9a 601 $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
7be077a2 602 $r,$pu,$ps,$pt) if $style eq 'noc';
e3d6de9a 603 $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
7be077a2 604 $r,$cu,$cs,$ct) if $style eq 'nop';
33e4b5a9
CK
605 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $style eq 'nop' ? $cu + $cs : $pu + $ps ))
606 if $n && ($style eq 'nop' ? $cu+$cs : $pu+$ps);
a0d0e21e
LW
607 $s;
608}
523cc92b
CS
609
610sub timedebug {
a0d0e21e 611 my($msg, $t) = @_;
53aa2791 612 print STDERR "$msg",timestr($t),"\n" if $Debug;
a0d0e21e
LW
613}
614
a0d0e21e
LW
615# --- Functions implementing low-level support for timing loops
616
53aa2791
MS
617$_Usage{runloop} = <<'USAGE';
618usage: runloop($number, [$string | $coderef])
619USAGE
620
a0d0e21e
LW
621sub runloop {
622 my($n, $c) = @_;
4aa0a1f7
AD
623
624 $n+=0; # force numeric now, so garbage won't creep into the eval
523cc92b 625 croak "negative loopcount $n" if $n<0;
53aa2791 626 confess usage unless defined $c;
a0d0e21e
LW
627 my($t0, $t1, $td); # before, after, difference
628
629 # find package of caller so we can execute code there
523cc92b
CS
630 my($curpack) = caller(0);
631 my($i, $pack)= 0;
a0d0e21e
LW
632 while (($pack) = caller(++$i)) {
633 last if $pack ne $curpack;
634 }
635
3f943bd9
GS
636 my ($subcode, $subref);
637 if (ref $c eq 'CODE') {
638 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
639 $subref = eval $subcode;
640 }
641 else {
642 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
643 $subref = _doeval($subcode);
644 }
4aa0a1f7 645 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
53aa2791 646 print STDERR "runloop $n '$subcode'\n" if $Debug;
a0d0e21e 647
3c6312e9
BS
648 # Wait for the user timer to tick. This makes the error range more like
649 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
650 # may not seem important, but it significantly reduces the chances of
651 # getting a too low initial $n in the initial, 'find the minimum' loop
431d98c2 652 # in &countit. This, in turn, can reduce the number of calls to
bba8fca5
BS
653 # &runloop a lot, and thus reduce additive errors.
654 my $tbase = Benchmark->new(0)->[1];
277427cf 655 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
f265d4df 656 $subref->();
6ee623d5 657 $t1 = Benchmark->new($n);
a0d0e21e 658 $td = &timediff($t1, $t0);
a0d0e21e
LW
659 timedebug("runloop:",$td);
660 $td;
661}
662
53aa2791
MS
663$_Usage{timeit} = <<'USAGE';
664usage: $result = timeit($count, 'code' ); or
665 $result = timeit($count, sub { code } );
666USAGE
a0d0e21e
LW
667
668sub timeit {
669 my($n, $code) = @_;
670 my($wn, $wc, $wd);
671
53aa2791
MS
672 die usage unless defined $code and
673 (!ref $code or ref $code eq 'CODE');
674
675 printf STDERR "timeit $n $code\n" if $Debug;
3c6312e9 676 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
53aa2791
MS
677 if ($Do_Cache && exists $Cache{$cache_key} ) {
678 $wn = $Cache{$cache_key};
523cc92b 679 } else {
6bf773bc 680 $wn = &runloop($n, ref( $code ) ? sub { } : '' );
3c6312e9
BS
681 # Can't let our baseline have any iterations, or they get subtracted
682 # out of the result.
683 $wn->[5] = 0;
53aa2791 684 $Cache{$cache_key} = $wn;
a0d0e21e
LW
685 }
686
687 $wc = &runloop($n, $code);
688
689 $wd = timediff($wc, $wn);
a0d0e21e
LW
690 timedebug("timeit: ",$wc);
691 timedebug(" - ",$wn);
692 timedebug(" = ",$wd);
693
694 $wd;
695}
696
6ee623d5
GS
697
698my $default_for = 3;
699my $min_for = 0.1;
700
3c6312e9 701
53aa2791
MS
702$_Usage{countit} = <<'USAGE';
703usage: $result = countit($time, 'code' ); or
704 $result = countit($time, sub { code } );
705USAGE
706
431d98c2
BS
707sub countit {
708 my ( $tmax, $code ) = @_;
6ee623d5 709
53aa2791
MS
710 die usage unless @_;
711
6ee623d5
GS
712 if ( not defined $tmax or $tmax == 0 ) {
713 $tmax = $default_for;
714 } elsif ( $tmax < 0 ) {
715 $tmax = -$tmax;
716 }
717
431d98c2 718 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
6ee623d5
GS
719 if $tmax < $min_for;
720
3c6312e9 721 my ($n, $tc);
6ee623d5 722
bba8fca5 723 # First find the minimum $n that gives a significant timing.
e68ec53f 724 my $zeros=0;
3c6312e9
BS
725 for ($n = 1; ; $n *= 2 ) {
726 my $td = timeit($n, $code);
727 $tc = $td->[1] + $td->[2];
e68ec53f
YO
728 if ( $tc <= 0 and $n > 1024 ) {
729 ++$zeros > 16
730 and die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
731 } else {
732 $zeros = 0;
733 }
3c6312e9
BS
734 last if $tc > 0.1;
735 }
6ee623d5 736
3c6312e9
BS
737 my $nmin = $n;
738
739 # Get $n high enough that we can guess the final $n with some accuracy.
740 my $tpra = 0.1 * $tmax; # Target/time practice.
741 while ( $tc < $tpra ) {
742 # The 5% fudge is to keep us from iterating again all
743 # that often (this speeds overall responsiveness when $tmax is big
744 # and we guess a little low). This does not noticably affect
745 # accuracy since we're not couting these times.
746 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
747 my $td = timeit($n, $code);
c5d57293
A
748 my $new_tc = $td->[1] + $td->[2];
749 # Make sure we are making progress.
750 $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
6ee623d5
GS
751 }
752
3c6312e9
BS
753 # Now, do the 'for real' timing(s), repeating until we exceed
754 # the max.
755 my $ntot = 0;
756 my $rtot = 0;
757 my $utot = 0.0;
758 my $stot = 0.0;
759 my $cutot = 0.0;
760 my $cstot = 0.0;
761 my $ttot = 0.0;
762
763 # The 5% fudge is because $n is often a few % low even for routines
764 # with stable times and avoiding extra timeit()s is nice for
765 # accuracy's sake.
766 $n = int( $n * ( 1.05 * $tmax / $tc ) );
e68ec53f 767 $zeros=0;
3c6312e9
BS
768 while () {
769 my $td = timeit($n, $code);
770 $ntot += $n;
771 $rtot += $td->[0];
772 $utot += $td->[1];
773 $stot += $td->[2];
6ee623d5
GS
774 $cutot += $td->[3];
775 $cstot += $td->[4];
3c6312e9
BS
776 $ttot = $utot + $stot;
777 last if $ttot >= $tmax;
e68ec53f
YO
778 if ( $ttot <= 0 ) {
779 ++$zeros > 16
780 and die "Timing is consistently zero, cannot benchmark. N=$n\n";
781 } else {
782 $zeros = 0;
783 }
c5d57293 784 $ttot = 0.01 if $ttot < 0.01;
3c6312e9 785 my $r = $tmax / $ttot - 1; # Linear approximation.
bba8fca5 786 $n = int( $r * $ntot );
6ee623d5 787 $n = $nmin if $n < $nmin;
6ee623d5
GS
788 }
789
790 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
791}
792
a0d0e21e
LW
793# --- Functions implementing high-level time-then-print utilities
794
6ee623d5
GS
795sub n_to_for {
796 my $n = shift;
797 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
798}
799
53aa2791
MS
800$_Usage{timethis} = <<'USAGE';
801usage: $result = timethis($time, 'code' ); or
802 $result = timethis($time, sub { code } );
803USAGE
804
a0d0e21e
LW
805sub timethis{
806 my($n, $code, $title, $style) = @_;
53aa2791
MS
807 my($t, $forn);
808
809 die usage unless defined $code and
810 (!ref $code or ref $code eq 'CODE');
6ee623d5
GS
811
812 if ( $n > 0 ) {
813 croak "non-integer loopcount $n, stopped" if int($n)<$n;
814 $t = timeit($n, $code);
815 $title = "timethis $n" unless defined $title;
816 } else {
53aa2791 817 my $fort = n_to_for( $n );
431d98c2 818 $t = countit( $fort, $code );
6ee623d5
GS
819 $title = "timethis for $fort" unless defined $title;
820 $forn = $t->[-1];
821 }
523cc92b 822 local $| = 1;
523cc92b 823 $style = "" unless defined $style;
3c6312e9 824 printf("%10s: ", $title) unless $style eq 'none';
53aa2791 825 print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none';
6ee623d5
GS
826
827 $n = $forn if defined $forn;
523cc92b 828
a0d0e21e
LW
829 # A conservative warning to spot very silly tests.
830 # Don't assume that your benchmark is ok simply because
831 # you don't get this warning!
832 print " (warning: too few iterations for a reliable count)\n"
53aa2791 833 if $n < $Min_Count
a0d0e21e 834 || ($t->real < 1 && $n < 1000)
53aa2791 835 || $t->cpu_a < $Min_CPU;
a0d0e21e
LW
836 $t;
837}
838
53aa2791
MS
839
840$_Usage{timethese} = <<'USAGE';
841usage: timethese($count, { Name1 => 'code1', ... }); or
842 timethese($count, { Name1 => sub { code1 }, ... });
843USAGE
844
a0d0e21e
LW
845sub timethese{
846 my($n, $alt, $style) = @_;
53aa2791
MS
847 die usage unless ref $alt eq 'HASH';
848
523cc92b
CS
849 my @names = sort keys %$alt;
850 $style = "" unless defined $style;
3c6312e9 851 print "Benchmark: " unless $style eq 'none';
6ee623d5
GS
852 if ( $n > 0 ) {
853 croak "non-integer loopcount $n, stopped" if int($n)<$n;
3c6312e9 854 print "timing $n iterations of" unless $style eq 'none';
6ee623d5 855 } else {
3c6312e9 856 print "running" unless $style eq 'none';
6ee623d5 857 }
3c6312e9 858 print " ", join(', ',@names) unless $style eq 'none';
6ee623d5
GS
859 unless ( $n > 0 ) {
860 my $for = n_to_for( $n );
df7779cf
T
861 print ", each" if $n > 1 && $style ne 'none';
862 print " for at least $for CPU seconds" unless $style eq 'none';
6ee623d5 863 }
3c6312e9 864 print "...\n" unless $style eq 'none';
523cc92b
CS
865
866 # we could save the results in an array and produce a summary here
a0d0e21e 867 # sum, min, max, avg etc etc
3c6312e9 868 my %results;
4dbb2df9 869 foreach my $name (@names) {
3c6312e9 870 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
4dbb2df9 871 }
3c6312e9
BS
872
873 return \%results;
a0d0e21e
LW
874}
875
53aa2791
MS
876
877$_Usage{cmpthese} = <<'USAGE';
878usage: cmpthese($count, { Name1 => 'code1', ... }); or
879 cmpthese($count, { Name1 => sub { code1 }, ... }); or
880 cmpthese($result, $style);
881USAGE
882
3c6312e9 883sub cmpthese{
53aa2791
MS
884 my ($results, $style);
885
72372890
ST
886 # $count can be a blessed object.
887 if ( ref $_[0] eq 'HASH' ) {
53aa2791
MS
888 ($results, $style) = @_;
889 }
890 else {
891 my($count, $code) = @_[0,1];
892 $style = $_[2] if defined $_[2];
893
894 die usage unless ref $code eq 'HASH';
895
896 $results = timethese($count, $code, ($style || "none"));
897 }
3c6312e9 898
d1083c7a 899 $style = "" unless defined $style;
3c6312e9
BS
900
901 # Flatten in to an array of arrays with the name as the first field
902 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
903
904 for (@vals) {
905 # The epsilon fudge here is to prevent div by 0. Since clock
906 # resolutions are much larger, it's below the noise floor.
33e4b5a9
CK
907 my $rate = $_->[6] / (( $style eq 'nop' ? $_->[4] + $_->[5]
908 : $_->[2] + $_->[3]) + 0.000000000000001 );
3c6312e9
BS
909 $_->[7] = $rate;
910 }
911
912 # Sort by rate
913 @vals = sort { $a->[7] <=> $b->[7] } @vals;
914
915 # If more than half of the rates are greater than one...
d598cef2 916 my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;
3c6312e9
BS
917
918 my @rows;
919 my @col_widths;
920
921 my @top_row = (
922 '',
923 $display_as_rate ? 'Rate' : 's/iter',
924 map { $_->[0] } @vals
925 );
926
927 push @rows, \@top_row;
928 @col_widths = map { length( $_ ) } @top_row;
929
930 # Build the data rows
931 # We leave the last column in even though it never has any data. Perhaps
932 # it should go away. Also, perhaps a style for a single column of
933 # percentages might be nice.
934 for my $row_val ( @vals ) {
935 my @row;
936
937 # Column 0 = test name
938 push @row, $row_val->[0];
939 $col_widths[0] = length( $row_val->[0] )
940 if length( $row_val->[0] ) > $col_widths[0];
941
942 # Column 1 = performance
943 my $row_rate = $row_val->[7];
944
945 # We assume that we'll never get a 0 rate.
53aa2791 946 my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;
3c6312e9
BS
947
948 # Only give a few decimal places before switching to sci. notation,
949 # since the results aren't usually that accurate anyway.
950 my $format =
53aa2791 951 $rate >= 100 ?
3c6312e9 952 "%0.0f" :
53aa2791 953 $rate >= 10 ?
3c6312e9 954 "%0.1f" :
53aa2791 955 $rate >= 1 ?
3c6312e9 956 "%0.2f" :
53aa2791 957 $rate >= 0.1 ?
3c6312e9
BS
958 "%0.3f" :
959 "%0.2e";
960
961 $format .= "/s"
962 if $display_as_rate;
53aa2791
MS
963
964 my $formatted_rate = sprintf( $format, $rate );
965 push @row, $formatted_rate;
966 $col_widths[1] = length( $formatted_rate )
967 if length( $formatted_rate ) > $col_widths[1];
3c6312e9
BS
968
969 # Columns 2..N = performance ratios
970 my $skip_rest = 0;
971 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
972 my $col_val = $vals[$col_num];
973 my $out;
974 if ( $skip_rest ) {
975 $out = '';
976 }
977 elsif ( $col_val->[0] eq $row_val->[0] ) {
978 $out = "--";
979 # $skip_rest = 1;
980 }
981 else {
982 my $col_rate = $col_val->[7];
983 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
984 }
985 push @row, $out;
986 $col_widths[$col_num+2] = length( $out )
987 if length( $out ) > $col_widths[$col_num+2];
988
989 # A little wierdness to set the first column width properly
990 $col_widths[$col_num+2] = length( $col_val->[0] )
991 if length( $col_val->[0] ) > $col_widths[$col_num+2];
992 }
993 push @rows, \@row;
994 }
995
d1083c7a
BS
996 return \@rows if $style eq "none";
997
3c6312e9
BS
998 # Equalize column widths in the chart as much as possible without
999 # exceeding 80 characters. This does not use or affect cols 0 or 1.
1000 my @sorted_width_refs =
1001 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
1002 my $max_width = ${$sorted_width_refs[-1]};
1003
277427cf 1004 my $total = @col_widths - 1 ;
3c6312e9
BS
1005 for ( @col_widths ) { $total += $_ }
1006
1007 STRETCHER:
1008 while ( $total < 80 ) {
1009 my $min_width = ${$sorted_width_refs[0]};
1010 last
1011 if $min_width == $max_width;
1012 for ( @sorted_width_refs ) {
1013 last
1014 if $$_ > $min_width;
1015 ++$$_;
1016 ++$total;
1017 last STRETCHER
1018 if $total >= 80;
1019 }
1020 }
1021
1022 # Dump the output
1023 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
1024 substr( $format, 1, 0 ) = '-';
1025 for ( @rows ) {
1026 printf $format, @$_;
1027 }
1028
d1083c7a 1029 return \@rows ;
3c6312e9
BS
1030}
1031
1032
a0d0e21e 10331;