#!/usr/bin/perl
use lib '..';
use Memoize;
BEGIN {
eval {require Time::HiRes};
if ($@ || $ENV{SLOW}) {
# $SLOW_TESTS = 1;
} else {
'Time::HiRes'->import('time');
}
}
my $DEBUG = 0;
my $n = 0;
$| = 1;
if (-e '.fast') {
print "1..0\n";
exit 0;
}
# Perhaps nobody will notice if we don't say anything
# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
print "1..15\n";
$| = 1;
# (1)
++$n; print "ok $n\n";
# (2)
require Memoize::Expire;
++$n; print "ok $n\n";
sub close_enough {
# print "Close enough? @_[0,1]\n";
abs($_[0] - $_[1]) <= 2;
}
sub very_close {
# print "Close enough? @_[0,1]\n";
abs($_[0] - $_[1]) <= 0.01;
}
my $t0;
sub start_timer {
$t0 = time;
$DEBUG and print "# $t0\n";
}
sub wait_until {
my $until = shift();
my $diff = $until - (time() - $t0);
$DEBUG and print "# until $until; diff = $diff\n";
return if $diff <= 0;
select undef, undef, undef, $diff;
}
sub now {
# print "NOW: @_ ", time(), "\n";
time;
}
tie my %cache => 'Memoize::Expire', LIFETIME => 15;
memoize 'now',
SCALAR_CACHE => [HASH => \%cache ],
LIST_CACHE => 'FAULT'
;
# (3)
++$n; print "ok $n\n";
# (4-6)
# T
start_timer();
for (1,2,3) {
$when{$_} = now($_);
++$n;
print "not " unless close_enough($when{$_}, time());
print "ok $n\n";
sleep 6 if $_ < 3;
$DEBUG and print "# ", time()-$t0, "\n";
}
# values will now expire at T=15, 21, 27
# it is now T=12
# T+12
for (1,2,3) {
$again{$_} = now($_); # Should be the same as before, because of memoization
}
# (7-9)
# T+12
foreach (1,2,3) {
++$n;
if (very_close($when{$_}, $again{$_})) {
print "ok $n\n";
} else {
print "not ok $n # expected $when{$_}, got $again{$_}\n";
}
}
# (10)
wait_until(18); # now(1) expires
print "not " unless close_enough(time, $again{1} = now(1));
++$n; print "ok $n\n";
# (11-12)
# T+18
foreach (2,3) { # Should not have expired yet.
++$n;
print "not " unless now($_) == $again{$_};
print "ok $n\n";
}
wait_until(24); # now(2) expires
# (13)
# T+24
print "not " unless close_enough(time, $again{2} = now(2));
++$n; print "ok $n\n";
# (14-15)
# T+24
foreach (1,3) { # 1 is good again because it was recomputed after it expired
++$n;
if (very_close(scalar(now($_)), $again{$_})) {
print "ok $n\n";
} else {
print "not ok $n # expected $when{$_}, got $again{$_}\n";
}
}
|