Skip to content
Browse files

import Memoize 1.01 from CPAN

git-cpan-module:   Memoize
git-cpan-version:  1.01
git-cpan-authorid: MJD
git-cpan-file:     authors/id/M/MJ/MJD/Memoize-1.01.tar.gz
  • Loading branch information...
1 parent f192e71 commit 6ace401cbece5f6d654b2b3683f9a35c29d0fe7d @mjdominus committed with schwern Jul 12, 2002
Showing with 62 additions and 32 deletions.
  1. +4 −6 Memoize.pm
  2. +8 −4 Memoize/ExpireFile.pm
  3. +2 −1 t/errors.t
  4. +11 −4 t/expfile.t
  5. +37 −17 t/expmod_t.t
View
10 Memoize.pm
@@ -8,10 +8,10 @@
# same terms as Perl itself. If in doubt,
# write to mjd-perl-memoize+@plover.com for a license.
#
-# Version 1.00 $Revision: 1.18 $ $Date: 2001/06/24 17:16:47 $
+# Version 1.01 $Revision: 1.18 $ $Date: 2001/06/24 17:16:47 $
package Memoize;
-$VERSION = '1.00';
+$VERSION = '1.01';
# Compile-time constants
sub SCALAR () { 0 }
@@ -167,8 +167,6 @@ sub memoize {
$wrapper # Return just memoized version
}
-use warnings::register;
-
# This function tries to load a tied hash class and tie the hash to it.
sub _my_tie {
my ($context, $hash, $options) = @_;
@@ -179,7 +177,7 @@ sub _my_tie {
return unless defined $shortopt && $shortopt eq 'TIE';
carp("TIE option to memoize() is deprecated; use HASH instead")
- if warnings::enabled('deprecated');
+ if $^W;
my @args = ref $fullopt ? @$fullopt : ();
shift @args;
@@ -363,7 +361,7 @@ Memoize - Make functions faster by trading space for time
=head1 SYNOPSIS
- # This is the documentation for Memoize 1.00
+ # This is the documentation for Memoize 1.01
use Memoize;
memoize('slow_function');
slow_function(arguments); # Is faster than it was before
View
12 Memoize/ExpireFile.pm
@@ -10,7 +10,7 @@ See L<Memoize::Expire>.
=cut
-$VERSION = 0.65;
+$VERSION = 1.01;
use Carp;
my $Zero = pack("N", 0);
@@ -23,6 +23,7 @@ sub TIEHASH {
sub STORE {
+# print "Expiry manager STORE handler\n";
my ($self, $key, $data) = @_;
my $cache = $self->{C};
my $cur_date = pack("N", (stat($key))[9]);
@@ -36,13 +37,16 @@ sub FETCH {
}
sub EXISTS {
+# print "Expiry manager EXISTS handler\n";
my ($self, $key) = @_;
- my $old_date = $self->{C}{"T$key"} || $Zero;
- my $cur_date = pack("N", (stat($key))[9]);
+ my $cache_date = $self->{C}{"T$key"} || $Zero;
+ my $file_date = pack("N", (stat($key))[9]);#
# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
# }
- return $old_date ge $cur_date;
+ my $res = $cache_date ge $file_date;
+# print $res ? "... still good\n" : "... expired\n";
+ $res;
}
1;
View
3 t/errors.t
@@ -4,6 +4,7 @@ use lib '..';
use Memoize;
use Config;
+$|=1;
print "1..11\n";
eval { memoize({}) };
@@ -33,7 +34,7 @@ for $mod (qw(DB_File GDBM_File SDBM_File ODBM_File NDBM_File)) {
};
print $@ =~ /can only store scalars/
|| $@ =~ /Can't locate.*in \@INC/ ? "ok $n\n" : "not ok $n # $@\n";
- 1 while unlink $dummyfile;
+ 1 while unlink $dummyfile, "$dummyfile.dir", "$dummyfile.pag", "$dummyfile.db";
$n++;
}
View
15 t/expfile.t
@@ -4,6 +4,7 @@ use lib '..';
use Memoize;
my $n = 0;
+$|=1;
if (-e '.fast') {
@@ -12,7 +13,7 @@ if (-e '.fast') {
}
print "1..12\n";
-
+# (1)
++$n; print "ok $n\n";
my $READFILE_CALLS = 0;
@@ -35,6 +36,7 @@ sub readfile {
}
require Memoize::ExpireFile;
+# (2)
++$n; print "ok $n\n";
tie my %cache => 'Memoize::ExpireFile';
@@ -43,22 +45,27 @@ memoize 'readfile',
LIST_CACHE => 'FAULT'
;
+# (3)
++$n; print "ok $n\n";
+# (4)
writefile($FILE);
++$n; print "ok $n\n";
-sleep 1;
+sleep 4;
+# (5-6)
my $t1 = readfile($FILE);
++$n; print "ok $n\n";
++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n");
+# (7-9)
my $t2 = readfile($FILE);
-++$n; print "ok $n\n";
+++$n; print "ok $n\n";
++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n");
++$n; print ((($t1 eq $t2) ? '' : 'not '), "ok $n\n");
-sleep 2;
+# (10-12)
+sleep 4;
writefile($FILE);
my $t3 = readfile($FILE);
++$n; print "ok $n\n";
View
54 t/expmod_t.t
@@ -27,14 +27,21 @@ if (-e '.fast') {
print "1..15\n";
$| = 1;
+# (1)
++$n; print "ok $n\n";
+# (2)
require Memoize::Expire;
++$n; print "ok $n\n";
sub close_enough {
# print "Close enough? @_[0,1]\n";
- abs($_[0] - $_[1]) <= 1;
+ abs($_[0] - $_[1]) <= 2;
+}
+
+sub very_close {
+# print "Close enough? @_[0,1]\n";
+ abs($_[0] - $_[1]) <= 0.01;
}
my $t0;
@@ -56,61 +63,74 @@ sub now {
time;
}
-tie my %cache => 'Memoize::Expire', LIFETIME => 10;
+tie my %cache => 'Memoize::Expire', LIFETIME => 15;
memoize 'now',
SCALAR_CACHE => [HASH => \%cache ],
LIST_CACHE => 'FAULT'
;
+# (3)
++$n; print "ok $n\n";
+# (4-6)
# T
start_timer();
for (1,2,3) {
$when{$_} = now($_);
++$n;
print "not " unless close_enough($when{$_}, time());
print "ok $n\n";
- sleep 4 if $_ < 3;
+ sleep 6 if $_ < 3;
$DEBUG and print "# ", time()-$t0, "\n";
}
-# values will now expire at T=10, 14, 18
-# it is now T=8
+# values will now expire at T=15, 21, 27
+# it is now T=12
-# T+8
+# T+12
for (1,2,3) {
$again{$_} = now($_); # Should be the same as before, because of memoization
}
-# T+8
+# (7-9)
+# T+12
foreach (1,2,3) {
++$n;
- print "not " unless close_enough($when{$_}, $again{$_});
- print "ok $n\n";
+ if (very_close($when{$_}, $again{$_})) {
+ print "ok $n\n";
+ } else {
+ print "not ok $n # expected $when{$_}, got $again{$_}\n";
+ }
}
-wait_until(12); # now(1) expires
+# (10)
+wait_until(18); # now(1) expires
print "not " unless close_enough(time, $again{1} = now(1));
++$n; print "ok $n\n";
-# T+12
+# (11-12)
+# T+18
foreach (2,3) { # Should not have expired yet.
++$n;
- print "not " unless close_enough(scalar(now($_)), $again{$_});
+ print "not " unless now($_) == $again{$_};
print "ok $n\n";
}
-wait_until(16); # now(2) expires
+wait_until(24); # now(2) expires
-# T+16
+# (13)
+# T+24
print "not " unless close_enough(time, $again{2} = now(2));
++$n; print "ok $n\n";
-# T+16
+# (14-15)
+# T+24
foreach (1,3) { # 1 is good again because it was recomputed after it expired
++$n;
- print "not " unless close_enough(scalar(now($_)), $again{$_});
- print "ok $n\n";
+ if (very_close(scalar(now($_)), $again{$_})) {
+ print "ok $n\n";
+ } else {
+ print "not ok $n # expected $when{$_}, got $again{$_}\n";
+ }
}

0 comments on commit 6ace401

Please sign in to comment.
Something went wrong with that request. Please try again.