# Some (safe?) bets.
-ok(keys %Config > 900, "Config has more than 900 entries");
+ok(keys %Config > 500, "Config has more than 500 entries");
ok(each %Config);
# 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 }
$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) = @_;
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;
=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
=cut
-$VERSION = 0.65;
+$VERSION = 1.01;
use Carp;
my $Zero = pack("N", 0);
sub STORE {
+# print "Expiry manager STORE handler\n";
my ($self, $key, $data) = @_;
my $cache = $self->{C};
my $cur_date = pack("N", (stat($key))[9]);
}
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;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize 'memoize', 'unmemoize';
sub reff {
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
print "1..25\n";
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
use Config;
use Memoize;
my $n = 0;
+$|=1;
if (-e '.fast') {
}
print "1..12\n";
-
+# (1)
++$n; print "ok $n\n";
my $READFILE_CALLS = 0;
}
require Memoize::ExpireFile;
+# (2)
++$n; print "ok $n\n";
tie my %cache => 'Memoize::ExpireFile';
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";
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
use Memoize::ExpireTest;
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;
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) {
++$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";
+ }
}
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize 'flush_cache', 'memoize';
print "1..8\n";
print "ok 1\n";
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
print "1..7\n";
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-#use lib '..';
+use lib '..';
use Memoize;
$EXPECTED_WARNING = '(no warning expected)';
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize;
-use strict;
-our $COUNT;
-our $RESULT;
if (-e '.fast') {
print "1..0\n";
# If we don't say anything, maybe nobody will notice.
# print STDERR "\nWarning: I'm testing the speedup. This might take up to thirty seconds.\n ";
+my $COARSE_TIME = 1;
+
sub times_to_time { my ($u) = times; $u; }
if ($^O eq 'riscos') {
eval {require Time::HiRes; *my_time = \&Time::HiRes::time };
- if ($@) { *my_time = sub { time }; }
+ if ($@) { *my_time = sub { time }; $COARSE_TIME = 1 }
} else {
*my_time = \×_to_time;
}
# This next test finds an example that takes a long time to run, then
# checks to make sure that the run is actually speeded up by memoization.
-# In some sense, this is the most essential correctness test in the package.
+# In some sense, this is the most essential correctness test in the package.
#
-# We do this by running the fib() function with successively larger
-# arguments until we find one that takes at least $LONG_RUN seconds
+# We do this by running the fib() function with successfily larger
+# arguments until we find one that tales at least $LONG_RUN seconds
# to execute. Then we memoize fib() and run the same call cagain. If
# it doesn't produce the same test in less than one-tenth the time,
# something is seriously wrong.
fib($n-1) + fib($n-2);
}
-our $N = 1;
+sub max { $_[0] > $_[1] ?
+ $_[0] : $_[1]
+ }
+
+$N = 1;
-our $ELAPSED = 0;
+$ELAPSED = 0;
my $LONG_RUN = 10;
# is exponential in $N. If we increase $N too aggressively,
# the user will be forced to wait a very long time.
} else {
- $N++;
+ $N++;
}
}
&memoize('fib');
$COUNT=0;
-my $start = time;
-our $RESULT2 = fib($N);
-our $ELAPSED2 = (time - $start) || 1; # prevent division by 0 errors
+$start = time;
+$RESULT2 = fib($N);
+$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
# If it's not ten times as fast, something is seriously wrong.
-print (($ELAPSED/$ELAPSED2 >= 10) ? "ok 2 - ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]\n"
- : "#
-# COUNT[$COUNT] N[$N] ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]
-not ok 2\n");
+print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n");
# If it called the function more than $N times, it wasn't memoized properly
print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
$COUNT = 0;
$start = time;
$RESULT2 = fib($N);
-$ELAPSED2 = (time - $start) || 1; # prevent division by 0 errors
+$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
-print (($ELAPSED/$ELAPSED2 >= 10) ? "ok 5 - ELAPSED[$ELAPSED] ELAPSED2[$ELAPSED2]\n"
- : "not ok 5\n");
+print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
# This time it shouldn't have called the function at all.
print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-#use lib qw(. ..);
+use lib qw(. ..);
use Memoize 0.52 qw(memoize unmemoize);
use Fcntl;
eval {require Memoize::AnyDBM_File};
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-#use lib qw(. ..);
+use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-#use lib qw(. ..);
+use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
# use Memoize::NDBM_File;
}
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
$file = catfile($tmpdir, "md$$");
-1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
+1 while unlink $file, "$file.dir", "$file.pag";
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
-1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
+1 while unlink $file, "$file.dir", "$file.pag";
sub tryout {
my ($tiepack, $file, $testno) = @_;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-#use lib qw(. ..);
+use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
# use Memoize::SDBM_File;
print "1..4\n";
-my $tmpdir;
-my $file;
if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
+ File::Spec::Functions->import('tmpdir', 'catfile');
+ $tmpdir = tmpdir();
} else {
- *catfile = sub { join '/', @_ };
+ *catfile = sub { join '/', @_ };
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
}
$file = catfile($tmpdir, "md$$");
1 while unlink $file, "$file.dir", "$file.pag";
-if ($^O eq 'VMS') {
- 1 while unlink "${file}.sdbm_dir";
-}
tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag";
-if ($^O eq 'VMS') {
- 1 while unlink "${file}.sdbm_dir";
-}
sub tryout {
my ($tiepack, $file, $testno) = @_;
#!/usr/bin/perl
# -*- mode: perl; perl-indent-level: 2 -*-
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
# $Memoize::Storable::Verbose = 0;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
use lib 'blib/lib';
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
#!/usr/bin/perl
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
+use lib '..';
use Memoize qw(memoize unmemoize);
print "1..5\n";
projects / p5sagit/p5-mst-13.2.git / commitdiff