Browse files

import Memoize 0.06 from CPAN

git-cpan-module:   Memoize
git-cpan-version:  0.06
git-cpan-authorid: MJD
git-cpan-file:     authors/id/M/MJ/MJD/Memoize-0.06.tar.gz
  • Loading branch information...
1 parent a86ea80 commit 5b4d5f3dfcf7bb7a3ba28f354b04349ab8d16ce2 @mjdominus committed with schwern Feb 23, 1998
Showing with 595 additions and 55 deletions.
  1. +3 −0 MANIFEST
  2. +1 −1 Makefile.PL
  3. +55 −26 Memoize.pm
  4. +359 −7 README
  5. +22 −14 TODO
  6. +19 −0 WHATSNEW
  7. +68 −0 t/array.t
  8. +4 −4 t/correctness.t
  9. +7 −3 t/errors.t
  10. +57 −0 t/normalize.t
View
3 MANIFEST
@@ -1,9 +1,12 @@
README
+WHATSNEW
MANIFEST
Memoize.pm
Makefile.PL
t/correctness.t
+t/array.t
t/speed.t
+t/normalize.t
t/errors.t
t/unmemoize.t
demo.pl
View
2 Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Memoize',
- VERSION => '0.05',
+ VERSION => '0.06',
# 'linkext' => {LINKTYPE => ''},
'dist' => {COMPRESS => 'gzip', SUFFIX => 'gz'},
);
View
81 Memoize.pm
@@ -8,10 +8,10 @@
# same terms as Perl iteself. If in doubt, write to mjd@pobox.com
# for a license.
#
-# Version 0.05 alpha $Revision: 1.3 $ $Date: 1998/02/05 03:26:25 $
+# Version 0.06 alpha $Revision: 1.5 $ $Date: 1998/02/23 16:31:22 $
package Memoize;
-$VERSION = '0.05';
+$VERSION = '0.06';
=head1 NAME
@@ -128,10 +128,10 @@ There are some optional options you can pass to C<memoize> to change
the way it behaves a little. To supply options, invoke C<memoize>
like this:
- memoize(function, { TODISK => filename,
- NORMALIZER => function,
- INSTALL => newname
- });
+ memoize(function, TODISK => filename,
+ NORMALIZER => function,
+ INSTALL => newname
+ );
Each of these three options is optional; you can include some, all, or
none of them.
@@ -142,7 +142,7 @@ If you supply a function name with C<INSTALL>, memoize will install
the new, memoized version of the function under the name you give.
For example,
- memoize('fib', { INSTALL => 'fastfib' })
+ memoize('fib', INSTALL => 'fastfib')
installs the memoized version of C<fib> as C<fastfib>; without the
C<INSTALL> option it would have replaced the old C<fib> with the
@@ -194,6 +194,10 @@ function looking exactly the same, like this:
OUCH^\B^\2^\C^\7
+You would tell C<Memoize> to use this normalizer this way:
+
+ memoize('f', NORMALIZER => 'normalize_f');
+
C<memoize> knows that if the normalized version of the arguments is
the same for two argument lists, then it can safely look up the value
that it computed for one argument list and return it as the result of
@@ -206,15 +210,23 @@ argument, and also when the arguments never contain C<$;> (which is
normally character #28, control-\. ) However, it can confuse certain
argument lists:
- normalizer("a$;", "b")
- normalizer("a", "$;b")
+ normalizer("a\034", "b")
+ normalizer("a", "\034b")
+ normalizer("a\034\034b")
for example.
+The calling context of the function (scalar or list context) is
+propagated to the normalizer. This means that if the memoized
+function will treat its arguments differently in list context than it
+would in scalar context, you can have the normalizer function select
+its behavior based on the results of C<wantarray>. Even if called in
+a list context, a normalizer should still return a single string.
+
=head2 TODISK
C<TODISK> means that the memo table should be saved to disk so that it
-will persist between invokations of your program. If you use this
+will persist between invocations of your program. If you use this
option, future runs of your program will get immediate benefit from
the results computed by earlier runs. A useful use of this feature:
You can construct a batch program that runs in the background and
@@ -250,19 +262,17 @@ Memoization is not a cure-all:
Do not memoize a function whose behavior depends on program
state other than its own arguments, such as global variables, the time
-of day, or file input. These functions whill not produce correct
+of day, or file input. These functions will not produce correct
results when memoized. For a particularly easy example:
sub f {
- my $i = <STDIN>;
- chomp $i;
- $i;
+ time;
}
This function takes no arguments, and as far as C<Memoize> is
concerned, it always returns the same result. C<Memoize> is wrong, of
-course, and the memoized version of this function will read STDIN once
-to get a string from the user, and it will return that same string
+course, and the memoized version of this function will call C<time> once
+to get the current time, and it will return that same time
every time you call it after that.
=item *
@@ -353,10 +363,12 @@ use strict;
my %memotable;
my %revmemotable;
+my ($SCALAR, $LIST) = (0, 1); # Constants
sub memoize {
my $fn = shift;
- my $options = shift || {};
+ my %options = @_;
+ my $options = \%options;
unless (defined($fn) &&
(ref $fn eq 'CODE' || ref $fn eq '')) {
@@ -399,8 +411,8 @@ sub memoize {
UNMEMOIZED => $cref,
MEMOIZED => $wrapper,
PACKAGE => $uppack,
- NAME => $install_name, # What was this supposed to be for?
- MEMOS => { }, # Memo table
+ NAME => $install_name,
+ MEMOS => [ { }, { } ], # Memo tables
};
$revmemotable{$wrapper} = "" . $cref; # Turn code ref into hash key
@@ -423,14 +435,32 @@ sub _memoizer {
}
my $argstr;
+ my $context = (wantarray() ? $LIST : $SCALAR);
{ no strict;
- $argstr = &{$normalizer}(@_);
+ if ($context == $SCALAR) {
+ $argstr = &{$normalizer}(@_);
+ } elsif ($context == $LIST) {
+ ($argstr) = &{$normalizer}(@_);
+ } else {
+ croak "Internal error \#41; context was neither \$LIST nor \$SCALAR\n";
+ }
+ }
+ if ($context == $SCALAR) {
+ if (exists $info->{MEMOS}[$SCALAR]{$argstr}) {
+ return $info->{MEMOS}[$SCALAR]{$argstr};
+ } else {
+ $info->{MEMOS}[$SCALAR]{$argstr} = &{$info->{UNMEMOIZED}}(@_);
+ }
+ } elsif ($context == $LIST) {
+ if (exists $info->{MEMOS}[$LIST]{$argstr}) {
+ return @{$info->{MEMOS}[$LIST]{$argstr}};
+ } else {
+ my $q = $info->{MEMOS}[$LIST]{$argstr} = [&{$info->{UNMEMOIZED}}(@_)];
+ @$q;
+ }
+ } else {
+ croak "Internal error \#42; context was neither \$LIST nor \$SCALAR\n";
}
- if (exists $info->{MEMOS}{$argstr}) {
- return $info->{MEMOS}{$argstr};
- }
-
- $info->{MEMOS}{$argstr} = &{$info->{UNMEMOIZED}}(@_);
}
sub _default_normalizer {
@@ -458,7 +488,6 @@ sub unmemoize {
undef $memotable{$revmemotable{$cref}};
undef $revmemotable{$cref};
$tabent->{UNMEMOIZED};
- 1;
}
sub _make_cref {
View
366 README
@@ -1,13 +1,365 @@
-Documentation for this module is in the module file itself; see
-`Memoize.pm'. This is true for all Perl modules. To display it,
-try
+Name: Memoize
+What: Transparently speed up functions by caching return values.
+Version: 0.06
+Author: Mark-Jason Dominus (mjd-perl-memoize@plover.com)
- perldoc Memoize.pm
+################################################################
-or just view Memoize.pm with any text viewer or editor.
+What's new since the previous release:
-Author: Mark-Jason Dominus (mjd-perl-memoize@plover.com)
+Calling syntax is now
-Date: 17 February 1998
+ memoize(function, OPTION1 => VALUE1, ...)
+
+instead of
+
+ memoize(function, { OPTION1 => VALUE1, ... })
+
+
+Functions that return lists can now be memoized.
+
+New tests for list-returning functions and their normalizers.
+
+Various documentation changes.
+
+Return value from `unmemoize' is now the resulting unmemoized
+function, instead of the constant `1'. It was already docmuented to
+do so.
+
+################################################################
+
+
+=head1 NAME
+
+Memoize - Make your functions faster by trading space for time
+
+=head1 SYNOPSIS
+
+ use Memoize;
+ memoize('slow_function');
+ slow_function(arguments); # Is faster than it was before
+
+=head1 DESCRIPTION
+
+`Memoizing' a function makes it faster by trading space for time.
+Here is an example. Consider the Fibonacci sequence, defined by the
+following function:
+
+ # Compute Fibonacci numbers
+ sub fib {
+ my $n = shift;
+ return $n if $n < 2;
+ fib($n-1) + fib($n-2);
+ }
+
+This function is very slow. Why? To compute fib(14), it first wants
+to compute fib(13) and fib(12), and add the results. But to compute
+fib(13), it first has to compute fib(12) and fib(11), and then it
+comes back and computes fib(12) all over again even though the answer
+is the same. And both of the times that it wants to compute fib(12),
+it has to compute fib(11) from scratch, and then it has to do it
+again each time it wants to compute fib(13). This function does so
+much recomputing of old results that it takes a really long time to
+run---fib(14) makes 1,200 extra recursive calls to itself, to compute
+and recompute things that it already computed.
+
+This function is a good candidate for memoization. Whenever a
+memoized function computes a result, it saves the result in a table.
+Then, if you ask the function to do the same work later, it just gives
+you the answer that was in the table, instead of computing it all over
+again.
+
+This module will automatically memoize functions for you. For
+example, if you memoize the `fib' function above, it will compute
+fib(14) exactly once, the first time it needs to, and then save the
+result in a table. Then if you ask for fib(14) again, it gives you
+the result out of the table. While computing fib(14), instead of
+computing fib(12) twice, it does it once; the second time it needs
+the value it gets it from the table. It doesn't compute fib(11) four
+times; it computes it once, getting it from the table the next three
+times. Instead of making 1,200 recursive calls to `fib', it makes
+15. This makes the function about 150 times faster.
+
+You could do the memoization yourself, by rewriting the function, like
+this:
+
+ # Compute Fibonacci numbers, memoized version
+ { my @fib;
+ sub fib {
+ my $n = shift;
+ return $fib[$n] if defined $fib[$n];
+ return $fib[$n] = $n if $n < 2;
+ $fib[$n] = fib($n-1) + fib($n-2);
+ }
+ }
+
+Or you could use this module, like this:
+
+ use Memoize;
+ memoize('fib');
+
+ # Rest of the fib function just like the original version.
+
+This makes it easy to turn memoizing on and off.
+
+Here's an even simpler example: I wrote a simple ray tracer; the
+program would look in a certain direction, figure out what it was
+looking at, and then convert the `color' value (typically a string
+like `red') of that object to a red, green, and blue pixel value, like
+this:
+
+ for ($direction = 0; $direction < 300; $direction++) {
+ # Figure out which object is in direction $direction
+ $color = $object->{color};
+ ($r, $g, $b) = @{&ColorToRGB($color)};
+ ...
+ }
+
+Since there are relatively few objects in a picture, there are only a
+few colors, which get looked up over and over again. Memoizing
+C<ColorToRGB> speeded up the program by several percent.
+
+=head1 DETAILS
+
+This module exports exactly one function, C<memoize>. The rest of the
+functions in this package are None of Your Business.
+
+You should say
+
+ memoize(function)
+
+where C<function> is the name of the function you want to memoize, or
+a reference to it. C<memoize> returns a reference to the new,
+memoized version of the function, or C<undef> on a non-fatal error.
+At present, there are no non-fatal errors, but there might be some in
+the future.
+
+If C<function> was the name of a function, then C<memoize> hides the
+old version and installs the new memoized version under the old name,
+so that C<&function(...)> actually invokes the memoized version.
+
+=head1 OPTIONS
+
+There are some optional options you can pass to C<memoize> to change
+the way it behaves a little. To supply options, invoke C<memoize>
+like this:
+
+ memoize(function, TODISK => filename,
+ NORMALIZER => function,
+ INSTALL => newname
+ );
+
+Each of these three options is optional; you can include some, all, or
+none of them.
+
+=head2 INSTALL
+
+If you supply a function name with C<INSTALL>, memoize will install
+the new, memoized version of the function under the name you give.
+For example,
+
+ memoize('fib', INSTALL => 'fastfib')
+
+installs the memoized version of C<fib> as C<fastfib>; without the
+C<INSTALL> option it would have replaced the old C<fib> with the
+memoized version.
+
+=head2 NORMALIZER
+
+Suppose your function looks like this:
+
+ # Typical call: f('aha!', A => 11, B => 12);
+ sub f {
+ my $a = shift;
+ my %hash = @_;
+ $hash{B} ||= 2; # B defaults to 2
+ $hash{C} ||= 7; # C defaults to 7
+
+ # Do something with $a, %hash
+ }
+
+Now, the following calls to your function are all completely equivalent:
+
+ f(OUCH);
+ f(OUCH, B => 2);
+ f(OUCH, C => 7);
+ f(OUCH, B => 2, C => 7);
+ f(OUCH, C => 7, B => 2);
+ (etc.)
+
+However, unless you tell C<Memoize> that these calls are equivalent,
+it will not know that, and it will compute the values for these
+invocations of your function separately, and store them separately.
+
+To prevent this, supply a C<NORMALIZER> function that turns the
+program arguments into a string in a way that equivalent arguments
+turn into the same string. A C<NORMALIZER> function for C<f> above
+might look like this:
+
+ sub normalize_f {
+ my $a = shift;
+ my %hash = @_;
+ $hash{B} ||= 2;
+ $hash{C} ||= 7;
+
+ join($;, $a, map ($_ => $hash{$_}) sort keys %hash);
+ }
+
+Each of the argument lists above comes out of the C<normalize_f>
+function looking exactly the same, like this:
+
+ OUCH^\B^\2^\C^\7
+
+You would tell C<Memoize> to use this normalizer this way:
+
+ memoize('f', NORMALIZER => 'normalize_f');
+
+C<memoize> knows that if the normalized version of the arguments is
+the same for two argument lists, then it can safely look up the value
+that it computed for one argument list and return it as the result of
+calling the function with the other argmuent list, even if the
+argument lists look different.
+
+The default normalizer just concatenates the arguments with C<$;> in
+between. This always works correctly for functions with only one
+argument, and also when the arguments never contain C<$;> (which is
+normally character #28, control-\. ) However, it can confuse certain
+argument lists:
+
+ normalizer("a\034", "b")
+ normalizer("a", "\034b")
+ normalizer("a\034\034b")
+
+for example.
+
+The calling context of the function (scalar or list context) is
+propagated to the normalizer. This means that if the memoized
+function will treat its arguments differently in list context than it
+would in scalar context, you can have the normalizer function select
+its behavior based on the results of C<wantarray>. Even if called in
+a list context, a normalizer should still return a single string.
+
+=head2 TODISK
+
+C<TODISK> means that the memo table should be saved to disk so that it
+will persist between invocations of your program. If you use this
+option, future runs of your program will get immediate benefit from
+the results computed by earlier runs. A useful use of this feature:
+You can construct a batch program that runs in the background and
+populates the memo table, and then when you come to run your real
+program the memoized function will be screamingly fast because al lits
+results have been precomputed. Or you would be able to do this, if
+TODISK were implemented, which it presently isn't. But it will be.
+Some day.
+
+=head1 OTHER FUNCTION
+
+There's an C<unmemoize> function that you can import if you want to.
+If you use it, please let me know what it was good for, since I can
+only think of very limited uses for it and was considering leaving it
+out altogether.
+
+It accepts a reference to, or the name of a previously memoized
+function, and undoes whatever it did to provide the memoized version
+in the first place, including making the name refer to the unmemoized
+version if appropriate. It returns a reference to the unmemoized
+version of the function.
+
+If you ask it to unmemoize a function that was never memoized, it
+croaks.
+
+=head1 CAVEATS
+
+Memoization is not a cure-all:
+
+=over 4
+
+=item *
+
+Do not memoize a function whose behavior depends on program
+state other than its own arguments, such as global variables, the time
+of day, or file input. These functions will not produce correct
+results when memoized. For a particularly easy example:
+
+ sub f {
+ time;
+ }
+
+This function takes no arguments, and as far as C<Memoize> is
+concerned, it always returns the same result. C<Memoize> is wrong, of
+course, and the memoized version of this function will call C<time> once
+to get the current time, and it will return that same time
+every time you call it after that.
+
+=item *
+
+Do not memoize a function with side effects.
+
+ sub f {
+ my ($a, $b) = @_;
+ my $s = $a + $b;
+ print "$a + $b = $s.\n";
+ }
+
+This function accepts two arguments, adds them, and prints their sum.
+Its return value is the numuber of characters it printed, but you
+probably didn't care about that. But C<Memoize> doesn't understand
+that. If you memoize this function, you will get the result you
+expect the first time you ask it to print the sum of 2 and 3, but
+subsequent calls will return the number 11 (the return value of
+C<print>) without actually printing anything.
+
+=item *
+
+Do not memoize a function that returns a data structure that is
+modified by its caller.
+
+Consider these functions: C<getusers> returns a list of users somehow,
+and then C<main> throws away the first user on the list and prints the
+rest:
+
+ sub main {
+ my $userlist = getusers();
+ shift @$userlist;
+ foreach $u (@$userlist) {
+ print "User $u\n";
+ }
+ }
+
+ sub getusers {
+ my @users;
+ # Do something to get a list of users;
+ \@users; # Return reference to list.
+ }
+
+If you memoize C<getusers> here, it will work right exactly once. The
+reference to the users list will be stored in the memo table. C<main>
+will discard the first element from the referenced list. The next
+time you invoke C<main>, C<Memoize> will not call C<getusers>; it will
+just return the same reference to the same list it got last time. But
+this time the list has already had its head removed; C<main> will
+erroneously remove another element from it. The list will get shorter
+and shorter every time you call C<main>.
+
+
+=back
+
+
+=head1 AUTHOR
+
+=begin text
+Mark-Jason Dominus (C<mjd-perl-memoize@plover.com>), Plover Systems co.
+
+See the C<Memoize.pm> Page at http://www.plover.com/~mjd/perl/Memoize
+for news and upgrades.
+=end text
+
+=begin html
+<p>Mark-Jason Dominus (<a href="mailto:mjd-perl-memoize@plover.com"><tt>mjd-perl-memoize@plover.com</tt></a>), Plover Systems co.</p>
+<p>See <a href="http://www.plover.com/~mjd/perl/Memoize/">The <tt>Memoize.pm</tt> Page</a> for news and upgrades.</p>
+
+=end html
+
+=cut
View
36 TODO
@@ -1,22 +1,11 @@
+# Version 0.05 alpha $Revision: 1.4 $ $Date: 1998/02/19 06:20:59 $
+
=head1 TO DO
=over 4
=item *
-The module does not work at all for functions that return lists.
-It should have a RETURN_TYPE option that accepts SCALAR, LIST, and
-BOTH and defaults to BOTH. The memo hash can be doubled somehow with
-one hash for (references to) lists and one for scalars.
-
-Don't forget to add array value tests to the test suite.
-
-=item *
-
-There should be an C<unmemoize> function.
-
-=item *
-
We should extend the benchmarking module to allow
timethis(main, { MEMOIZED => [ suba, subb ] })
@@ -73,10 +62,29 @@ Well, I did add the ColorToRGB example, but it's still not so good.
These examples need a lot of work. C<factorial> might be a better
example than C<fibo>.
-=item *
+=item *
+
+Add more regression tests for normalizers.
+
+=item *
+
+Maybe resolve normalizer function to code-ref at memoize time instead
+of at function call time for efficiency? I think there was some
+reason not to do this, but I can't remember what it was.
+
+=item *
+
+Add more array value tests to the test suite.
+
+=item *
+
+Fix that `Subroutine u rededined ... line 484' message.
+
+=item *
There was probably some other stuff that I forgot.
=back
+
View
19 WHATSNEW
@@ -0,0 +1,19 @@
+
+Calling syntax is now
+
+ memoize(function, OPTION1 => VALUE1, ...)
+
+instead of
+
+ memoize(function, { OPTION1 => VALUE1, ... })
+
+
+Functions that return lists can now be memoized.
+
+New tests for list-returning functions and their normalizers.
+
+Various documentation changes.
+
+Return value from `unmemoize' is now the resulting unmemoized
+function, instead of the constant `1'. It was already docmuented to
+do so.
View
68 t/array.t
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize;
+
+
+print "1..11\n";
+
+sub timelist {
+ return (time) x $_[0];
+}
+
+memoize('timelist');
+
+@t1 = &timelist(1);
+sleep 2;
+@u1 = &timelist(1);
+print ((("@t1" eq "@u1") ? '' : 'not '), "ok 1\n");
+
+@t7 = &timelist(7);
+print (((@t7 == 7) ? '' : 'not '), "ok 2\n");
+$BAD = 0;
+for ($i = 1; $i < 7; $i++) {
+ $BAD++ unless $t7[$i-1] == $t7[$i];
+}
+print (($BAD ? 'not ' : ''), "ok 3\n");
+
+sleep 2;
+@u7 = &timelist(7);
+print (((@u7 == 7) ? '' : 'not '), "ok 4\n");
+$BAD = 0;
+for ($i = 1; $i < 7; $i++) {
+ $BAD++ unless $u7[$i-1] == $u7[$i];
+}
+print (($BAD ? 'not ' : ''), "ok 5\n");
+# Properly memoized?
+print ((("@t7" eq "@u7") ? '' : 'not '), "ok 6\n");
+
+sub con {
+ return wantarray()
+}
+
+# Same arguments yield different results in different contexts?
+memoize('con');
+$s = con(1);
+@a = con(1);
+print ((($s == $a[0]) ? 'not ' : ''), "ok 7\n");
+
+# Context propagated correctly?
+print ((($s eq '') ? '' : 'not '), "ok 8\n"); # Scalar context
+print ((("@a" eq '1' && @a == 1) ? '' : 'not '), "ok 9\n"); # List context
+
+# Context propagated correctly to normalizer?
+sub n {
+ my $arg = shift;
+ my $test = shift;
+ if (wantarray) {
+ print ((($arg eq ARRAY) ? '' : 'not '), "ok $test\n"); # List context
+ } else {
+ print ((($arg eq SCALAR) ? '' : 'not '), "ok $test\n"); # Scalar context
+ }
+}
+
+sub f { 1 }
+memoize('f', NORMALIZER => 'n');
+$s = f('SCALAR', 10); # Test 10
+@a = f('ARRAY' , 11); # Test 11
+
View
8 t/correctness.t
@@ -35,7 +35,7 @@ print (($c2 == 12) ? "ok 5\n" : "not ok 5\n");
print $FAIL ? "not ok 6\n" : "ok 6\n"; # Was it really memoized?
$f = do { my $COUNT = 0; sub { $FAIL++ if $COUNT++; 13 } };
-$fm = memoize($f, {INSTALL => 'another'});
+$fm = memoize($f, INSTALL => 'another');
$c1 = &another(); # Was it really installed?
print (($c1 == 13) ? "ok 7\n" : "not ok 7\n");
@@ -99,8 +99,8 @@ sub f3 {
return shift;
}
&memoize('f1');
-&memoize('f2', {NORMALIZER => 'fake_normalize'});
-&memoize('f3', {NORMALIZER => \&fake_normalize});
+&memoize('f2', NORMALIZER => 'fake_normalize');
+&memoize('f3', NORMALIZER => \&fake_normalize);
@f1r = map { f1($_) } (1 .. 10);
@f2r = map { f2($_) } (1 .. 10);
@f3r = map { f3($_) } (1 .. 10);
@@ -115,7 +115,7 @@ print "INSTALL => undef option.\n";
{ my $i = 1;
sub u1 { $i++ }
}
-my $um = memoize('u1', {INSTALL => undef});
+my $um = memoize('u1', INSTALL => undef);
@umr = (&$um, &$um, &$um);
@u1r = (&u1, &u1, &u1 ); # Did *not* clobber &u1
$n++;
View
10 t/errors.t
@@ -2,15 +2,19 @@
use lib '..';
use Memoize;
-use Carp;
-print "1..2\n";
-eval { croak("Ouch.") };
+print "1..3\n";
+
+eval { memoize({}) };
print "\$\@: `$@'\n";
print (($@ ? '' : 'not '), "ok 1\n");
eval { memoize([]) };
print "\$\@: `$@'\n";
print (($@ ? '' : 'not '), "ok 2\n");
+eval { my $x; memoize(\$x) };
+print "\$\@: `$@'\n";
+print (($@ ? '' : 'not '), "ok 3\n");
+
View
57 t/normalize.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize;
+
+print "1..7\n";
+
+
+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');
+
+@ARGS = (1, 2, 3, 2, 1);
+
+@res = map { &$a_normal($_) } @ARGS;
+print ((("@res" eq "1-1 2-2 3-3 2-2 1-1") ? '' : 'not '), "ok 1\n");
+
+@res = map { &$a_nomemo($_) } @ARGS;
+print ((("@res" eq "1-1 2-2 3-3 2-4 1-5") ? '' : 'not '), "ok 2\n");
+
+@res = map { &$a_allmemo($_) } @ARGS;
+print ((("@res" eq "1-1 1-1 1-1 1-1 1-1") ? '' : 'not '), "ok 3\n");
+
+
+
+# Test fully-qualified name and installation
+$COUNT = 0;
+sub parity { $COUNT++; $_[0] % 2 }
+sub parnorm { $_[0] % 2 }
+memoize('parity', NORMALIZER => 'main::parnorm');
+@res = map { &parity($_) } @ARGS;
+print ((("@res" eq "1 0 1 0 1") ? '' : 'not '), "ok 4\n");
+print (( ($COUNT == 2) ? '' : 'not '), "ok 5\n");
+
+# Test normalization with reference to normalizer function
+$COUNT = 0;
+sub par2 { $COUNT++; $_[0] % 2 }
+memoize('par2', NORMALIZER => \&parnorm);
+@res = map { &par2($_) } @ARGS;
+print ((("@res" eq "1 0 1 0 1") ? '' : 'not '), "ok 6\n");
+print (( ($COUNT == 2) ? '' : 'not '), "ok 7\n");
+
+

0 comments on commit 5b4d5f3

Please sign in to comment.