lib/Memoize/t/expire_module_t.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   4 use Memoize;
   5
   6 my $n = 0;
   7
   8 if (-e '.fast') {
   9   print "1..0\n";
  10   exit 0;
  11 }
  12
  13 print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
  14
  15 print "1..14\n";
  16
  17 ++$n; print "ok $n\n";
  18
  19 sub close_enough {
  20 #  print "Close enough? @_[0,1]\n";
  21   abs($_[0] - $_[1]) <= 1;
  22 }
  23
  24 sub now {
  25 #  print "NOW: @_ ", time(), "\n";
  26   time;
  27 }
  28
  29 memoize 'now',
  30     SCALAR_CACHE => ['TIE', 'Memoize::Expire', LIFETIME => 15],
  31     LIST_CACHE => 'FAULT'
  32     ;
  33
  34 ++$n; print "ok $n\n";
  35
  36
  37 # T
  38 for (1,2,3) {
  39   $when{$_} = now($_);
  40   ++$n;
  41   print "not " unless $when{$_} == time;
  42   print "ok $n\n";
  43   sleep 5 if $_ < 3;
  44 }
  45
  46 # T+10
  47 for (1,2,3) {
  48   $again{$_} = now($_); # Should be the sameas before, because of memoization
  49 }
  50
  51 # T+10
  52 foreach (1,2,3) {
  53   ++$n;
  54   print "not " unless $when{$_} == $again{$_};
  55   print "ok $n\n";
  56 }
  57
  58 sleep 6;  # now(1) expires
  59
  60 # T+16
  61 print "not " unless close_enough(time, $again{1} = now(1));
  62 ++$n; print "ok $n\n";
  63
  64 # T+16
  65 foreach (2,3) {                 # Have not expired yet.
  66   ++$n;
  67   print "not " unless now($_) == $again{$_};
  68   print "ok $n\n";
  69 }
  70
  71 sleep 6;  # now(2) expires
  72
  73 # T+22
  74 print "not " unless close_enough(time, $again{2} = now(2));
  75 ++$n; print "ok $n\n";
  76
  77 # T+22
  78 foreach (1,3) {
  79   ++$n;
  80   print "not " unless now($_) == $again{$_};
  81   print "ok $n\n";
  82 }
  83
  84