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 use strict;
   9 our $COUNT;
  10 our $RESULT;
  11
  12 if (-e '.fast') {
  13   print "1..0\n";
  14   exit 0;
  15 }
  16 $| = 1;
  17
  18 # If we don't say anything, maybe nobody will notice.
  19 # print STDERR "\nWarning: I'm testing the speedup.  This might take up to thirty seconds.\n                    ";
  20
  21 sub times_to_time { my ($u) = times; $u; }
  22 if ($^O eq 'riscos') {
  23   eval {require Time::HiRes; *my_time = \&Time::HiRes::time };
  24   if ($@) { *my_time = sub { time }; }
  25 } else {
  26   *my_time = \&times_to_time;
  27 }
  28
  29
  30 print "1..6\n";
  31
  32
  33
  34 # This next test finds an example that takes a long time to run, then
  35 # checks to make sure that the run is actually speeded up by memoization.
  36 # In some sense, this is the most essential correctness test in the package.
  37 #
  38 # We do this by running the fib() function with successively larger
  39 # arguments until we find one that takes at least $LONG_RUN seconds
  40 # to execute.  Then we memoize fib() and run the same call cagain.  If
  41 # it doesn't produce the same test in less than one-tenth the time,
  42 # something is seriously wrong.
  43 #
  44 # $LONG_RUN is the number of seconds that the function call must last
  45 # in order for the call to be considered sufficiently long.
  46
  47
  48 sub fib {
  49   my $n = shift;
  50   $COUNT++;
  51   return $n if $n < 2;
  52   fib($n-1) + fib($n-2);
  53 }
  54
  55 our $N = 1;
  56
  57 our $ELAPSED = 0;
  58
  59 my $LONG_RUN = 10;
  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 my $start = time;
  89 our $RESULT2 = fib($N);
  90 our $ELAPSED2 = (time - $start) || 1; # prevent division by 0 errors
  91
  92 print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
  93 # If it's not ten times as fast, something is seriously wrong.
  94 print (($ELAPSED/$ELAPSED2 >= 10) ? "ok 2 - ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]\n"
  95        : "#
  96 # COUNT[$COUNT] N[$N] ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]
  97 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) || 1; # prevent division by 0 errors
 106
 107 print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
 108 print (($ELAPSED/$ELAPSED2 >= 10) ? "ok 5 - ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]\n"
 109        : "not ok 5\n");
 110 # This time it shouldn't have called the function at all.
 111 print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");