lib/Memoize/t/expire_module_t.t

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