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