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