lib/Memoize/t/correctness.t

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