Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
5189e6fe |
3 | use lib '..'; |
a0cb3900 |
4 | use Memoize; |
3d4a255c |
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 | |
899dc88a |
14 | my $DEBUG = 0; |
a0cb3900 |
15 | |
16 | my $n = 0; |
899dc88a |
17 | $| = 1; |
a0cb3900 |
18 | |
19 | if (-e '.fast') { |
20 | print "1..0\n"; |
21 | exit 0; |
22 | } |
23 | |
899dc88a |
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"; |
a0cb3900 |
26 | |
899dc88a |
27 | print "1..15\n"; |
28 | $| = 1; |
a0cb3900 |
29 | |
484fdf61 |
30 | # (1) |
a0cb3900 |
31 | ++$n; print "ok $n\n"; |
32 | |
484fdf61 |
33 | # (2) |
899dc88a |
34 | require Memoize::Expire; |
35 | ++$n; print "ok $n\n"; |
36 | |
a0cb3900 |
37 | sub close_enough { |
38 | # print "Close enough? @_[0,1]\n"; |
484fdf61 |
39 | abs($_[0] - $_[1]) <= 2; |
40 | } |
41 | |
42 | sub very_close { |
43 | # print "Close enough? @_[0,1]\n"; |
44 | abs($_[0] - $_[1]) <= 0.01; |
a0cb3900 |
45 | } |
46 | |
899dc88a |
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 | |
a0cb3900 |
61 | sub now { |
62 | # print "NOW: @_ ", time(), "\n"; |
63 | time; |
64 | } |
65 | |
484fdf61 |
66 | tie my %cache => 'Memoize::Expire', LIFETIME => 15; |
a0cb3900 |
67 | memoize 'now', |
899dc88a |
68 | SCALAR_CACHE => [HASH => \%cache ], |
a0cb3900 |
69 | LIST_CACHE => 'FAULT' |
70 | ; |
71 | |
484fdf61 |
72 | # (3) |
a0cb3900 |
73 | ++$n; print "ok $n\n"; |
74 | |
75 | |
484fdf61 |
76 | # (4-6) |
a0cb3900 |
77 | # T |
899dc88a |
78 | start_timer(); |
a0cb3900 |
79 | for (1,2,3) { |
80 | $when{$_} = now($_); |
81 | ++$n; |
899dc88a |
82 | print "not " unless close_enough($when{$_}, time()); |
a0cb3900 |
83 | print "ok $n\n"; |
484fdf61 |
84 | sleep 6 if $_ < 3; |
899dc88a |
85 | $DEBUG and print "# ", time()-$t0, "\n"; |
a0cb3900 |
86 | } |
484fdf61 |
87 | # values will now expire at T=15, 21, 27 |
88 | # it is now T=12 |
a0cb3900 |
89 | |
484fdf61 |
90 | # T+12 |
a0cb3900 |
91 | for (1,2,3) { |
899dc88a |
92 | $again{$_} = now($_); # Should be the same as before, because of memoization |
a0cb3900 |
93 | } |
94 | |
484fdf61 |
95 | # (7-9) |
96 | # T+12 |
a0cb3900 |
97 | foreach (1,2,3) { |
98 | ++$n; |
484fdf61 |
99 | if (very_close($when{$_}, $again{$_})) { |
100 | print "ok $n\n"; |
101 | } else { |
102 | print "not ok $n # expected $when{$_}, got $again{$_}\n"; |
103 | } |
a0cb3900 |
104 | } |
105 | |
484fdf61 |
106 | # (10) |
107 | wait_until(18); # now(1) expires |
a0cb3900 |
108 | print "not " unless close_enough(time, $again{1} = now(1)); |
109 | ++$n; print "ok $n\n"; |
110 | |
484fdf61 |
111 | # (11-12) |
112 | # T+18 |
899dc88a |
113 | foreach (2,3) { # Should not have expired yet. |
a0cb3900 |
114 | ++$n; |
484fdf61 |
115 | print "not " unless now($_) == $again{$_}; |
a0cb3900 |
116 | print "ok $n\n"; |
117 | } |
118 | |
484fdf61 |
119 | wait_until(24); # now(2) expires |
a0cb3900 |
120 | |
484fdf61 |
121 | # (13) |
122 | # T+24 |
a0cb3900 |
123 | print "not " unless close_enough(time, $again{2} = now(2)); |
124 | ++$n; print "ok $n\n"; |
125 | |
484fdf61 |
126 | # (14-15) |
127 | # T+24 |
899dc88a |
128 | foreach (1,3) { # 1 is good again because it was recomputed after it expired |
a0cb3900 |
129 | ++$n; |
484fdf61 |
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 | } |
a0cb3900 |
135 | } |
136 | |