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 | |
30 | ++$n; print "ok $n\n"; |
31 | |
899dc88a |
32 | require Memoize::Expire; |
33 | ++$n; print "ok $n\n"; |
34 | |
a0cb3900 |
35 | sub close_enough { |
36 | # print "Close enough? @_[0,1]\n"; |
37 | abs($_[0] - $_[1]) <= 1; |
38 | } |
39 | |
899dc88a |
40 | my $t0; |
41 | sub start_timer { |
42 | $t0 = time; |
43 | $DEBUG and print "# $t0\n"; |
44 | } |
45 | |
46 | sub wait_until { |
47 | my $until = shift(); |
48 | my $diff = $until - (time() - $t0); |
49 | $DEBUG and print "# until $until; diff = $diff\n"; |
50 | return if $diff <= 0; |
51 | select undef, undef, undef, $diff; |
52 | } |
53 | |
a0cb3900 |
54 | sub now { |
55 | # print "NOW: @_ ", time(), "\n"; |
56 | time; |
57 | } |
58 | |
3d4a255c |
59 | tie my %cache => 'Memoize::Expire', LIFETIME => 10; |
a0cb3900 |
60 | memoize 'now', |
899dc88a |
61 | SCALAR_CACHE => [HASH => \%cache ], |
a0cb3900 |
62 | LIST_CACHE => 'FAULT' |
63 | ; |
64 | |
65 | ++$n; print "ok $n\n"; |
66 | |
67 | |
68 | # T |
899dc88a |
69 | start_timer(); |
a0cb3900 |
70 | for (1,2,3) { |
71 | $when{$_} = now($_); |
72 | ++$n; |
899dc88a |
73 | print "not " unless close_enough($when{$_}, time()); |
a0cb3900 |
74 | print "ok $n\n"; |
3d4a255c |
75 | sleep 4 if $_ < 3; |
899dc88a |
76 | $DEBUG and print "# ", time()-$t0, "\n"; |
a0cb3900 |
77 | } |
3d4a255c |
78 | # values will now expire at T=10, 14, 18 |
79 | # it is now T=8 |
a0cb3900 |
80 | |
3d4a255c |
81 | # T+8 |
a0cb3900 |
82 | for (1,2,3) { |
899dc88a |
83 | $again{$_} = now($_); # Should be the same as before, because of memoization |
a0cb3900 |
84 | } |
85 | |
3d4a255c |
86 | # T+8 |
a0cb3900 |
87 | foreach (1,2,3) { |
88 | ++$n; |
899dc88a |
89 | print "not " unless close_enough($when{$_}, $again{$_}); |
a0cb3900 |
90 | print "ok $n\n"; |
91 | } |
92 | |
3d4a255c |
93 | wait_until(12); # now(1) expires |
a0cb3900 |
94 | print "not " unless close_enough(time, $again{1} = now(1)); |
95 | ++$n; print "ok $n\n"; |
96 | |
3d4a255c |
97 | # T+12 |
899dc88a |
98 | foreach (2,3) { # Should not have expired yet. |
a0cb3900 |
99 | ++$n; |
899dc88a |
100 | print "not " unless close_enough(scalar(now($_)), $again{$_}); |
a0cb3900 |
101 | print "ok $n\n"; |
102 | } |
103 | |
3d4a255c |
104 | wait_until(16); # now(2) expires |
a0cb3900 |
105 | |
3d4a255c |
106 | # T+16 |
a0cb3900 |
107 | print "not " unless close_enough(time, $again{2} = now(2)); |
108 | ++$n; print "ok $n\n"; |
109 | |
3d4a255c |
110 | # T+16 |
899dc88a |
111 | foreach (1,3) { # 1 is good again because it was recomputed after it expired |
a0cb3900 |
112 | ++$n; |
899dc88a |
113 | print "not " unless close_enough(scalar(now($_)), $again{$_}); |
a0cb3900 |
114 | print "ok $n\n"; |
115 | } |
116 | |