lib/Memoize/t/expire.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   4 use Memoize;
   5 use Memoize::ExpireTest;
   6
   7 my $n = 0;
   8
   9 print "1..17\n";
  10
  11 $n++; print "ok $n\n";
  12
  13 my %CALLS;
  14 sub id {
  15   my($arg) = @_;
  16   ++$CALLS{$arg};
  17   $arg;
  18 }
  19
  20 memoize 'id', SCALAR_CACHE => ['TIE', 'Memoize::ExpireTest'],
  21   LIST_CACHE => 'FAULT';
  22 $n++; print "ok $n\n";
  23
  24 for $i (1, 2, 3, 1, 2, 1) {
  25   $n++;
  26   unless ($i == id($i)) {
  27     print "not ";
  28   }
  29   print "ok $n\n";
  30 }
  31
  32 for $i (1, 2, 3) {
  33   $n++;
  34   unless ($CALLS{$i} == 1) {
  35     print "not ";
  36   }
  37   print "ok $n\n";
  38 }
  39
  40 Memoize::ExpireTest::expire(1);
  41
  42 for $i (1, 2, 3) {
  43   my $v = id($i);
  44 }
  45
  46 for $i (1, 2, 3) {
  47   $n++;
  48   unless ($CALLS{$i} == 1 + ($i == 1)) {
  49     print "not ";
  50   }
  51   print "ok $n\n";
  52 }
  53
  54 Memoize::ExpireTest::expire(1);
  55 Memoize::ExpireTest::expire(2);
  56
  57 for $i (1, 2, 3) {
  58   my $v = id($i);
  59 }
  60
  61 for $i (1, 2, 3) {
  62   $n++;
  63   unless ($CALLS{$i} == 4 - $i) {
  64     print "not ";
  65   }
  66   print "ok $n\n";
  67 }
  68
  69 exit 0;
  70