1#!/usr/bin/perl 2 3use lib '..'; 4use Memoize; 5 6print "1..25\n"; 7 8print "# 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# 19memoize('no_args'); 20 21$c1 = &no_args(); 22print (($c1 == 11) ? "ok 1\n" : "not ok 1\n"); 23$c2 = &no_args(); 24print (($c2 == 11) ? "ok 2\n" : "not ok 2\n"); 25print $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(); 32print (($c1 == 12) ? "ok 4\n" : "not ok 4\n"); 33$c2 = &$fm(); 34print (($c2 == 12) ? "ok 5\n" : "not ok 5\n"); 35print $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? 41print (($c1 == 13) ? "ok 7\n" : "not ok 7\n"); 42$c2 = &another(); 43print (($c2 == 13) ? "ok 8\n" : "not ok 8\n"); 44print $FAIL ? "not ok 9\n" : "ok 9\n"; # Was it really memoized? 45$c3 = &$fm(); # Call memoized version through returned ref 46print (($c3 == 13) ? "ok 10\n" : "not ok 10\n"); 47print $FAIL ? "not ok 11\n" : "ok 11\n"; # Was it really memoized? 48$c4 = &$f(); # Call original version again 49print (($c4 == 13) ? "ok 12\n" : "not ok 12\n"); 50print $FAIL ? "ok 13\n" : "not ok 13\n"; # Did we get the original? 51 52print "# Fibonacci\n"; 53 54sub mt1 { # Fibonacci 55 my $n = shift; 56 return $n if $n < 2; 57 mt1($n-1) + mt2($n-2); 58} 59sub 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); 67memoize('mt1'); 68@f3 = map { mt1($_) } (0 .. 15); 69@f4 = map { mt1($_) } (0 .. 15); 70@arrays = (\@f1, \@f2, \@f3, \@f4); 71$n = 13; 72for ($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 86print "# Normalizers\n"; 87 88sub fake_normalize { 89 return ''; 90} 91 92sub f1 { 93 return shift; 94} 95sub f2 { 96 return shift; 97} 98sub 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++; 108print (("@f1r" eq "1 2 3 4 5 6 7 8 9 10") ? "ok $n\n" : "not ok $n\n"); 109$n++; 110print (("@f2r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n"); 111$n++; 112print (("@f3r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n"); 113 114print "# INSTALL => undef option.\n"; 115{ my $i = 1; 116 sub u1 { $i++ } 117} 118my $um = memoize('u1', INSTALL => undef); 119@umr = (&$um, &$um, &$um); 120@u1r = (&u1, &u1, &u1 ); # Did *not* clobber &u1 121$n++; 122print (("@umr" eq "1 1 1") ? "ok $n\n" : "not ok $n\n"); # Increment once 123$n++; 124print (("@u1r" eq "2 3 4") ? "ok $n\n" : "not ok $n\n"); # Increment thrice 125$n++; 126print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case 127 128print "# $n tests in all.\n"; 129 130