Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
3 | use lib '..'; |
4 | use Memoize; |
899dc88a |
5 | use Time::HiRes 'time'; |
6 | my $DEBUG = 0; |
a0cb3900 |
7 | |
8 | my $n = 0; |
899dc88a |
9 | $| = 1; |
a0cb3900 |
10 | |
11 | if (-e '.fast') { |
12 | print "1..0\n"; |
13 | exit 0; |
14 | } |
15 | |
899dc88a |
16 | # Perhaps nobody will notice if we don't say anything |
17 | # print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n"; |
a0cb3900 |
18 | |
899dc88a |
19 | print "1..15\n"; |
20 | $| = 1; |
a0cb3900 |
21 | |
22 | ++$n; print "ok $n\n"; |
23 | |
899dc88a |
24 | require Memoize::Expire; |
25 | ++$n; print "ok $n\n"; |
26 | |
a0cb3900 |
27 | sub close_enough { |
28 | # print "Close enough? @_[0,1]\n"; |
29 | abs($_[0] - $_[1]) <= 1; |
30 | } |
31 | |
899dc88a |
32 | my $t0; |
33 | sub start_timer { |
34 | $t0 = time; |
35 | $DEBUG and print "# $t0\n"; |
36 | } |
37 | |
38 | sub wait_until { |
39 | my $until = shift(); |
40 | my $diff = $until - (time() - $t0); |
41 | $DEBUG and print "# until $until; diff = $diff\n"; |
42 | return if $diff <= 0; |
43 | select undef, undef, undef, $diff; |
44 | } |
45 | |
a0cb3900 |
46 | sub now { |
47 | # print "NOW: @_ ", time(), "\n"; |
48 | time; |
49 | } |
50 | |
899dc88a |
51 | tie my %cache => 'Memoize::Expire', LIFETIME => 8; |
a0cb3900 |
52 | memoize 'now', |
899dc88a |
53 | SCALAR_CACHE => [HASH => \%cache ], |
a0cb3900 |
54 | LIST_CACHE => 'FAULT' |
55 | ; |
56 | |
57 | ++$n; print "ok $n\n"; |
58 | |
59 | |
60 | # T |
899dc88a |
61 | start_timer(); |
a0cb3900 |
62 | for (1,2,3) { |
63 | $when{$_} = now($_); |
64 | ++$n; |
899dc88a |
65 | print "not " unless close_enough($when{$_}, time()); |
a0cb3900 |
66 | print "ok $n\n"; |
899dc88a |
67 | sleep 3 if $_ < 3; |
68 | $DEBUG and print "# ", time()-$t0, "\n"; |
a0cb3900 |
69 | } |
899dc88a |
70 | # values will now expire at T=8, 11, 14 |
71 | # it is now T=6 |
a0cb3900 |
72 | |
899dc88a |
73 | # T+6 |
a0cb3900 |
74 | for (1,2,3) { |
899dc88a |
75 | $again{$_} = now($_); # Should be the same as before, because of memoization |
a0cb3900 |
76 | } |
77 | |
899dc88a |
78 | # T+6 |
a0cb3900 |
79 | foreach (1,2,3) { |
80 | ++$n; |
899dc88a |
81 | print "not " unless close_enough($when{$_}, $again{$_}); |
a0cb3900 |
82 | print "ok $n\n"; |
83 | } |
84 | |
899dc88a |
85 | wait_until(9.5); # now(1) expires |
a0cb3900 |
86 | print "not " unless close_enough(time, $again{1} = now(1)); |
87 | ++$n; print "ok $n\n"; |
88 | |
899dc88a |
89 | # T+9.5 |
90 | foreach (2,3) { # Should not have expired yet. |
a0cb3900 |
91 | ++$n; |
899dc88a |
92 | print "not " unless close_enough(scalar(now($_)), $again{$_}); |
a0cb3900 |
93 | print "ok $n\n"; |
94 | } |
95 | |
899dc88a |
96 | wait_until(12.5); # now(2) expires |
a0cb3900 |
97 | |
899dc88a |
98 | # T+12.5 |
a0cb3900 |
99 | print "not " unless close_enough(time, $again{2} = now(2)); |
100 | ++$n; print "ok $n\n"; |
101 | |
899dc88a |
102 | # T+12.5 |
103 | foreach (1,3) { # 1 is good again because it was recomputed after it expired |
a0cb3900 |
104 | ++$n; |
899dc88a |
105 | print "not " unless close_enough(scalar(now($_)), $again{$_}); |
a0cb3900 |
106 | print "ok $n\n"; |
107 | } |
108 | |