This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Memoize: fix test timing
[perl5.git] / cpan / Memoize / t / speed.t
CommitLineData
a0cb3900
JH
1#!/usr/bin/perl
2
484fdf61 3use lib '..';
a0cb3900
JH
4use Memoize;
5
6if (-e '.fast') {
7 print "1..0\n";
8 exit 0;
9}
899dc88a
JH
10$| = 1;
11
12# If we don't say anything, maybe nobody will notice.
13# print STDERR "\nWarning: I'm testing the speedup. This might take up to thirty seconds.\n ";
a0cb3900 14
484fdf61
JH
15my $COARSE_TIME = 1;
16
3d4a255c
JH
17sub times_to_time { my ($u) = times; $u; }
18if ($^O eq 'riscos') {
19 eval {require Time::HiRes; *my_time = \&Time::HiRes::time };
484fdf61 20 if ($@) { *my_time = sub { time }; $COARSE_TIME = 1 }
3d4a255c
JH
21} else {
22 *my_time = \&times_to_time;
23}
24
a0cb3900
JH
25
26print "1..6\n";
27
3d4a255c
JH
28
29
899dc88a
JH
30# This next test finds an example that takes a long time to run, then
31# checks to make sure that the run is actually speeded up by memoization.
484fdf61 32# In some sense, this is the most essential correctness test in the package.
899dc88a 33#
484fdf61
JH
34# We do this by running the fib() function with successfily larger
35# arguments until we find one that tales at least $LONG_RUN seconds
899dc88a
JH
36# to execute. Then we memoize fib() and run the same call cagain. If
37# it doesn't produce the same test in less than one-tenth the time,
38# something is seriously wrong.
39#
40# $LONG_RUN is the number of seconds that the function call must last
41# in order for the call to be considered sufficiently long.
42
43
a0cb3900
JH
44sub fib {
45 my $n = shift;
46 $COUNT++;
47 return $n if $n < 2;
48 fib($n-1) + fib($n-2);
49}
50
484fdf61
JH
51sub max { $_[0] > $_[1] ?
52 $_[0] : $_[1]
53 }
54
55$N = 1;
a0cb3900 56
484fdf61 57$ELAPSED = 0;
899dc88a 58
f0206e81 59my $LONG_RUN = 11;
899dc88a
JH
60
61while (1) {
a0cb3900
JH
62 my $start = time;
63 $COUNT=0;
64 $RESULT = fib($N);
65 $ELAPSED = time - $start;
899dc88a
JH
66 last if $ELAPSED >= $LONG_RUN;
67 if ($ELAPSED > 1) {
68 print "# fib($N) took $ELAPSED seconds.\n" if $N % 1 == 0;
69 # we'd expect that fib(n+1) takes about 1.618 times as long as fib(n)
70 # so now that we have a longish run, let's estimate the value of $N
71 # that will get us a sufficiently long run.
72 $N += 1 + int(log($LONG_RUN/$ELAPSED)/log(1.618));
73 print "# OK, N=$N ought to do it.\n";
74 # It's important not to overshoot here because the running time
75 # is exponential in $N. If we increase $N too aggressively,
76 # the user will be forced to wait a very long time.
77 } else {
484fdf61 78 $N++;
899dc88a 79 }
a0cb3900
JH
80}
81
82print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n";
899dc88a 83print "# Total calls: $COUNT.\n";
a0cb3900
JH
84
85&memoize('fib');
86
87$COUNT=0;
484fdf61
JH
88$start = time;
89$RESULT2 = fib($N);
90$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
a0cb3900
JH
91print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
92# If it's not ten times as fast, something is seriously wrong.
f0206e81 93print "# ELAPSED2=$ELAPSED2 seconds.\n";
484fdf61 94print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n");
f0206e81 95
a0cb3900
JH
96# If it called the function more than $N times, it wasn't memoized properly
97print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
98
99# Do it again. Should be even faster this time.
899dc88a 100$COUNT = 0;
a0cb3900
JH
101$start = time;
102$RESULT2 = fib($N);
484fdf61 103$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
a0cb3900 104print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
f0206e81 105print "# ELAPSED2=$ELAPSED2 seconds.\n";
484fdf61 106print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
a0cb3900 107# This time it shouldn't have called the function at all.
899dc88a 108print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");