Re: Clock skew failures in Memoize test suite

From: Mark-Jason Dominus <mjd@plover.com>
Date: Fri, 12 Jul 2002 14:17:56 -0400
Message-ID: <20020712181756.9595.qmail@plover.com>
To: sthoenna@efn.org (Yitzchak Scott-Thoennes)

(an accidental dual submit...)

Subject: lib/Config.t : why 900 entries?
From: "Craig A. Berry" <craigberry@mac.com>
Date: Fri, 12 Jul 2002 16:02:59 -0500
Message-Id: <a05111b04b954f27fd5a7@[172.16.52.1]>

(dropping the limit from 750 down to 500)

p4raw-id: //depot/perl@17508

21 files changed, 100 insertions, 134 deletions

diff --git a/lib/Config.t b/lib/Config.t
index d64d810396..c47519bc26 100644
--- a/lib/Config.t
+++ b/lib/Config.t
@@ -10,7 +10,7 @@ use_ok('Config');
 
 # 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);
 
diff --git a/lib/Memoize.pm b/lib/Memoize.pm
index 9f5c591d4f..3db1c7d217 100644
--- a/lib/Memoize.pm
+++ b/lib/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
diff --git a/lib/Memoize/ExpireFile.pm b/lib/Memoize/ExpireFile.pm
index cca9fba651..e52c09a3bf 100644
--- a/lib/Memoize/ExpireFile.pm
+++ b/lib/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;
diff --git a/lib/Memoize/t/array.t b/lib/Memoize/t/array.t
index 032d7c20bc..b7057ea58a 100755
--- a/lib/Memoize/t/array.t
+++ b/lib/Memoize/t/array.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize;
 
 
diff --git a/lib/Memoize/t/array_confusion.t b/lib/Memoize/t/array_confusion.t
index a1693df162..44847c36b7 100644
--- a/lib/Memoize/t/array_confusion.t
+++ b/lib/Memoize/t/array_confusion.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize 'memoize', 'unmemoize';
 
 sub reff {
diff --git a/lib/Memoize/t/correctness.t b/lib/Memoize/t/correctness.t
index 7bd1760dc6..ae56787255 100755
--- a/lib/Memoize/t/correctness.t
+++ b/lib/Memoize/t/correctness.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize;
 
 print "1..25\n";
diff --git a/lib/Memoize/t/errors.t b/lib/Memoize/t/errors.t
index 2e3c8a0db1..f92e5172b2 100755
--- a/lib/Memoize/t/errors.t
+++ b/lib/Memoize/t/errors.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize;
 use Config;
 
diff --git a/lib/Memoize/t/expfile.t b/lib/Memoize/t/expfile.t
index 9959d00313..c81bfd494f 100644
--- a/lib/Memoize/t/expfile.t
+++ b/lib/Memoize/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";
diff --git a/lib/Memoize/t/expire.t b/lib/Memoize/t/expire.t
index c97f9f347d..497e7a9fdd 100644
--- a/lib/Memoize/t/expire.t
+++ b/lib/Memoize/t/expire.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize;
 use Memoize::ExpireTest;
 
diff --git a/lib/Memoize/t/expmod_t.t b/lib/Memoize/t/expmod_t.t
index 3cc3de13f8..a1ffa017bb 100644
--- a/lib/Memoize/t/expmod_t.t
+++ b/lib/Memoize/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,15 +63,17 @@ 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) {
@@ -72,45 +81,56 @@ 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";
+  }
 }
 
diff --git a/lib/Memoize/t/flush.t b/lib/Memoize/t/flush.t
index 9d1353674c..bf9262ec7c 100644
--- a/lib/Memoize/t/flush.t
+++ b/lib/Memoize/t/flush.t
@@ -1,9 +1,6 @@
 #!/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";
diff --git a/lib/Memoize/t/normalize.t b/lib/Memoize/t/normalize.t
index 228c074eef..a920ff4b30 100755
--- a/lib/Memoize/t/normalize.t
+++ b/lib/Memoize/t/normalize.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize;
 
 print "1..7\n";
