This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Less potentially test-harness-confusing output.
[perl5.git] / lib / Memoize / t / expire_module_t.t
CommitLineData
a0cb3900
JH
1#!/usr/bin/perl
2
3use lib '..';
4use Memoize;
5
6my $n = 0;
7
8if (-e '.fast') {
9 print "1..0\n";
10 exit 0;
11}
12
b2f04286 13print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
a0cb3900
JH
14
15print "1..14\n";
16
17++$n; print "ok $n\n";
18
19sub close_enough {
20# print "Close enough? @_[0,1]\n";
21 abs($_[0] - $_[1]) <= 1;
22}
23
24sub now {
25# print "NOW: @_ ", time(), "\n";
26 time;
27}
28
29memoize 'now',
30 SCALAR_CACHE => ['TIE', 'Memoize::Expire', LIFETIME => 15],
31 LIST_CACHE => 'FAULT'
32 ;
33
34++$n; print "ok $n\n";
35
36
37# T
38for (1,2,3) {
39 $when{$_} = now($_);
40 ++$n;
41 print "not " unless $when{$_} == time;
42 print "ok $n\n";
43 sleep 5 if $_ < 3;
44}
45
46# T+10
47for (1,2,3) {
48 $again{$_} = now($_); # Should be the sameas before, because of memoization
49}
50
51# T+10
52foreach (1,2,3) {
53 ++$n;
54 print "not " unless $when{$_} == $again{$_};
55 print "ok $n\n";
56}
57
58sleep 6; # now(1) expires
59
60# T+16
61print "not " unless close_enough(time, $again{1} = now(1));
62++$n; print "ok $n\n";
63
64# T+16
65foreach (2,3) { # Have not expired yet.
66 ++$n;
67 print "not " unless now($_) == $again{$_};
68 print "ok $n\n";
69}
70
71sleep 6; # now(2) expires
72
73# T+22
74print "not " unless close_enough(time, $again{2} = now(2));
75++$n; print "ok $n\n";
76
77# T+22
78foreach (1,3) {
79 ++$n;
80 print "not " unless now($_) == $again{$_};
81 print "ok $n\n";
82}
83
84