1 files changed, 129 insertions, 0 deletions
diff --git a/lib/Memoize/t/correctness.t b/lib/Memoize/t/correctness.t
new file mode 100755
index 0000000000..ae56787255
--- /dev/null
+++ b/lib/Memoize/t/correctness.t
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize;
+
+print "1..25\n";
+
+print "# Basic\n";
+
+# A function that should only be called once.
+{ my $COUNT = 0;
+  sub no_args {	
+    $FAIL++ if $COUNT++;
+    11;
+  }
+}
+
+# 
+memoize('no_args');
+
+$c1 = &no_args();
+print (($c1 == 11) ? "ok 1\n" : "not ok 1\n");
+$c2 = &no_args();
+print (($c2 == 11) ? "ok 2\n" : "not ok 2\n");
+print $FAIL ? "not ok 3\n" : "ok 3\n";	# Was it really memoized?
+
+$FAIL = 0;
+$f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 12 } };
+$fm = memoize($f);
+
+$c1 = &$fm();
+print (($c1 == 12) ? "ok 4\n" : "not ok 4\n");
+$c2 = &$fm();
+print (($c2 == 12) ? "ok 5\n" : "not ok 5\n");
+print $FAIL ? "not ok 6\n" : "ok 6\n";	# Was it really memoized?
+
+$f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 13 } };
+$fm = memoize($f, INSTALL => 'another');
+
+$c1 = &another();  # Was it really installed?
+print (($c1 == 13) ? "ok 7\n" : "not ok 7\n");
+$c2 = &another();  
+print (($c2 == 13) ? "ok 8\n" : "not ok 8\n");
+print $FAIL ? "not ok 9\n" : "ok 9\n";	# Was it really memoized?
+$c3 = &$fm();			# Call memoized version through returned ref
+print (($c3 == 13) ? "ok 10\n" : "not ok 10\n");
+print $FAIL ? "not ok 11\n" : "ok 11\n";	# Was it really memoized?
+$c4 = &$f();			# Call original version again
+print (($c4 == 13) ? "ok 12\n" : "not ok 12\n");
+print $FAIL ? "ok 13\n" : "not ok 13\n";	# Did we get the original?
+
+print "# Fibonacci\n";
+
+sub mt1 {			# Fibonacci
+  my $n = shift;
+  return $n if $n < 2;
+  mt1($n-1) + mt2($n-2);
+}
+sub mt2 {		
+  my $n = shift;
+  return $n if $n < 2;
+  mt1($n-1) + mt2($n-2);
+}
+
+@f1 = map { mt1($_) } (0 .. 15);
+@f2 = map { mt2($_) } (0 .. 15);
+memoize('mt1');
+@f3 = map { mt1($_) } (0 .. 15);
+@f4 = map { mt1($_) } (0 .. 15);
+@arrays = (\@f1, \@f2, \@f3, \@f4); 
+$n = 13;
+for ($i=0; $i<3; $i++) {
+  for ($j=$i+1; $j<3; $j++) {
+    $n++;
+    print ((@{$arrays[$i]} == @{$arrays[$j]}) ? "ok $n\n" : "not ok $n\n");
+    $n++;
+    for ($k=0; $k < @{$arrays[$i]}; $k++) {
+      (print "not ok $n\n", next)  if $arrays[$i][$k] != $arrays[$j][$k];
+    }
+    print "ok $n\n";
+  }
+}
+
+
+
+print "# Normalizers\n";
+
+sub fake_normalize {
+  return '';
+}
+
+sub f1 {
+  return shift;
+}
+sub f2 {
+  return shift;
+}
+sub f3 {
+  return shift;
+}
+&memoize('f1');
+&memoize('f2', NORMALIZER => 'fake_normalize');
+&memoize('f3', NORMALIZER => \&fake_normalize);
+@f1r = map { f1($_) } (1 .. 10);
+@f2r = map { f2($_) } (1 .. 10);
+@f3r = map { f3($_) } (1 .. 10);
+$n++;
+print (("@f1r" eq "1 2 3 4 5 6 7 8 9 10") ? "ok $n\n" : "not ok $n\n");
+$n++;
+print (("@f2r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
+$n++;
+print (("@f3r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
+
+print "# INSTALL => undef option.\n";
+{ my $i = 1;
+  sub u1 { $i++ }
+}
+my $um = memoize('u1', INSTALL => undef);
+@umr = (&$um, &$um, &$um);
+@u1r = (&u1,  &u1,  &u1 );	# Did *not* clobber &u1
+$n++;
+print (("@umr" eq "1 1 1") ? "ok $n\n" : "not ok $n\n"); # Increment once
+$n++;
+print (("@u1r" eq "2 3 4") ? "ok $n\n" : "not ok $n\n"); # Increment thrice
+$n++;
+print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case
+
+print "# $n tests in all.\n";
+