Commit | Line | Data |
---|---|---|

a0cb3900 JH |
1 | #!/usr/bin/perl |

2 | ||

484fdf61 | 3 | use lib '..'; |

a0cb3900 JH |
4 | use Memoize; |

5 | ||

6 | if (-e '.fast') { | |

7 | print "1..0\n"; | |

8 | exit 0; | |

9 | } | |

899dc88a JH |
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 "; | |

a0cb3900 | 14 | |

484fdf61 JH |
15 | my $COARSE_TIME = 1; |

16 | ||

3d4a255c JH |
17 | sub times_to_time { my ($u) = times; $u; } |

18 | if ($^O eq 'riscos') { | |

19 | eval {require Time::HiRes; *my_time = \&Time::HiRes::time }; | |

484fdf61 | 20 | if ($@) { *my_time = sub { time }; $COARSE_TIME = 1 } |

3d4a255c JH |
21 | } else { |

22 | *my_time = \×_to_time; | |

23 | } | |

24 | ||

a0cb3900 JH |
25 | |

26 | print "1..6\n"; | |

27 | ||

3d4a255c JH |
28 | |

29 | ||

899dc88a JH |
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. | |

484fdf61 | 32 | # In some sense, this is the most essential correctness test in the package. |

899dc88a | 33 | # |

484fdf61 JH |
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 | |

899dc88a JH |
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 | ||

a0cb3900 JH |
44 | sub fib { |

45 | my $n = shift; | |

46 | $COUNT++; | |

47 | return $n if $n < 2; | |

48 | fib($n-1) + fib($n-2); | |

49 | } | |

50 | ||

484fdf61 JH |
51 | sub max { $_[0] > $_[1] ? |

52 | $_[0] : $_[1] | |

53 | } | |

54 | ||

55 | $N = 1; | |

a0cb3900 | 56 | |

484fdf61 | 57 | $ELAPSED = 0; |

899dc88a | 58 | |

f0206e81 | 59 | my $LONG_RUN = 11; |

899dc88a JH |
60 | |

61 | while (1) { | |

a0cb3900 JH |
62 | my $start = time; |

63 | $COUNT=0; | |

64 | $RESULT = fib($N); | |

65 | $ELAPSED = time - $start; | |

899dc88a JH |
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 { | |

484fdf61 | 78 | $N++; |

899dc88a | 79 | } |

a0cb3900 JH |
80 | } |

81 | ||

82 | print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n"; | |

899dc88a | 83 | print "# Total calls: $COUNT.\n"; |

a0cb3900 JH |
84 | |

85 | &memoize('fib'); | |

86 | ||

87 | $COUNT=0; | |

484fdf61 JH |
88 | $start = time; |

89 | $RESULT2 = fib($N); | |

90 | $ELAPSED2 = time - $start + .001; # prevent division by 0 errors | |

a0cb3900 JH |
91 | print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n"); |

92 | # If it's not ten times as fast, something is seriously wrong. | |

f0206e81 | 93 | print "# ELAPSED2=$ELAPSED2 seconds.\n"; |

484fdf61 | 94 | print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n"); |

f0206e81 | 95 | |

a0cb3900 JH |
96 | # If it called the function more than $N times, it wasn't memoized properly |

97 | print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n"); | |

98 | ||

99 | # Do it again. Should be even faster this time. | |

899dc88a | 100 | $COUNT = 0; |

a0cb3900 JH |
101 | $start = time; |

102 | $RESULT2 = fib($N); | |

484fdf61 | 103 | $ELAPSED2 = time - $start + .001; # prevent division by 0 errors |

a0cb3900 | 104 | print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n"); |

f0206e81 | 105 | print "# ELAPSED2=$ELAPSED2 seconds.\n"; |

484fdf61 | 106 | print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n"); |

a0cb3900 | 107 | # This time it shouldn't have called the function at all. |

899dc88a | 108 | print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n"); |