avoid temp file littering in tests

[p5sagit/p5-mst-13.2.git] / lib / Memoize / t / expire_module_t.t

diff --git a/lib/Memoize/t/expire_module_t.t b/lib/Memoize/t/expire_module_t.t
index 22d64e8..7032f65 100644 (file)
--- a/lib/Memoize/t/expire_module_t.t
+++ b/lib/Memoize/t/expire_module_t.t
@@ -2,32 +2,55 @@
 
 use lib '..';
 use Memoize;
+use Time::HiRes 'time';
+my $DEBUG = 0;
 
 my $n = 0;
+$| = 1;
 
 if (-e '.fast') {
   print "1..0\n";
   exit 0;
 }
 
-print "# Warning: I'm testing the timed expiration policy.\nThis will take about thirty seconds.\n";
+# Perhaps nobody will notice if we don't say anything
+# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
 
-print "1..14\n";
+print "1..15\n";
+$| = 1;
 
 ++$n; print "ok $n\n";
 
+require Memoize::Expire;
+++$n; print "ok $n\n";
+
 sub close_enough {
 #  print "Close enough? @_[0,1]\n";
   abs($_[0] - $_[1]) <= 1;
 }
 
+my $t0;
+sub start_timer {
+  $t0 = time;
+  $DEBUG and print "# $t0\n";
+}
+
+sub wait_until {
+  my $until = shift();
+  my $diff = $until - (time() - $t0);
+  $DEBUG and print "# until $until; diff = $diff\n";
+  return if $diff <= 0;
+  select undef, undef, undef, $diff;
+}
+
 sub now {
 #  print "NOW: @_ ", time(), "\n";
   time;
 }
 
+tie my %cache => 'Memoize::Expire', LIFETIME => 8;
 memoize 'now',
-    SCALAR_CACHE => ['TIE', 'Memoize::Expire', LIFETIME => 15],
+    SCALAR_CACHE => [HASH => \%cache ],
     LIST_CACHE => 'FAULT'
     ;
 
@@ -35,50 +58,51 @@ memoize 'now',
 
 
 # T
+start_timer();
 for (1,2,3) {
   $when{$_} = now($_);
   ++$n;
-  print "not " unless $when{$_} == time;
+  print "not " unless close_enough($when{$_}, time());
   print "ok $n\n";
-  sleep 5 if $_ < 3;
+  sleep 3 if $_ < 3;
+  $DEBUG and print "# ", time()-$t0, "\n";
 }
+# values will now expire at T=8, 11, 14
+# it is now T=6
 
-# T+10
+# T+6
 for (1,2,3) {
-  $again{$_} = now($_); # Should be the sameas before, because of memoization
+  $again{$_} = now($_); # Should be the same as before, because of memoization
 }
 
-# T+10
+# T+6
 foreach (1,2,3) {
   ++$n;
-  print "not " unless $when{$_} == $again{$_};
+  print "not " unless close_enough($when{$_}, $again{$_});
   print "ok $n\n";
 }
 
-sleep 6;  # now(1) expires
-
-# T+16 
+wait_until(9.5);  # now(1) expires
 print "not " unless close_enough(time, $again{1} = now(1));
 ++$n; print "ok $n\n";
 
-# T+16 
-foreach (2,3) {                        # Have not expired yet.
+# T+9.5
+foreach (2,3) {                        # Should not have expired yet.
   ++$n;
-  print "not " unless now($_) == $again{$_};
+  print "not " unless close_enough(scalar(now($_)), $again{$_});
   print "ok $n\n";
 }
 
-sleep 6;  # now(2) expires
+wait_until(12.5);  # now(2) expires
 
-# T+22
+# T+12.5
 print "not " unless close_enough(time, $again{2} = now(2));
 ++$n; print "ok $n\n";
 
-# T+22
-foreach (1,3) {
+# T+12.5
+foreach (1,3) {  # 1 is good again because it was recomputed after it expired
   ++$n;
-  print "not " unless now($_) == $again{$_};
+  print "not " unless close_enough(scalar(now($_)), $again{$_});
   print "ok $n\n";
 }
 
-