lib/Memoize/t/expire_module_t.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   4 use Memoize;
   5 BEGIN {
   6   eval {require Time::HiRes};
   7   if ($@ || $ENV{SLOW}) {
   8 #    $SLOW_TESTS = 1;
   9   } else {
  10     'Time::HiRes'->import('time');
  11   }
  12 }
  13
  14 my $DEBUG = 0;
  15
  16 my $n = 0;
  17 $| = 1;
  18
  19 if (-e '.fast') {
  20   print "1..0\n";
  21   exit 0;
  22 }
  23
  24 # Perhaps nobody will notice if we don't say anything
  25 # print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
  26
  27 print "1..15\n";
  28 $| = 1;
  29
  30 ++$n; print "ok $n\n";
  31
  32 require Memoize::Expire;
  33 ++$n; print "ok $n\n";
  34
  35 sub close_enough {
  36 #  print "Close enough? @_[0,1]\n";
  37   abs($_[0] - $_[1]) <= 1;
  38 }
  39
  40 my $t0;
  41 sub start_timer {
  42   $t0 = time;
  43   $DEBUG and print "# $t0\n";
  44 }
  45
  46 sub wait_until {
  47   my $until = shift();
  48   my $diff = $until - (time() - $t0);
  49   $DEBUG and print "# until $until; diff = $diff\n";
  50   return if $diff <= 0;
  51   select undef, undef, undef, $diff;
  52 }
  53
  54 sub now {
  55 #  print "NOW: @_ ", time(), "\n";
  56   time;
  57 }
  58
  59 tie my %cache => 'Memoize::Expire', LIFETIME => 10;
  60 memoize 'now',
  61     SCALAR_CACHE => [HASH => \%cache ],
  62     LIST_CACHE => 'FAULT'
  63     ;
  64
  65 ++$n; print "ok $n\n";
  66
  67
  68 # T
  69 start_timer();
  70 for (1,2,3) {
  71   $when{$_} = now($_);
  72   ++$n;
  73   print "not " unless close_enough($when{$_}, time());
  74   print "ok $n\n";
  75   sleep 4 if $_ < 3;
  76   $DEBUG and print "# ", time()-$t0, "\n";
  77 }
  78 # values will now expire at T=10, 14, 18
  79 # it is now T=8
  80
  81 # T+8
  82 for (1,2,3) {
  83   $again{$_} = now($_); # Should be the same as before, because of memoization
  84 }
  85
  86 # T+8
  87 foreach (1,2,3) {
  88   ++$n;
  89   print "not " unless close_enough($when{$_}, $again{$_});
  90   print "ok $n\n";
  91 }
  92
  93 wait_until(12);  # now(1) expires
  94 print "not " unless close_enough(time, $again{1} = now(1));
  95 ++$n; print "ok $n\n";
  96
  97 # T+12
  98 foreach (2,3) {                 # Should not have expired yet.
  99   ++$n;
 100   print "not " unless close_enough(scalar(now($_)), $again{$_});
 101   print "ok $n\n";
 102 }
 103
 104 wait_until(16);  # now(2) expires
 105
 106 # T+16
 107 print "not " unless close_enough(time, $again{2} = now(2));
 108 ++$n; print "ok $n\n";
 109
 110 # T+16
 111 foreach (1,3) {  # 1 is good again because it was recomputed after it expired
 112   ++$n;
 113   print "not " unless close_enough(scalar(now($_)), $again{$_});
 114   print "ok $n\n";
 115 }
 116