X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMemoize%2Ft%2Fexpmod_t.t;h=a1ffa017bb96ef72b0fb67312951d6b0040a2342;hb=484fdf61e8653b10160ba1e8011888f52ab6825a;hp=3cc3de13f8372a1e56bcc6e93bd4dcd7fb9fdd4d;hpb=2c9a7a58b20fb637a8583ba7deb759be31f62b62;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Memoize/t/expmod_t.t b/lib/Memoize/t/expmod_t.t index 3cc3de1..a1ffa01 100644 --- a/lib/Memoize/t/expmod_t.t +++ b/lib/Memoize/t/expmod_t.t @@ -27,14 +27,21 @@ if (-e '.fast') { 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]) <= 1; + abs($_[0] - $_[1]) <= 2; +} + +sub very_close { +# print "Close enough? @_[0,1]\n"; + abs($_[0] - $_[1]) <= 0.01; } my $t0; @@ -56,15 +63,17 @@ sub now { time; } -tie my %cache => 'Memoize::Expire', LIFETIME => 10; +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) { @@ -72,45 +81,56 @@ for (1,2,3) { ++$n; print "not " unless close_enough($when{$_}, time()); print "ok $n\n"; - sleep 4 if $_ < 3; + sleep 6 if $_ < 3; $DEBUG and print "# ", time()-$t0, "\n"; } -# values will now expire at T=10, 14, 18 -# it is now T=8 +# values will now expire at T=15, 21, 27 +# it is now T=12 -# T+8 +# T+12 for (1,2,3) { $again{$_} = now($_); # Should be the same as before, because of memoization } -# T+8 +# (7-9) +# T+12 foreach (1,2,3) { ++$n; - print "not " unless close_enough($when{$_}, $again{$_}); - print "ok $n\n"; + if (very_close($when{$_}, $again{$_})) { + print "ok $n\n"; + } else { + print "not ok $n # expected $when{$_}, got $again{$_}\n"; + } } -wait_until(12); # now(1) expires +# (10) +wait_until(18); # now(1) expires print "not " unless close_enough(time, $again{1} = now(1)); ++$n; print "ok $n\n"; -# T+12 +# (11-12) +# T+18 foreach (2,3) { # Should not have expired yet. ++$n; - print "not " unless close_enough(scalar(now($_)), $again{$_}); + print "not " unless now($_) == $again{$_}; print "ok $n\n"; } -wait_until(16); # now(2) expires +wait_until(24); # now(2) expires -# T+16 +# (13) +# T+24 print "not " unless close_enough(time, $again{2} = now(2)); ++$n; print "ok $n\n"; -# T+16 +# (14-15) +# T+24 foreach (1,3) { # 1 is good again because it was recomputed after it expired ++$n; - print "not " unless close_enough(scalar(now($_)), $again{$_}); - print "ok $n\n"; + if (very_close(scalar(now($_)), $again{$_})) { + print "ok $n\n"; + } else { + print "not ok $n # expected $when{$_}, got $again{$_}\n"; + } }