lib/Memoize/t/expmod_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 # (1)
  31 ++$n; print "ok $n\n";
  32
  33 # (2)
  34 require Memoize::Expire;
  35 ++$n; print "ok $n\n";
  36
  37 sub close_enough {
  38 #  print "Close enough? @_[0,1]\n";
  39   abs($_[0] - $_[1]) <= 2;
  40 }
  41
  42 sub very_close {
  43 #  print "Close enough? @_[0,1]\n";
  44   abs($_[0] - $_[1]) <= 0.01;
  45 }
  46
  47 my $t0;
  48 sub start_timer {
  49   $t0 = time;
  50   $DEBUG and print "# $t0\n";
  51 }
  52
  53 sub wait_until {
  54   my $until = shift();
  55   my $diff = $until - (time() - $t0);
  56   $DEBUG and print "# until $until; diff = $diff\n";
  57   return if $diff <= 0;
  58   select undef, undef, undef, $diff;
  59 }
  60
  61 sub now {
  62 #  print "NOW: @_ ", time(), "\n";
  63   time;
  64 }
  65
  66 tie my %cache => 'Memoize::Expire', LIFETIME => 15;
  67 memoize 'now',
  68     SCALAR_CACHE => [HASH => \%cache ],
  69     LIST_CACHE => 'FAULT'
  70     ;
  71
  72 # (3)
  73 ++$n; print "ok $n\n";
  74
  75
  76 # (4-6)
  77 # T
  78 start_timer();
  79 for (1,2,3) {
  80   $when{$_} = now($_);
  81   ++$n;
  82   print "not " unless close_enough($when{$_}, time());
  83   print "ok $n\n";
  84   sleep 6 if $_ < 3;
  85   $DEBUG and print "# ", time()-$t0, "\n";
  86 }
  87 # values will now expire at T=15, 21, 27
  88 # it is now T=12
  89
  90 # T+12
  91 for (1,2,3) {
  92   $again{$_} = now($_); # Should be the same as before, because of memoization
  93 }
  94
  95 # (7-9)
  96 # T+12
  97 foreach (1,2,3) {
  98   ++$n;
  99   if (very_close($when{$_}, $again{$_})) {
 100     print "ok $n\n";
 101   } else {
 102     print "not ok $n # expected $when{$_}, got $again{$_}\n";
 103   }
 104 }
 105
 106 # (10)
 107 wait_until(18);  # now(1) expires
 108 print "not " unless close_enough(time, $again{1} = now(1));
 109 ++$n; print "ok $n\n";
 110
 111 # (11-12)
 112 # T+18
 113 foreach (2,3) {                 # Should not have expired yet.
 114   ++$n;
 115   print "not " unless now($_) == $again{$_};
 116   print "ok $n\n";
 117 }
 118
 119 wait_until(24);  # now(2) expires
 120
 121 # (13)
 122 # T+24
 123 print "not " unless close_enough(time, $again{2} = now(2));
 124 ++$n; print "ok $n\n";
 125
 126 # (14-15)
 127 # T+24
 128 foreach (1,3) {  # 1 is good again because it was recomputed after it expired
 129   ++$n;
 130   if (very_close(scalar(now($_)), $again{$_})) {
 131     print "ok $n\n";
 132   } else {
 133     print "not ok $n # expected $when{$_}, got $again{$_}\n";
 134   }
 135 }
 136