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
1 #!/usr/bin/perl
2
3 use lib '..';
4 use Memoize;
5
6 my $n = 0;
7
8 if (-e '.fast') {
9   print "1..0\n";
10   exit 0;
11 }
12
13 print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
14
15 print "1..14\n";
16
17 ++$n; print "ok $n\n";
18
19 sub close_enough {
20 #  print "Close enough? @_[0,1]\n";
21   abs($_[0] - $_[1]) <= 1;
22 }
23
24 sub now {
25 #  print "NOW: @_ ", time(), "\n";
26   time;
27 }
28
29 memoize '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
38 for (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
47 for (1,2,3) {
48   $again{$_} = now($_); # Should be the sameas before, because of memoization
49 }
50
51 # T+10
52 foreach (1,2,3) {
53   ++$n;
54   print "not " unless $when{$_} == $again{$_};
55   print "ok $n\n";
56 }
57
58 sleep 6;  # now(1) expires
59
60 # T+16 
61 print "not " unless close_enough(time, $again{1} = now(1));
62 ++$n; print "ok $n\n";
63
64 # T+16 
65 foreach (2,3) {                 # Have not expired yet.
66   ++$n;
67   print "not " unless now($_) == $again{$_};
68   print "ok $n\n";
69 }
70
71 sleep 6;  # now(2) expires
72
73 # T+22
74 print "not " unless close_enough(time, $again{2} = now(2));
75 ++$n; print "ok $n\n";
76
77 # T+22
78 foreach (1,3) {
79   ++$n;
80   print "not " unless now($_) == $again{$_};
81   print "ok $n\n";
82 }
83
84