xref: /openbsd/gnu/usr.bin/perl/cpan/Memoize/t/expmod_t.t (revision 097a140d) 
1#!/usr/bin/perl
2
3# test caching timeout
4
5use lib '..';
6use Memoize;
7
8my $DEBUG = 0;
9my $LIFETIME = 15;
10
11my $test = 0;
12$| = 1;
13
14if (-e '.fast') {
15  print "1..0\n";
16  exit 0;
17}
18
19print "# Testing the timed expiration policy.\n";
20print "# This will take about thirty seconds.\n";
21
22print "1..26\n";
23
24require Memoize::Expire;
25++$test; print "ok $test - Expire loaded\n";
26
27sub now {
28#  print "NOW: @_ ", time(), "\n";
29  time;
30}
31
32tie my %cache => 'Memoize::Expire', LIFETIME => $LIFETIME;
33
34memoize 'now',
35    SCALAR_CACHE => [HASH => \%cache ],
36    LIST_CACHE => 'FAULT'
37    ;
38
39++$test; print "ok $test - function memoized\n";
40
41my (@before, @after, @now);
42
43# Once a second call now(), with three varying indices. Record when
44# (within a range) it was called last, and depending on the value returned
45# on the next call with the same index, decide whether it correctly
46# returned the old value or expired the cache entry.
47
48for my $iteration (0..($LIFETIME/2)) {
49    for my $i (0..2) {
50        my $before = time;
51        my $now = now($i);
52        my $after = time;
53
54        # the time returned by now() should either straddle the
55        # current time range, or if it returns a cached value, the
56        # time range of the previous time it was called.
57        # $before..$after represents the time range within which now() must have
58        # been called. On very slow platforms, $after - $before may be > 1.
59
60        my $in_range0 = !$iteration || ($before[$i] <= $now && $now <= $after[$i]);
61        my $in_range1 = ($before <= $now && $now <= $after);
62
63        my $ok;
64        if ($iteration) {
65            if ($in_range0) {
66                if ($in_range1) {
67                    $ok = 0; # this should never happen
68                }
69                else {
70                    # cached value, so cache shouldn't have expired
71                    $ok = $after[$i] + $LIFETIME >= $before && $now[$i] == $now;
72                }
73            }
74            else {
75                if ($in_range1) {
76                    # not cached value, so any cache should have have expired
77                    $ok = $before[$i] + $LIFETIME <= $after && $now[$i] != $now;
78                }
79                else {
80                    # not in any range; caching broken
81                    $ok = 0;
82                }
83            }
84        }
85        else {
86            $ok = $in_range1;
87        }
88
89        $test++;
90        print "not " unless $ok;
91        print "ok $test - $iteration:$i\n";
92        if (!$ok || $DEBUG) {
93            print STDERR sprintf
94                "expmod_t.t: %d:%d: r0=%d r1=%d prev=(%s..%s) cur=(%s..%s) now=(%s,%s)\n",
95                $iteration, $i, $in_range0, $in_range1,
96                $before[$i]||-1, $after[$i]||-1, $before, $after, $now[$i]||-1, $now;
97        }
98
99        if (!defined($now[$i]) || $now[$i] != $now) {
100            # cache expired; record value of new cache
101            $before[$i] = $before;
102            $after[$i]  = $after;
103            $now[$i]    = $now;
104        }
105
106        sleep 1;
107    }
108}
109