1use strict; use warnings; 2use Memoize; 3use Test::More tests => 11; 4 5sub n_null { '' } 6 7{ my $I = 0; 8 sub n_diff { $I++ } 9} 10 11{ my $I = 0; 12 sub a1 { $I++; "$_[0]-$I" } 13 my $J = 0; 14 sub a2 { $J++; "$_[0]-$J" } 15 my $K = 0; 16 sub a3 { $K++; "$_[0]-$K" } 17} 18 19my $a_normal = memoize('a1', INSTALL => undef); 20my $a_nomemo = memoize('a2', INSTALL => undef, NORMALIZER => 'n_diff'); 21my $a_allmemo = memoize('a3', INSTALL => undef, NORMALIZER => 'n_null'); 22 23my @ARGS; 24@ARGS = (1, 2, 3, 2, 1); 25 26is_deeply [map $a_normal->($_), @ARGS], [qw(1-1 2-2 3-3 2-2 1-1)], 'no normalizer'; 27is_deeply [map $a_nomemo->($_), @ARGS], [qw(1-1 2-2 3-3 2-4 1-5)], 'n_diff'; 28is_deeply [map $a_allmemo->($_), @ARGS], [qw(1-1 1-1 1-1 1-1 1-1)], 'n_null'; 29 30# Test fully-qualified name and installation 31my $COUNT; 32$COUNT = 0; 33sub parity { $COUNT++; $_[0] % 2 } 34sub parnorm { $_[0] % 2 } 35memoize('parity', NORMALIZER => 'main::parnorm'); 36is_deeply [map parity($_), @ARGS], [qw(1 0 1 0 1)], 'parity normalizer'; 37is $COUNT, 2, '... with the expected number of calls'; 38 39# Test normalization with reference to normalizer function 40$COUNT = 0; 41sub par2 { $COUNT++; $_[0] % 2 } 42memoize('par2', NORMALIZER => \&parnorm); 43is_deeply [map par2($_), @ARGS], [qw(1 0 1 0 1)], '... also installable by coderef'; 44is $COUNT, 2, '... still with the expected number of calls'; 45 46$COUNT = 0; 47sub count_uninitialized { $COUNT += join('', @_) =~ /\AUse of uninitialized value / } 48my $war1 = memoize(sub {1}, NORMALIZER => sub {undef}); 49{ local $SIG{__WARN__} = \&count_uninitialized; $war1->() } 50is $COUNT, 0, 'no warning when normalizer returns undef'; 51 52# Context propagated correctly to normalizer? 53sub n { 54 my $which = wantarray ? 'list' : 'scalar'; 55 local $Test::Builder::Level = $Test::Builder::Level + 2; 56 is $_[0], $which, "$which context propagates properly"; 57} 58sub f { 1 } 59memoize('f', NORMALIZER => 'n'); 60my $s = f 'scalar'; 61my @a = f 'list'; 62 63sub args { scalar @_ } 64sub null_args { join chr(28), splice @_ } 65memoize('args', NORMALIZER => 'null_args'); 66ok args(1), 'original @_ is protected from normalizer'; 67