lib/Memoize/t/expire_module_t.t

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