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