1N/A#!/usr/bin/perl
1N/A
1N/Ause lib '..';
1N/Ause Memoize;
1N/A
1N/Aif (-e '.fast') {
1N/A print "1..0\n";
1N/A exit 0;
1N/A}
1N/A$| = 1;
1N/A
1N/A# If we don't say anything, maybe nobody will notice.
1N/A# print STDERR "\nWarning: I'm testing the speedup. This might take up to thirty seconds.\n ";
1N/A
1N/Amy $COARSE_TIME = 1;
1N/A
1N/Asub times_to_time { my ($u) = times; $u; }
1N/Aif ($^O eq 'riscos') {
1N/A eval {require Time::HiRes; *my_time = \&Time::HiRes::time };
1N/A if ($@) { *my_time = sub { time }; $COARSE_TIME = 1 }
1N/A} else {
1N/A *my_time = \&times_to_time;
1N/A}
1N/A
1N/A
1N/Aprint "1..6\n";
1N/A
1N/A
1N/A
1N/A# This next test finds an example that takes a long time to run, then
1N/A# checks to make sure that the run is actually speeded up by memoization.
1N/A# In some sense, this is the most essential correctness test in the package.
1N/A#
1N/A# We do this by running the fib() function with successfily larger
1N/A# arguments until we find one that tales at least $LONG_RUN seconds
1N/A# to execute. Then we memoize fib() and run the same call cagain. If
1N/A# it doesn't produce the same test in less than one-tenth the time,
1N/A# something is seriously wrong.
1N/A#
1N/A# $LONG_RUN is the number of seconds that the function call must last
1N/A# in order for the call to be considered sufficiently long.
1N/A
1N/A
1N/Asub fib {
1N/A my $n = shift;
1N/A $COUNT++;
1N/A return $n if $n < 2;
1N/A fib($n-1) + fib($n-2);
1N/A}
1N/A
1N/Asub max { $_[0] > $_[1] ?
1N/A $_[0] : $_[1]
1N/A }
1N/A
1N/A$N = 1;
1N/A
1N/A$ELAPSED = 0;
1N/A
1N/Amy $LONG_RUN = 10;
1N/A
1N/Awhile (1) {
1N/A my $start = time;
1N/A $COUNT=0;
1N/A $RESULT = fib($N);
1N/A $ELAPSED = time - $start;
1N/A last if $ELAPSED >= $LONG_RUN;
1N/A if ($ELAPSED > 1) {
1N/A print "# fib($N) took $ELAPSED seconds.\n" if $N % 1 == 0;
1N/A # we'd expect that fib(n+1) takes about 1.618 times as long as fib(n)
1N/A # so now that we have a longish run, let's estimate the value of $N
1N/A # that will get us a sufficiently long run.
1N/A $N += 1 + int(log($LONG_RUN/$ELAPSED)/log(1.618));
1N/A print "# OK, N=$N ought to do it.\n";
1N/A # It's important not to overshoot here because the running time
1N/A # is exponential in $N. If we increase $N too aggressively,
1N/A # the user will be forced to wait a very long time.
1N/A } else {
1N/A $N++;
1N/A }
1N/A}
1N/A
1N/Aprint "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n";
1N/Aprint "# Total calls: $COUNT.\n";
1N/A
1N/A&memoize('fib');
1N/A
1N/A$COUNT=0;
1N/A$start = time;
1N/A$RESULT2 = fib($N);
1N/A$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
1N/A
1N/Aprint (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
1N/A# If it's not ten times as fast, something is seriously wrong.
1N/Aprint (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n");
1N/A# If it called the function more than $N times, it wasn't memoized properly
1N/Aprint (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
1N/A
1N/A# Do it again. Should be even faster this time.
1N/A$COUNT = 0;
1N/A$start = time;
1N/A$RESULT2 = fib($N);
1N/A$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
1N/A
1N/Aprint (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
1N/Aprint (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
1N/A# This time it shouldn't have called the function at all.
1N/Aprint ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");