Permalink
Browse files

import Memoize 0.48 from CPAN

git-cpan-module:   Memoize
git-cpan-version:  0.48
git-cpan-authorid: MJD
git-cpan-file:     authors/id/M/MJ/MJD/Memoize-0.48.tar.gz
  • Loading branch information...
1 parent 52571e4 commit 7d8eff32b273bb473a8720028e12b722b5d4e039 @mjdominus committed with schwern Jan 15, 1999
Showing with 110 additions and 22 deletions.
  1. +1 −0 MANIFEST
  2. +1 −1 Makefile.PL
  3. +30 −5 Memoize.pm
  4. +8 −5 Memoize/AnyDBM_File.pm
  5. +31 −0 TODO
  6. +0 −2 t/correctness.t
  7. +31 −0 t/prototype.t
  8. +2 −2 t/tie_storable.t
  9. +6 −7 t/tiefeatures.t
View
@@ -8,6 +8,7 @@ Memoize/NDBM_File.pm
Memoize/AnyDBM_File.pm
Memoize/Storable.pm
t/correctness.t
+t/prototype.t
t/array.t
t/speed.t
t/normalize.t
View
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Memoize',
- VERSION => '0.47',
+ VERSION => '0.48',
# 'linkext' => {LINKTYPE => ''},
'dist' => {COMPRESS => 'gzip', SUFFIX => 'gz'},
);
View
@@ -8,10 +8,10 @@
# same terms as Perl itself. If in doubt,
# write to mjd-perl-memoize@plover.com for a license.
#
-# Version 0.47 beta $Revision: 1.11 $ $Date: 1998/09/15 05:00:10 $
+# Version 0.48 beta $Revision: 1.13 $ $Date: 1999/01/15 20:04:34 $
package Memoize;
-$VERSION = '0.47';
+$VERSION = '0.48';
@@ -52,8 +52,20 @@ sub memoize {
# Convert function names to code references
$cref = &_make_cref($fn, $uppack);
+ # Locate function prototype, if any
+ my $proto = prototype $cref;
+ if (defined $proto) { $proto = "($proto)" }
+ else { $proto = "" }
+
# Goto considered harmful! Hee hee hee.
- my $wrapper = eval "sub { unshift \@_, qq{$cref}; goto &_memoizer; }";
+ my $wrapper = eval "sub $proto { unshift \@_, qq{$cref}; goto &_memoizer; }";
+# --- THREADED PERL COMMENT ---
+# The above might not work under threaded perl because goto & semantics are
+# broken. If that's the case, try the following:
+# my $wrapper = eval "sub { &_memoizer(qq{$cref}, \@_); }";
+# Confirmed 1998-12-27 this does work.
+# 1998-12-29: Sarathy says this bug is fixed in 5.005_54.
+# However, the module still fails, although the sample test program doesn't.
my $install_name;
if (defined $options->{INSTALL}) {
@@ -794,12 +806,25 @@ function (or when your program exits):
SCALAR_CACHE => [TIE, Memoize::Storable, $filename, 'nstore'];
Include the `nstore' option to have the C<Storable> database written
-in `network order'. (See L<Storable> for moer details about this.)
+in `network order'. (See L<Storable> for more details about this.)
=head1 MY BUGS
Needs a better test suite, especially for the tied stuff.
-That is why the version number is 0.46 instead of 0.50.
+
+Also, there is some problem with the way C<goto &f> works under
+threaded Perl, because of the lexical scoping of C<@_>. This is a bug
+in Perl, and until it is resolved, Memoize won't work with these
+Perls. To fix it, you need to chop the source code a little. Find
+the comment in the source code that says C<--- THREADED PERL
+COMMENT---> and comment out the active line and uncomment the
+commented one. Then try it again.
+
+I wish I could investigate this threaded Perl problem. If someone
+could lend me an account on a machine with threaded Perl for a few
+hours, it would be very helpful.
+
+That is why the version number is 0.48 instead of 1.00.
=head1 MAILING LIST
View
@@ -3,13 +3,16 @@ package Memoize::AnyDBM_File;
use vars qw(@ISA);
@ISA = qw(Memoize::NDBM_File DB_File GDBM_File Memoize::SDBM_File ODBM_File) unless @ISA;
+my $verbose = 1;
+
my $mod;
for $mod (@ISA) {
- if (eval "require $mod") {
- print STDERR "AnyDBM_File => Selected $mod.\n" if $Verbose;
- @ISA = ($mod); # if we leave @ISA alone, warnings abound
- return 1;
- }
+# (my $truemod = $mod) =~ s/^Memoize:://;
+ if (eval "require $mod") {
+ print STDERR "AnyDBM_File => Selected $mod.\n" if $Verbose;
+ @ISA = ($mod); # if we leave @ISA alone, warnings abound
+ return 1;
+ }
}
die "No DBM package was successfully found or installed";
View
31 TODO
@@ -164,6 +164,37 @@ Maybe the default for LIST_CACHE should be MERGE anyway.
=item *
+There's some terrible bug probably related to use under threaded perl,
+possibly connected with line 56:
+
+ my $wrapper = eval "sub { unshift \@_, qq{$cref}; goto &_memoizer; }";
+
+I think becayse C<@_> is lexically scoped in threadperl, the effect of
+C<unshift> never makes it into C<_memoizer>. That's probably a bug in
+Perl, but maybe I should work around it. Can anyone provide more
+information here, or lend me a machine with threaded Perl where I can
+test this theory? Line 59, currently commented out, may fix the
+problem.
+
+=item *
+
+What's the timeout stuff going to look like?
+
+ EXPIRE_TIME => time_in_sec
+ EXPIRE_USES => num_uses
+ MAXENTRIES => n
+
+perhaps? Is EXPIRE_USES actually useful?
+
+=item *
+
+Maybe if the original function has a prototype, the module can use
+that to select the most appropriate default normalizer. For example,
+if the prototype was C<($)>, there's no reason to use `join'. If it's
+C<(\@)> then it can use C<join $;,@$_[0];> instead of C<join $;,@_;>.
+
+=item *
+
There was probably some other stuff that I forgot.
=back
View
@@ -126,5 +126,3 @@ $n++;
print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case
print "$n tests in all.\n";
-
-
View
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize;
+$EXPECTED_WARNING = '(no warning expected)';
+print STDERR "$Memoize::Version";
+
+
+print "1..3\n";
+
+sub q1 ($) { $_[0] + 1 }
+sub q2 () { time }
+sub q3 { join "--", @_ }
+
+$SIG{__WARN__} = \&handle_warnings;
+
+$RES = 'ok';
+memoize 'q1';
+print "$RES 1\n";
+
+$RES = 'ok';
+memoize 'q2';
+print "$RES 2\n";
+
+$RES = 'ok';
+memoize 'q3';
+print "$RES 3\n";
+
+sub handle_warnings {
+ $RES = 'not ok' unless $_[0] eq $EXPECTED_WARNING;
+}
View
@@ -3,8 +3,8 @@
use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
-use Memoize::Storable;
-$Memoize::Storable::Verbose = 0;
+# use Memoize::Storable;
+# $Memoize::Storable::Verbose = 0;
sub i {
$_[0];
View
@@ -3,25 +3,24 @@
use lib 'blib/lib';
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
-use Memoize::SDBM_File;
# print STDERR $INC{'Memoize.pm'}, "\n";
print "1..6\n";
# Test MERGE
-sub x {
+sub xx {
wantarray();
}
-my $s = x();
+my $s = xx();
print ((!$s) ? "ok 1\n" : "not ok 1\n");
-my ($a) = x();
+my ($a) = xx();
print (($a) ? "ok 2\n" : "not ok 2\n");
-memoize 'x', LIST_CACHE => MERGE;
-$s = x();
+memoize 'xx', LIST_CACHE => MERGE;
+$s = xx();
print ((!$s) ? "ok 3\n" : "not ok 3\n");
-($a) = x(); # Should return cached false value from previous invocation
+($a) = xx(); # Should return cached false value from previous invocation
print ((!$a) ? "ok 4\n" : "not ok 4\n");

0 comments on commit 7d8eff3

Please sign in to comment.