xref: /openbsd-src/gnu/usr.bin/perl/cpan/Memoize/t/normalize.t (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
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