cpan/Memoize/t/correctness.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   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