This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Throw away uncleanable scopes when exiting a pseudo-forked process.
[perl5.git] / cpan / Memoize / t / expmod_n.t
CommitLineData
a0cb3900
JH
1#!/usr/bin/perl
2
5189e6fe 3use lib '..';
a0cb3900
JH
4use Memoize;
5
6my $n = 0;
7
8
899dc88a 9print "1..22\n";
a0cb3900
JH
10
11++$n; print "ok $n\n";
12
13$RETURN = 1;
14
15%CALLS = ();
16sub call {
17# print "CALL $_[0] => $RETURN\n";
18 ++$CALLS{$_[0]};
19 $RETURN;
20}
21
899dc88a
JH
22require Memoize::Expire;
23++$n; print "ok $n\n";
24
25tie my %cache => 'Memoize::Expire', NUM_USES => 2;
a0cb3900 26memoize 'call',
899dc88a 27 SCALAR_CACHE => [HASH => \%cache],
a0cb3900
JH
28 LIST_CACHE => 'FAULT';
29
30# $Memoize::Expire::DEBUG = 1;
31++$n; print "ok $n\n";
32
33# 3--6
34for (0,1,2,3) {
35 print "not " unless call($_) == 1;
36 ++$n; print "ok $n\n";
37}
38
39# 7--10
40for (keys %CALLS) {
41 print "not " unless $CALLS{$_} == (1,1,1,1)[$_];
42 ++$n; print "ok $n\n";
43}
44
45# 11--13
46$RETURN = 2;
47++$n; print ((call(1) == 1 ? '' : 'not '), "ok $n\n"); # 1 expires
48++$n; print ((call(1) == 2 ? '' : 'not '), "ok $n\n"); # 1 gets new val
49++$n; print ((call(2) == 1 ? '' : 'not '), "ok $n\n"); # 2 expires
50
51# 14--17
52$RETURN = 3;
53for (0,1,2,3) {
54 # 0 expires, 1 expires, 2 gets new val, 3 expires
55 print "not " unless call($_) == (1,2,3,1)[$_];
56 ++$n; print "ok $n\n";
57}
58
59for (0,1,2,3) {
60 print "not " unless $CALLS{$_} == (1,2,2,1)[$_];
61 ++$n; print "ok $n\n";
62}