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 = 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 $start = time;
  89 $RESULT2 = fib($N);
  90 $ELAPSED2 = time - $start + .001; # 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\n" : "not ok 2\n");
  95 # If it called the function more than $N times, it wasn't memoized properly
  96 print (($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
 104 print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
 105 print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
 106 # This time it shouldn't have called the function at all.
 107 print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");