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