10 # A function that should only be called once.
22 print (($c1 == 11) ? "ok 1\n" : "not ok 1\n");
24 print (($c2 == 11) ? "ok 2\n" : "not ok 2\n");
25 print $FAIL ? "not ok 3\n" : "ok 3\n"; # Was it really memoized?
28 $f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 12 } };
32 print (($c1 == 12) ? "ok 4\n" : "not ok 4\n");
34 print (($c2 == 12) ? "ok 5\n" : "not ok 5\n");
35 print $FAIL ? "not ok 6\n" : "ok 6\n"; # Was it really memoized?
37 $f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 13 } };
38 $fm = memoize($f, INSTALL => 'another');
40 $c1 = &another(); # Was it really installed?
41 print (($c1 == 13) ? "ok 7\n" : "not ok 7\n");
43 print (($c2 == 13) ? "ok 8\n" : "not ok 8\n");
44 print $FAIL ? "not ok 9\n" : "ok 9\n"; # Was it really memoized?
45 $c3 = &$fm(); # Call memoized version through returned ref
46 print (($c3 == 13) ? "ok 10\n" : "not ok 10\n");
47 print $FAIL ? "not ok 11\n" : "ok 11\n"; # Was it really memoized?
48 $c4 = &$f(); # Call original version again
49 print (($c4 == 13) ? "ok 12\n" : "not ok 12\n");
50 print $FAIL ? "ok 13\n" : "not ok 13\n"; # Did we get the original?
52 print "# Fibonacci\n";
57 mt1($n-1) + mt2($n-2);
62 mt1($n-1) + mt2($n-2);
65 @f1 = map { mt1($_) } (0 .. 15);
66 @f2 = map { mt2($_) } (0 .. 15);
68 @f3 = map { mt1($_) } (0 .. 15);
69 @f4 = map { mt1($_) } (0 .. 15);
70 @arrays = (\@f1, \@f2, \@f3, \@f4);
72 for ($i=0; $i<3; $i++) {
73 for ($j=$i+1; $j<3; $j++) {
75 print ((@{$arrays[$i]} == @{$arrays[$j]}) ? "ok $n\n" : "not ok $n\n");
77 for ($k=0; $k < @{$arrays[$i]}; $k++) {
78 (print "not ok $n\n", next) if $arrays[$i][$k] != $arrays[$j][$k];
86 print "# Normalizers\n";
102 &memoize('f2', NORMALIZER => 'fake_normalize');
103 &memoize('f3', NORMALIZER => \&fake_normalize);
104 @f1r = map { f1($_) } (1 .. 10);
105 @f2r = map { f2($_) } (1 .. 10);
106 @f3r = map { f3($_) } (1 .. 10);
108 print (("@f1r" eq "1 2 3 4 5 6 7 8 9 10") ? "ok $n\n" : "not ok $n\n");
110 print (("@f2r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
112 print (("@f3r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
114 print "# INSTALL => undef option.\n";
118 my $um = memoize('u1', INSTALL => undef);
119 @umr = (&$um, &$um, &$um);
120 @u1r = (&u1, &u1, &u1 ); # Did *not* clobber &u1
122 print (("@umr" eq "1 1 1") ? "ok $n\n" : "not ok $n\n"); # Increment once
124 print (("@u1r" eq "2 3 4") ? "ok $n\n" : "not ok $n\n"); # Increment thrice
126 print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case
128 print "# $n tests in all.\n";