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