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
1 #!/usr/bin/perl
2
3 use lib '..';
4 use Memoize;
5
6 if (-e '.fast') {
7   print "1..0\n";
8   exit 0;
9 }
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                    ";
14
15 my $COARSE_TIME = 1;
16
17 sub times_to_time { my ($u) = times; $u; }
18 if ($^O eq 'riscos') {
19   eval {require Time::HiRes; *my_time = \&Time::HiRes::time };
20   if ($@) { *my_time = sub { time }; $COARSE_TIME = 1 }
21 } else {
22   *my_time = \&times_to_time;
23 }
24
25
26 print "1..6\n";
27
28
29
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.
32 # In some sense, this is the most essential correctness test in the package.  
33 #
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
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
44 sub fib {
45   my $n = shift;
46   $COUNT++;
47   return $n if $n < 2;
48   fib($n-1) + fib($n-2);
49 }
50
51 sub max { $_[0] > $_[1] ? 
52           $_[0] : $_[1] 
53         }
54
55 $N = 1;
56
57 $ELAPSED = 0;
58
59 my $LONG_RUN = 11;
60
61 while (1) {
62   my $start = time;
63   $COUNT=0;
64   $RESULT = fib($N);
65   $ELAPSED = time - $start;
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 {
78       $N++; 
79   }
80 }
81
82 print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n";
83 print "# Total calls: $COUNT.\n";
84
85 &memoize('fib');
86
87 $COUNT=0;
88 $start = time;
89 $RESULT2 = fib($N);
90 $ELAPSED2 = time - $start + .001; # prevent division by 0 errors
91 print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
92 # If it's not ten times as fast, something is seriously wrong.
93 print "# ELAPSED2=$ELAPSED2 seconds.\n";
94 print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n");
95
96 # If it called the function more than $N times, it wasn't memoized properly
97 print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
98
99 # Do it again. Should be even faster this time.
100 $COUNT = 0;
101 $start = time;
102 $RESULT2 = fib($N);
103 $ELAPSED2 = time - $start + .001; # prevent division by 0 errors
104 print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
105 print "# ELAPSED2=$ELAPSED2 seconds.\n";
106 print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
107 # This time it shouldn't have called the function at all.
108 print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");