diff --git a/lib/Memoize/t/prototype.t b/lib/Memoize/t/prototype.t
index a1c7c4da31..f3859e329d 100644
--- a/lib/Memoize/t/prototype.t
+++ b/lib/Memoize/t/prototype.t
@@ -1,10 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-#use lib '..';
+use lib '..';
 use Memoize;
 $EXPECTED_WARNING = '(no warning expected)';
 
diff --git a/lib/Memoize/t/speed.t b/lib/Memoize/t/speed.t
index 0456f2fcb5..6d21906573 100755
--- a/lib/Memoize/t/speed.t
+++ b/lib/Memoize/t/speed.t
@@ -1,13 +1,7 @@
 #!/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";
@@ -18,10 +12,12 @@ $| = 1;
 # 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 = \&times_to_time;
 }
@@ -33,10 +29,10 @@ print "1..6\n";
 
 # 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.
@@ -52,9 +48,13 @@ sub fib {
   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;
 
@@ -75,7 +75,7 @@ while (1) {
       # is exponential in $N.  If we increase $N too aggressively,
       # the user will be forced to wait a very long time.
   } else {
-      $N++;
+      $N++; 
   }
 }
 
@@ -85,16 +85,13 @@ print "# Total calls: $COUNT.\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");
 
@@ -102,10 +99,9 @@ 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");
diff --git a/lib/Memoize/t/tie.t b/lib/Memoize/t/tie.t
index c2b3ff15aa..e058674761 100755
--- a/lib/Memoize/t/tie.t
+++ b/lib/Memoize/t/tie.t
@@ -1,10 +1,6 @@
 #!/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};
diff --git a/lib/Memoize/t/tie_gdbm.t b/lib/Memoize/t/tie_gdbm.t
index 7d17cbe7e0..e9f20a071e 100755
--- a/lib/Memoize/t/tie_gdbm.t
+++ b/lib/Memoize/t/tie_gdbm.t
@@ -1,10 +1,6 @@
 #!/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;
 
diff --git a/lib/Memoize/t/tie_ndbm.t b/lib/Memoize/t/tie_ndbm.t
index a82c93e2d4..0551446940 100644
--- a/lib/Memoize/t/tie_ndbm.t
+++ b/lib/Memoize/t/tie_ndbm.t
@@ -1,10 +1,6 @@
 #!/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;
@@ -40,9 +36,9 @@ if (eval {require File::Spec::Functions}) {
 }
 $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) = @_;
diff --git a/lib/Memoize/t/tie_sdbm.t b/lib/Memoize/t/tie_sdbm.t
index ddb6a86412..07a7a80bce 100644
--- a/lib/Memoize/t/tie_sdbm.t
+++ b/lib/Memoize/t/tie_sdbm.t
@@ -1,10 +1,6 @@
 #!/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;
@@ -32,25 +28,17 @@ if ($@) {
 
 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) = @_;
diff --git a/lib/Memoize/t/tie_storable.t b/lib/Memoize/t/tie_storable.t
index 17bf93d957..042175552b 100644
--- a/lib/Memoize/t/tie_storable.t
+++ b/lib/Memoize/t/tie_storable.t
@@ -1,10 +1,7 @@
 #!/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;
 
diff --git a/lib/Memoize/t/tiefeatures.t b/lib/Memoize/t/tiefeatures.t
index bdabb2824c..7306d9f4f8 100755
--- a/lib/Memoize/t/tiefeatures.t
+++ b/lib/Memoize/t/tiefeatures.t
@@ -1,9 +1,5 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
 use lib 'blib/lib';
 use Memoize 0.45 qw(memoize unmemoize);
 use Fcntl;
diff --git a/lib/Memoize/t/unmemoize.t b/lib/Memoize/t/unmemoize.t
index 38b61b66b9..82b318c645 100755
--- a/lib/Memoize/t/unmemoize.t
+++ b/lib/Memoize/t/unmemoize.t
@@ -1,9 +1,6 @@
 #!/usr/bin/perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
+use lib '..';
 use Memoize qw(memoize unmemoize);
 
 print "1..5\n";