Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
484fdf61 |
3 | use lib '..'; |
a0cb3900 |
4 | use Memoize; |
5 | |
6 | if (-e '.fast') { |
7 | print "1..0\n"; |
8 | exit 0; |
9 | } |
899dc88a |
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 |
15 | my $COARSE_TIME = 1; |
16 | |
3d4a255c |
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 |
21 | } else { |
22 | *my_time = \×_to_time; |
23 | } |
24 | |
a0cb3900 |
25 | |
26 | print "1..6\n"; |
27 | |
3d4a255c |
28 | |
29 | |
899dc88a |
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 |
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 |
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 |
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 |
51 | sub max { $_[0] > $_[1] ? |
52 | $_[0] : $_[1] |
53 | } |
54 | |
55 | $N = 1; |
a0cb3900 |
56 | |
484fdf61 |
57 | $ELAPSED = 0; |
899dc88a |
58 | |
59 | my $LONG_RUN = 10; |
60 | |
61 | while (1) { |
a0cb3900 |
62 | my $start = time; |
63 | $COUNT=0; |
64 | $RESULT = fib($N); |
65 | $ELAPSED = time - $start; |
899dc88a |
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 |
80 | } |
81 | |
82 | print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n"; |
899dc88a |
83 | print "# Total calls: $COUNT.\n"; |
a0cb3900 |
84 | |
85 | &memoize('fib'); |
86 | |
87 | $COUNT=0; |
484fdf61 |
88 | $start = time; |
89 | $RESULT2 = fib($N); |
90 | $ELAPSED2 = time - $start + .001; # prevent division by 0 errors |
a0cb3900 |
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. |
484fdf61 |
94 | print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n"); |
a0cb3900 |
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. |
899dc88a |
99 | $COUNT = 0; |
a0cb3900 |
100 | $start = time; |
101 | $RESULT2 = fib($N); |
484fdf61 |
102 | $ELAPSED2 = time - $start + .001; # prevent division by 0 errors |
a0cb3900 |
103 | |
a0cb3900 |
104 | print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n"); |
484fdf61 |
105 | print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n"); |
a0cb3900 |
106 | # This time it shouldn't have called the function at all. |
899dc88a |
107 | print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n"); |