Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
484fdf61 |
3 | use lib '..'; |
a0cb3900 |
4 | use Memoize; |
5 | |
6 | print "1..25\n"; |
7 | |
8 | print "# Basic\n"; |
9 | |
10 | # A function that should only be called once. |
11 | { my $COUNT = 0; |
12 | sub no_args { |
13 | $FAIL++ if $COUNT++; |
14 | 11; |
15 | } |
16 | } |
17 | |
18 | # |
19 | memoize('no_args'); |
20 | |
21 | $c1 = &no_args(); |
22 | print (($c1 == 11) ? "ok 1\n" : "not ok 1\n"); |
23 | $c2 = &no_args(); |
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? |
26 | |
27 | $FAIL = 0; |
28 | $f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 12 } }; |
29 | $fm = memoize($f); |
30 | |
31 | $c1 = &$fm(); |
32 | print (($c1 == 12) ? "ok 4\n" : "not ok 4\n"); |
33 | $c2 = &$fm(); |
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? |
36 | |
37 | $f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 13 } }; |
38 | $fm = memoize($f, INSTALL => 'another'); |
39 | |
40 | $c1 = &another(); # Was it really installed? |
41 | print (($c1 == 13) ? "ok 7\n" : "not ok 7\n"); |
42 | $c2 = &another(); |
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? |
51 | |
52 | print "# Fibonacci\n"; |
53 | |
54 | sub mt1 { # Fibonacci |
55 | my $n = shift; |
56 | return $n if $n < 2; |
57 | mt1($n-1) + mt2($n-2); |
58 | } |
59 | sub mt2 { |
60 | my $n = shift; |
61 | return $n if $n < 2; |
62 | mt1($n-1) + mt2($n-2); |
63 | } |
64 | |
65 | @f1 = map { mt1($_) } (0 .. 15); |
66 | @f2 = map { mt2($_) } (0 .. 15); |
67 | memoize('mt1'); |
68 | @f3 = map { mt1($_) } (0 .. 15); |
69 | @f4 = map { mt1($_) } (0 .. 15); |
70 | @arrays = (\@f1, \@f2, \@f3, \@f4); |
71 | $n = 13; |
72 | for ($i=0; $i<3; $i++) { |
73 | for ($j=$i+1; $j<3; $j++) { |
74 | $n++; |
75 | print ((@{$arrays[$i]} == @{$arrays[$j]}) ? "ok $n\n" : "not ok $n\n"); |
76 | $n++; |
77 | for ($k=0; $k < @{$arrays[$i]}; $k++) { |
78 | (print "not ok $n\n", next) if $arrays[$i][$k] != $arrays[$j][$k]; |
79 | } |
80 | print "ok $n\n"; |
81 | } |
82 | } |
83 | |
84 | |
85 | |
86 | print "# Normalizers\n"; |
87 | |
88 | sub fake_normalize { |
89 | return ''; |
90 | } |
91 | |
92 | sub f1 { |
93 | return shift; |
94 | } |
95 | sub f2 { |
96 | return shift; |
97 | } |
98 | sub f3 { |
99 | return shift; |
100 | } |
101 | &memoize('f1'); |
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); |
107 | $n++; |
108 | print (("@f1r" eq "1 2 3 4 5 6 7 8 9 10") ? "ok $n\n" : "not ok $n\n"); |
109 | $n++; |
110 | print (("@f2r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n"); |
111 | $n++; |
112 | print (("@f3r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n"); |
113 | |
114 | print "# INSTALL => undef option.\n"; |
115 | { my $i = 1; |
116 | sub u1 { $i++ } |
117 | } |
118 | my $um = memoize('u1', INSTALL => undef); |
119 | @umr = (&$um, &$um, &$um); |
120 | @u1r = (&u1, &u1, &u1 ); # Did *not* clobber &u1 |
121 | $n++; |
122 | print (("@umr" eq "1 1 1") ? "ok $n\n" : "not ok $n\n"); # Increment once |
123 | $n++; |
124 | print (("@u1r" eq "2 3 4") ? "ok $n\n" : "not ok $n\n"); # Increment thrice |
125 | $n++; |
126 | print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case |
127 | |
128 | print "# $n tests in all.\n"; |
129 | |