1#!/usr/bin/perl 2 3use lib '..'; 4use Memoize; 5 6if (-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 15my $COARSE_TIME = 1; 16 17sub times_to_time { my ($u) = times; $u; } 18if ($^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 = \×_to_time; 23} 24 25 26print "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 44sub fib { 45 my $n = shift; 46 $COUNT++; 47 return $n if $n < 2; 48 fib($n-1) + fib($n-2); 49} 50 51sub max { $_[0] > $_[1] ? 52 $_[0] : $_[1] 53 } 54 55$N = 1; 56 57$ELAPSED = 0; 58 59my $LONG_RUN = 10; 60 61while (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 82print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n"; 83print "# 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 92print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n"); 93# If it's not ten times as fast, something is seriously wrong. 94print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n"); 95# If it called the function more than $N times, it wasn't memoized properly 96print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n"); 97 98# Do it again. Should be even faster this time. 99$COUNT = 0; 100$start = time; 101$RESULT2 = fib($N); 102$ELAPSED2 = time - $start + .001; # prevent division by 0 errors 103 104print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n"); 105print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n"); 106# This time it shouldn't have called the function at all. 107print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n"); 108