xref: /openbsd-src/gnu/usr.bin/perl/cpan/Memoize/t/expmod.t (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
1*f2a19305Safresh1use strict; use warnings;
2*f2a19305Safresh1use Memoize;
3*f2a19305Safresh1use Memoize::Expire;
4*f2a19305Safresh1use Test::More tests => 22;
5*f2a19305Safresh1
6*f2a19305Safresh1tie my %h => 'Memoize::Expire', HASH => \my %backing;
7*f2a19305Safresh1
8*f2a19305Safresh1$h{foo} = 1;
9*f2a19305Safresh1my $num_keys = keys %backing;
10*f2a19305Safresh1my $num_refs = grep ref, values %backing;
11*f2a19305Safresh1
12*f2a19305Safresh1is $h{foo}, 1, 'setting and getting a plain scalar value works';
13*f2a19305Safresh1cmp_ok $num_keys, '>', 0, 'HASH option is effective';
14*f2a19305Safresh1is $num_refs, 0, 'backing storage contains only plain scalars';
15*f2a19305Safresh1
16*f2a19305Safresh1$h{bar} = my $bar = {};
17*f2a19305Safresh1my $num_keys_step2 = keys %backing;
18*f2a19305Safresh1$num_refs = grep ref, values %backing;
19*f2a19305Safresh1
20*f2a19305Safresh1is ref($h{bar}), ref($bar), 'setting and getting a reference value works';
21*f2a19305Safresh1cmp_ok $num_keys, '<', $num_keys_step2, 'HASH option is effective';
22*f2a19305Safresh1is $num_refs, 1, 'backing storage contains only one reference';
23*f2a19305Safresh1
24*f2a19305Safresh1my $contents = eval { +{ %h } };
25*f2a19305Safresh1
26*f2a19305Safresh1ok defined $contents, 'dumping the tied hash works';
27*f2a19305Safresh1is_deeply $contents, { foo => 1, bar => $bar }, ' ... with the expected contents';
28*f2a19305Safresh1
29*f2a19305Safresh1########################################################################
30*f2a19305Safresh1
31*f2a19305Safresh1my $RETURN = 1;
32*f2a19305Safresh1my %CALLS;
33*f2a19305Safresh1
34*f2a19305Safresh1tie my %cache => 'Memoize::Expire', NUM_USES => 2;
35*f2a19305Safresh1memoize sub { ++$CALLS{$_[0]}; $RETURN },
36*f2a19305Safresh1	SCALAR_CACHE => [ HASH => \%cache ],
37*f2a19305Safresh1	LIST_CACHE => 'FAULT',
38*f2a19305Safresh1	INSTALL => 'call';
39*f2a19305Safresh1
40*f2a19305Safresh1is call($_), 1, "$_ gets new val" for 0..3;
41*f2a19305Safresh1
42*f2a19305Safresh1is_deeply \%CALLS, {0=>1,1=>1,2=>1,3=>1}, 'memoized function called once per argument';
43*f2a19305Safresh1
44*f2a19305Safresh1$RETURN = 2;
45*f2a19305Safresh1is call(1), 1, '1 expires';
46*f2a19305Safresh1is call(1), 2, '1 gets new val';
47*f2a19305Safresh1is call(2), 1, '2 expires';
48*f2a19305Safresh1
49*f2a19305Safresh1is_deeply \%CALLS, {0=>1,1=>2,2=>1,3=>1}, 'memoized function called for expired argument';
50*f2a19305Safresh1
51*f2a19305Safresh1$RETURN = 3;
52*f2a19305Safresh1is call(0), 1, '0 expires';
53*f2a19305Safresh1is call(1), 2, '1 expires';
54*f2a19305Safresh1is call(2), 3, '2 gets new val';
55*f2a19305Safresh1is call(3), 1, '3 expires';
56*f2a19305Safresh1
57*f2a19305Safresh1is_deeply \%CALLS, {0=>1,1=>2,2=>2,3=>1}, 'memoized function called for other expired argument';
58