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