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