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