1 | #!/usr/bin/perl
|
---|
2 |
|
---|
3 | use lib '..';
|
---|
4 | use Memoize;
|
---|
5 |
|
---|
6 | print "1..7\n";
|
---|
7 |
|
---|
8 |
|
---|
9 | sub n_null { '' }
|
---|
10 |
|
---|
11 | { my $I = 0;
|
---|
12 | sub n_diff { $I++ }
|
---|
13 | }
|
---|
14 |
|
---|
15 | { my $I = 0;
|
---|
16 | sub a1 { $I++; "$_[0]-$I" }
|
---|
17 | my $J = 0;
|
---|
18 | sub a2 { $J++; "$_[0]-$J" }
|
---|
19 | my $K = 0;
|
---|
20 | sub a3 { $K++; "$_[0]-$K" }
|
---|
21 | }
|
---|
22 |
|
---|
23 | my $a_normal = memoize('a1', INSTALL => undef);
|
---|
24 | my $a_nomemo = memoize('a2', INSTALL => undef, NORMALIZER => 'n_diff');
|
---|
25 | my $a_allmemo = memoize('a3', INSTALL => undef, NORMALIZER => 'n_null');
|
---|
26 |
|
---|
27 | @ARGS = (1, 2, 3, 2, 1);
|
---|
28 |
|
---|
29 | @res = map { &$a_normal($_) } @ARGS;
|
---|
30 | print ((("@res" eq "1-1 2-2 3-3 2-2 1-1") ? '' : 'not '), "ok 1\n");
|
---|
31 |
|
---|
32 | @res = map { &$a_nomemo($_) } @ARGS;
|
---|
33 | print ((("@res" eq "1-1 2-2 3-3 2-4 1-5") ? '' : 'not '), "ok 2\n");
|
---|
34 |
|
---|
35 | @res = map { &$a_allmemo($_) } @ARGS;
|
---|
36 | print ((("@res" eq "1-1 1-1 1-1 1-1 1-1") ? '' : 'not '), "ok 3\n");
|
---|
37 |
|
---|
38 |
|
---|
39 |
|
---|
40 | # Test fully-qualified name and installation
|
---|
41 | $COUNT = 0;
|
---|
42 | sub parity { $COUNT++; $_[0] % 2 }
|
---|
43 | sub parnorm { $_[0] % 2 }
|
---|
44 | memoize('parity', NORMALIZER => 'main::parnorm');
|
---|
45 | @res = map { &parity($_) } @ARGS;
|
---|
46 | print ((("@res" eq "1 0 1 0 1") ? '' : 'not '), "ok 4\n");
|
---|
47 | print (( ($COUNT == 2) ? '' : 'not '), "ok 5\n");
|
---|
48 |
|
---|
49 | # Test normalization with reference to normalizer function
|
---|
50 | $COUNT = 0;
|
---|
51 | sub par2 { $COUNT++; $_[0] % 2 }
|
---|
52 | memoize('par2', NORMALIZER => \&parnorm);
|
---|
53 | @res = map { &par2($_) } @ARGS;
|
---|
54 | print ((("@res" eq "1 0 1 0 1") ? '' : 'not '), "ok 6\n");
|
---|
55 | print (( ($COUNT == 2) ? '' : 'not '), "ok 7\n");
|
---|
56 |
|
---|
57 |
|
---|