lib/Memoize/t/speed.t

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