1use strict; use warnings; 2use Memoize; 3use Memoize::Expire; 4 5my $DEBUG = 0; 6my $LIFETIME = 15; 7 8my $test = 0; 9$| = 1; 10 11if ($ENV{PERL_MEMOIZE_TESTS_FAST_ONLY}) { 12 print "1..0 # Skipped: Slow tests disabled\n"; 13 exit 0; 14} 15 16print "# Testing the timed expiration policy.\n"; 17print "# This will take about thirty seconds.\n"; 18 19print "1..24\n"; 20 21tie my %cache => 'Memoize::Expire', LIFETIME => $LIFETIME; 22memoize sub { time }, 23 SCALAR_CACHE => [ HASH => \%cache ], 24 LIST_CACHE => 'FAULT', 25 INSTALL => 'now'; 26 27my (@before, @after, @now); 28 29# Once a second call now(), with three varying indices. Record when 30# (within a range) it was called last, and depending on the value returned 31# on the next call with the same index, decide whether it correctly 32# returned the old value or expired the cache entry. 33 34for my $iteration (0..($LIFETIME/2)) { 35 for my $i (0..2) { 36 my $before = time; 37 my $now = now($i); 38 my $after = time; 39 40 # the time returned by now() should either straddle the 41 # current time range, or if it returns a cached value, the 42 # time range of the previous time it was called. 43 # $before..$after represents the time range within which now() must have 44 # been called. On very slow platforms, $after - $before may be > 1. 45 46 my $in_range0 = !$iteration || ($before[$i] <= $now && $now <= $after[$i]); 47 my $in_range1 = ($before <= $now && $now <= $after); 48 49 my $ok; 50 if ($iteration) { 51 if ($in_range0) { 52 if ($in_range1) { 53 $ok = 0; # this should never happen 54 } 55 else { 56 # cached value, so cache shouldn't have expired 57 $ok = $after[$i] + $LIFETIME >= $before && $now[$i] == $now; 58 } 59 } 60 else { 61 if ($in_range1) { 62 # not cached value, so any cache should have have expired 63 $ok = $before[$i] + $LIFETIME <= $after && $now[$i] != $now; 64 } 65 else { 66 # not in any range; caching broken 67 $ok = 0; 68 } 69 } 70 } 71 else { 72 $ok = $in_range1; 73 } 74 75 $test++; 76 print "not " unless $ok; 77 print "ok $test - $iteration:$i\n"; 78 if (!$ok || $DEBUG) { 79 print STDERR sprintf 80 "expmod_t.t: %d:%d: r0=%d r1=%d prev=(%s..%s) cur=(%s..%s) now=(%s,%s)\n", 81 $iteration, $i, $in_range0, $in_range1, 82 $before[$i]||-1, $after[$i]||-1, $before, $after, $now[$i]||-1, $now; 83 } 84 85 if (!defined($now[$i]) || $now[$i] != $now) { 86 # cache expired; record value of new cache 87 $before[$i] = $before; 88 $after[$i] = $after; 89 $now[$i] = $now; 90 } 91 92 sleep 1; 93 } 94} 95