Upgrade to Tie::File 0.21.

p4raw-id: //depot/perl@15277

7 files changed, 688 insertions, 17 deletions

diff --git a/lib/Tie/File/t/00_version.t b/lib/Tie/File/t/00_version.t
index 8a154b1b72..5d950b9c20 100644
--- a/lib/Tie/File/t/00_version.t
+++ b/lib/Tie/File/t/00_version.t
@@ -2,14 +2,16 @@
 
 print "1..1\n";
 
+my $testversion = "0.21";
 use Tie::File;
 
-if ($Tie::File::VERSION != 0.20) {
+if ($Tie::File::VERSION != $testversion) {
   print STDERR "
-WHOA THERE!!
 
-You seem to be running version $Tie::File::VERSION of the module against
-version 0.20 of the test suite!
+*** WHOA THERE!!! ***
+
+You seem to be running version $Tie::File::VERSION of the module
+against version $testversion of the test suite!
 
 None of the other test results will be reliable.
 ";
diff --git a/lib/Tie/File/t/15_pushpop.t b/lib/Tie/File/t/15_pushpop.t
index cc09b02d5d..4b6d1bc959 100644
--- a/lib/Tie/File/t/15_pushpop.t
+++ b/lib/Tie/File/t/15_pushpop.t
@@ -28,7 +28,6 @@ $N++;
 my ($n, @r);
 
 
-
 # (3-11) PUSH tests
 $n = push @a, "rec0", "rec1", "rec2";
 check_contents($data);
diff --git a/lib/Tie/File/t/17_misc_meth.t b/lib/Tie/File/t/17_misc_meth.t
index 87749616fc..b7543898d4 100644
--- a/lib/Tie/File/t/17_misc_meth.t
+++ b/lib/Tie/File/t/17_misc_meth.t
@@ -8,7 +8,7 @@ my $file = "tf$$.txt";
 $: = Tie::File::_default_recsep();
 1 while unlink $file;
 
-print "1..24\n";
+print "1..35\n";
 
 my $N = 1;
 use Tie::File;
@@ -30,7 +30,7 @@ check_contents("$:$:$:$:");
 @a = ();
 check_contents("");
 
-# (11-16) EXISTS
+# (11-20) EXISTS
 if ($] >= 5.006) {
   eval << 'TESTS';
 print !exists $a[0] ? "ok $N\n" : "not ok $N\n";
@@ -48,28 +48,52 @@ print exists $a[1] ? "ok $N\n" : "ok $N\n";
 $N++;
 print exists $a[2] ? "ok $N\n" : "not ok $N\n";
 $N++;
+print exists $a[-1] ? "ok $N\n" : "not ok $N\n";
+$N++;
+print exists $a[-2] ? "ok $N\n" : "not ok $N\n";
+$N++;
+print exists $a[-3] ? "ok $N\n" : "not ok $N\n";
+$N++;
+print !exists $a[-4] ? "ok $N\n" : "not ok $N\n";
+$N++;
 TESTS
   } else {                      # perl 5.005 doesn't have exists $array[1]
-    for (11..16) {
+    for (11..20) {
       print "ok $_ \# skipped (no exists for arrays)\n";
           $N++;
     }
   }
 
-# (17-24) DELETE
+my $del;
+
+# (21-35) DELETE
 if ($] >= 5.006) {
   eval << 'TESTS';
-delete $a[0];
+$del = delete $a[0];
 check_contents("$:$:GIVE ME PIE$:");
-delete $a[2];
+# 20020317 Through 0.20, the 'delete' function returned the wrong values.
+expect($del, "I like pie.");
+$del = delete $a[2];
 check_contents("$:$:");
-delete $a[0];
+expect($del, "GIVE ME PIE");
+$del = delete $a[0];
 check_contents("$:$:");
-delete $a[1];
+expect($del, "");
+$del = delete $a[1];
 check_contents("$:");
+expect($del, "");
+
+# 20020317 Through 0.20, we had a bug where deleting an element past the 
+# end of the array would actually extend the array to that length.
+$del = delete $a[4];
+check_contents("$:");
+expect($del, undef);
+
+
+
 TESTS
   } else {                      # perl 5.005 doesn't have delete $array[1]
-    for (17..24) {
+    for (21..35) {
       print "ok $_ \# skipped (no delete for arrays)\n";
           $N++;
     }
@@ -87,13 +111,37 @@ sub check_contents {
     print "ok $N\n";
   } else {
     ctrlfix(my $msg = "# expected <$x>, got <$a>");
-    print "not ok $N\n$msg\n";
+    print "not ok $N # $msg\n";
   }
   $N++;
   print $o->_check_integrity($file, $ENV{INTEGRITY}) ? "ok $N\n" : "not ok $N\n";
   $N++;
 }
 
+sub expect {
+  if (@_ == 1) {
+    print $_[0] ? "ok $N\n" : "not ok $N\n";
+  } elsif (@_ == 2) {
+    my ($a, $x) = @_;
+    if    (! defined($a) && ! defined($x)) { print "ok $N\n" }
+    elsif (  defined($a) && ! defined($x)) { 
+      ctrlfix(my $msg = "expected UNDEF, got <$a>");
+      print "not ok $N \# $msg\n";
+    }
+    elsif (! defined($a) &&   defined($x)) { 
+      ctrlfix(my $msg = "expected <$x>, got UNDEF");
+      print "not ok $N \# $msg\n";
+    } elsif ($a eq $x) { print "ok $N\n" }
+    else {
+      ctrlfix(my $msg = "expected <$x>, got <$a>");
+      print "not ok $N \# $msg\n";
+    }
+  } else {
+    die "expect() got ", scalar(@_), " args, should have been 1 or 2";
+  }
+  $N++;
+}
+
 sub ctrlfix {
   for (@_) {
     s/\n/\\n/g;
diff --git a/lib/Tie/File/t/22_autochomp.t b/lib/Tie/File/t/22_autochomp.t
index 70974d4b49..caa7150e0c 100644
--- a/lib/Tie/File/t/22_autochomp.t
+++ b/lib/Tie/File/t/22_autochomp.t
@@ -141,10 +141,18 @@ sub expect {
     print $_[0] ? "ok $N\n" : "not ok $N\n";
   } elsif (@_ == 2) {
     my ($a, $x) = @_;
-    if ($a eq $x) { print "ok $N\n" }
+    if    (! defined($a) && ! defined($x)) { print "ok $N\n" }
+    elsif (  defined($a) && ! defined($x)) { 
+      ctrlfix(my $msg = "expected UNDEF, got <$a>");
+      print "not ok $N \# $msg\n";
+    }
+    elsif (! defined($a) &&   defined($x)) { 
+      ctrlfix(my $msg = "expected <$x>, got UNDEF");
+      print "not ok $N \# $msg\n";
+    } elsif ($a eq $x) { print "ok $N\n" }
     else {
       ctrlfix(my $msg = "expected <$x>, got <$a>");
-      print "not ok $N # $msg\n";
+      print "not ok $N \# $msg\n";
     }
   } else {
     die "expect() got ", scalar(@_), " args, should have been 1 or 2";
diff --git a/lib/Tie/File/t/30_defer.t b/lib/Tie/File/t/30_defer.t
new file mode 100644
index 0000000000..4c32825fe2
--- /dev/null
+++ b/lib/Tie/File/t/30_defer.t
@@ -0,0 +1,319 @@
+#!/usr/bin/perl
+#
+# Check ->defer and ->flush methods
+#
+
+use POSIX 'SEEK_SET';
+my $file = "tf$$.txt";
+$: = Tie::File::_default_recsep();
+my $data = "rec0$:rec1$:rec2$:";
+my ($o, $n);
+
+print "1..79\n";
+
+my $N = 1;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+open F, "> $file" or die $!;
+binmode F;
+print F $data;
+close F;
+$o = tie @a, 'Tie::File', $file;
+print $o ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (3-6) Deferred storage
+$o->defer;
+$a[3] = "rec3";
+check_contents($data);          # nothing written yet
+$a[4] = "rec4";
+check_contents($data);          # nothing written yet
+
+# (7-8) Flush
+$o->flush;
+check_contents($data . "rec3$:rec4$:");          # now it's written
+
+# (9-12) Deferred writing disabled?
+$a[3] = "rec9";
+check_contents("${data}rec9$:rec4$:");
+$a[4] = "rec8";
+check_contents("${data}rec9$:rec8$:");
+
+# (13-18) Now let's try two batches of records
+$#a = 2;
+$o->defer;
+$a[0] = "record0";
+check_contents($data);          # nothing written yet
+$a[2] = "record2";
+check_contents($data);          # nothing written yet
+$o->flush;
+check_contents("record0$:rec1$:record2$:");
+
+# (19-22) Deferred writing past the end of the file
+$o->defer;
+$a[4] = "record4";
+check_contents("record0$:rec1$:record2$:");
+$o->flush;
+check_contents("record0$:rec1$:record2$:$:record4$:");
+
+
+# (23-26) Now two long batches
+$o->defer;
+for (0..2, 4..6) {
+  $a[$_] = "r$_";
+}
+check_contents("record0$:rec1$:record2$:$:record4$:");
+$o->flush;
+check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
+
+# (27-30) Now let's make sure that discarded writes are really discarded
+# We have a 2Mib buffer here, so we can be sure that we aren't accidentally
+# filling it up
+$o->defer;
+for (0, 3, 7) {
+  $a[$_] = "discarded$_";
+}
+check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
+$o->discard;
+check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
+
+################################################################
+#
+# Now we're going to test the results of a small memory limit
+#
+# 
+undef $o;  untie @a;
+$data = join "$:", map("record$_", 0..7), "";  # records are 8 or 9 bytes long
+open F, "> $file" or die $!;
+binmode F;
+print F $data;
+close F;
+
+# Limit cache+buffer size to 47 bytes 
+my $MAX = 47;
+#  -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
+my $BUF = 20;
+#  -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
+$o = tie @a, 'Tie::File', $file, memory => $MAX, dw_size => $BUF;
+print $o ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (31-32) Fill up the read cache
+my @z;
+@z = @a;                        
+# the cache now contains records 3,4,5,6,7.
+check_caches({map(($_ => "record$_$:"), 3..7)}, 
+             {});
+
+# (33-44) See if overloading the defer starts by flushing the read cache
+# and then flushes out the defer
+$o->defer;
+$a[0] = "recordA";              # That should flush record 3 from the cache
+check_caches({map(($_ => "record$_$:"), 4..7)}, 
+             {0 => "recordA$:"});
+check_contents($data);
+
+$a[1] = "recordB";              # That should flush record 4 from the cache
+check_caches({map(($_ => "record$_$:"), 5..7)}, 
+             {0 => "recordA$:",
+              1 => "recordB$:"});
+check_contents($data);
+
+$a[2] = "recordC";              # That should flush the whole darn defer
+# Flushing the defer requires looking up the true lengths of records
+# 0..2, which flushes out the read cache, leaving only 1..2 there.
+# Then the splicer updates the cached versions of 1..2 to contain the
+# new data
+check_caches({1 => "recordB$:", 2 => "recordC$:"},
+             {});               # URRRP
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+$a[3] = "recordD";         # even though we flushed, deferring is STILL ENABLED
+check_caches({1 => "recordB$:", 2 => "recordC$:"},
+             {3 => "recordD$:"}); 
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+# Check readcache-deferbuffer interactions
+
+# (45-47) This should remove outdated data from the read cache
+$a[2] = "recordE";
+check_caches({1 => "recordB$:",                 },
+             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+# (48-51) This should read back out of the defer buffer 
+# without adding anything to the read cache
+my $z;
+$z = $a[2];
+print $z eq "recordE" ? "ok $N\n" : "not ok $N\n";  $N++;
+check_caches({1 => "recordB$:",                 },
+             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+# (52-55) This should repopulate the read cache with a new record
+$z = $a[0];
+print $z eq "recordA" ? "ok $N\n" : "not ok $N\n";  $N++;
+check_caches({1 => "recordB$:", 0 => "recordA$:"},
+             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+# (56-59) This should flush the LRU record from the read cache
+$z = $a[4];  $z = $a[5];
+print $z eq "record5" ? "ok $N\n" : "not ok $N\n";  $N++;
+check_caches({5 => "record5$:", 0 => "recordA$:", 4 => "record4$:"},
+             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_contents(join("$:", qw(recordA recordB recordC 
+                             record3 record4 record5 record6 record7)) . "$:");
+
+# (60-63) This should FLUSH the deferred buffer
+# In doing so, it will read in records 2 and 3, flushing 0 and 4
+# from the read cache, leaving 2, 3, and 5.
+$z = splice @a, 3, 1, "recordZ";
+print $z eq "recordD" ? "ok $N\n" : "not ok $N\n";  $N++;
+check_caches({5 => "record5$:", 3 => "recordZ$:", 2 => "recordE$:"},
+             {}); 
+check_contents(join("$:", qw(recordA recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+
+# (64-66) We should STILL be in deferred writing mode
+$a[5] = "recordX";
+check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+             {5 => "recordX$:"}); 
+check_contents(join("$:", qw(recordA recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+
+# Fill up the defer buffer again
+$a[4] = "recordP";
+# (67-69) This should OVERWRITE the existing deferred record 
+# and NOT flush the buffer
+$a[5] = "recordQ";   
+check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+             {5 => "recordQ$:", 4 => "recordP$:"}); 
+check_contents(join("$:", qw(recordA recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+
+
+# (70-72) Discard should just dump the whole deferbuffer
+$o->discard;
+check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+             {}); 
+check_contents(join("$:", qw(recordA recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+# (73-75) NOW we are out of deferred writing mode
+$a[0] = "recordF";
+check_caches({3 => "recordZ$:", 2 => "recordE$:", 0 => "recordF$:"},
+             {}); 
+check_contents(join("$:", qw(recordF recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+
+# (76-79) Last call--untying the array should flush the deferbuffer
+$o->defer;
+$a[0] = "flushed";
+check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+             {0 => "flushed$:" }); 
+check_contents(join("$:", qw(recordF recordB recordE 
+                             recordZ record4 record5 record6 record7)) . "$:");
+undef $o;
+untie @a;
+# (79) We can't use check_contents any more, because the object is dead
+open F, "< $file" or die;
+{ local $/ ; $z = <F> }
+close F;
+my $x = join("$:", qw(flushed recordB recordE 
+                      recordZ record4 record5 record6 record7)) . "$:";
+if ($z eq $x) {
+  print "ok $N\n";
+} else {
+  my $msg = ctrlfix("expected <$x>, got <$z>");
+  print "not ok $N \# $msg\n";
+}
+$N++;
+
+################################################################
+
+
+sub check_caches {
+  my ($xcache, $xdefer) = @_;
+
+#  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+#  print $integrity ? "ok $N\n" : "not ok $N\n";
+#  $N++;
+
+  my $good = 1;
+  $good &&= hash_equal($o->{cache}, $xcache, "true cache", "expected cache");
+  $good &&= hash_equal($o->{deferred}, $xdefer, "true defer", "expected defer");
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+sub hash_equal {
+  my ($a, $b, $ha, $hb) = @_;
+  $ha = 'first hash'  unless defined $ha;
+  $hb = 'second hash' unless defined $hb;
+
+  my $good = 1;
+  my %b_seen;
+
+  for my $k (keys %$a) {
+    if (! exists $b->{$k}) {
+      print ctrlfix("# Key $k is in $ha but not $hb"), "\n";
+      $good = 0;
+    } elsif ($b->{$k} ne $a->{$k}) {
+      print ctrlfix("# Key $k is <$a->{$k}> in $ha but <$b->{$k}> in $hb"), "\n";
+      $b_seen{$k} = 1;
+      $good = 0;
+    } else {
+      $b_seen{$k} = 1;
+    }
+  }
+
+  for my $k (keys %$b) {
+    unless ($b_seen{$k}) {
+      print ctrlfix("# Key $k is in $hb but not $ha"), "\n";
+      $good = 0;
+    }
+  }
+
+  $good;
+}
+
+
+sub check_contents {
+  my $x = shift;
+
+  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+  print $integrity ? "ok $N\n" : "not ok $N\n";
+  $N++;
+
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+
+  my $a;
+  { local $/; $a = <FH> }
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    my $msg = ctrlfix("# expected <$x>, got <$a>");
+    print "not ok $N\n$msg\n";
+  }
+  $N++;
+}
+
+sub ctrlfix {
+  local $_ = shift;
+  s/\n/\\n/g;
+  s/\r/\\r/g;
+  $_;
+}
+
+END {
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/31_autodefer.t b/lib/Tie/File/t/31_autodefer.t
new file mode 100644
index 0000000000..38d89dacd3
--- /dev/null
+++ b/lib/Tie/File/t/31_autodefer.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+#
+# Check behavior of 'autodefer' feature
+# Mostly this isn't implemented yet
+# This file is primarily here to make sure that the promised ->autodefer
+# method doesn't croak.
+#
+
+use POSIX 'SEEK_SET';
+my $file = "tf$$.txt";
+$: = Tie::File::_default_recsep();
+my $data = "rec0$:rec1$:rec2$:";
+my ($o, $n, @a);
+
+print "1..3\n";
+
+my $N = 1;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+open F, "> $file" or die $!;
+binmode F;
+print F $data;
+close F;
+$o = tie @a, 'Tie::File', $file;
+print $o ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (3) You promised this interface, so it better not die
+
+eval {$o->autodefer(0)};
+print $@ ? "not ok $N # $@\n" : "ok $N\n";
+
+
+
+sub check_contents {
+  my $x = shift;
+  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+  print $integrity ? "ok $N\n" : "not ok $N\n";
+  $N++;
+  my $a;
+  { local $/; $a = <FH> }
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    ctrlfix(my $msg = "# expected <$x>, got <$a>");
+    print "not ok $N\n$msg\n";
+  }
+  $N++;
+}
+
+sub ctrlfix {
+  for (@_) {
+    s/\n/\\n/g;
+    s/\r/\\r/g;
+  }
+}
+
+END {
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/32_defer_misc.t b/lib/Tie/File/t/32_defer_misc.t
new file mode 100644
index 0000000000..8e6edf94a4
--- /dev/null
+++ b/lib/Tie/File/t/32_defer_misc.t
@@ -0,0 +1,230 @@
+#!/usr/bin/perl
+#
+# Check interactions of deferred writing
+# with miscellaneous methods like DELETE, EXISTS,
+# FETCHSIZE, STORESIZE, CLEAR, EXTEND
+#
+
+use POSIX 'SEEK_SET';
+my $file = "tf$$.txt";
+$: = Tie::File::_default_recsep();
+my $data = "rec0$:rec1$:rec2$:";
+my ($o, $n);
+
+print "1..42\n";
+
+my $N = 1;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+open F, "> $file" or die $!;
+binmode F;
+print F $data;
+close F;
+$o = tie @a, 'Tie::File', $file;
+print $o ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (3-6) EXISTS
+if ($] >= 5.006) {
+  eval << 'TESTS';
+$o->defer;
+expect(not exists $a[4]);
+$a[4] = "rec4";
+expect(exists $a[4]);
+check_contents($data);          # nothing written yet
+$o->discard;
+TESTS
+} else {
+    for (3..6) {
+      print "ok $_ \# skipped (no exists for arrays)\n";
+          $N++;
+    }
+}
+
+# (7-10) FETCHSIZE
+$o->defer;
+expect($#a, 2);
+$a[4] = "rec4";
+expect($#a, 4);
+check_contents($data);          # nothing written yet
+$o->discard;
+
+# (11-21) STORESIZE
+$o->defer;
+$#a = 4;
+check_contents($data);          # nothing written yet
+expect($#a, 4);
+$o->flush;
+expect($#a, 4);
+check_contents("$data$:$:");    # two extra empty records
+
+$o->defer;
+$a[4] = "rec4";
+$#a = 2;
+expect($a[4], undef);
+check_contents($data);          # written data was unwritten
+$o->flush;
+check_contents($data);          # nothing left to write
+
+# (22-28) CLEAR
+$o->defer;
+$a[9] = "rec9";
+check_contents($data);          # nothing written yet
+@a = ();
+check_contents("");             # this happens right away
+expect($a[9], undef);
+$o->flush;
+check_contents("");             # nothing left to write
+
+# (29-34) EXTEND
+# Actually it's not real clear what these tests are for
+# since EXTEND has no defined semantics
+$o->defer;
+@a = (0..3);
+check_contents("");             # nothing happened yet
+expect($a[3], "3");
+expect($a[4], undef);
+$o->flush;
+check_contents("0$:1$:2$:3$:"); # file now 4 records long
+
+# (35-53) DELETE
+if ($] >= 5.006) {
+  eval << 'TESTS';
+my $del;
+$o->defer;
+$del = delete $a[2];
+check_contents("0$:1$:2$:3$:"); # nothing happened yet
+expect($a[2], "");
+expect($del, "2");
+$del = delete $a[3];            # shortens file!
+check_contents("0$:1$:2$:");    # deferred writes NOT flushed
+expect($a[3], undef);
+expect($a[2], "");
+exoect($del, "3");
+$a[2] = "cookies";
+$del = delete $a[2];            # shortens file!
+expect($a[2], undef);
+exoect($del, 'cookies');
+check_contents("0$:1$:");
+$a[0] = "crackers";
+$del = delete $a[0];            # file unchanged
+expect($a[0], "");
+exoect($del, 'crackers');
+check_contents("0$:1$:");       # no change yet
+$o->flush;
+check_contents("$:1$:");        # record 0 is NOT 'cookies';
+TESTS
+} else {
+    for (35..53) {
+      print "ok $_ \# skipped (no delete for arrays)\n";
+          $N++;
+    }
+}
+
+################################################################
+
+
+sub check_caches {
+  my ($xcache, $xdefer) = @_;
+
+#  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+#  print $integrity ? "ok $N\n" : "not ok $N\n";
+#  $N++;
+
+  my $good = 1;
+  $good &&= hash_equal($o->{cache}, $xcache, "true cache", "expected cache");
+  $good &&= hash_equal($o->{deferred}, $xdefer, "true defer", "expected defer");
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+sub hash_equal {
+  my ($a, $b, $ha, $hb) = @_;
+  $ha = 'first hash'  unless defined $ha;
+  $hb = 'second hash' unless defined $hb;
+
+  my $good = 1;
+  my %b_seen;
+
+  for my $k (keys %$a) {
+    if (! exists $b->{$k}) {
+      print ctrlfix("# Key $k is in $ha but not $hb"), "\n";
+      $good = 0;
+    } elsif ($b->{$k} ne $a->{$k}) {
+      print ctrlfix("# Key $k is <$a->{$k}> in $ha but <$b->{$k}> in $hb"), "\n";
+      $b_seen{$k} = 1;
+      $good = 0;
+    } else {
+      $b_seen{$k} = 1;
+    }
+  }
+
+  for my $k (keys %$b) {
+    unless ($b_seen{$k}) {
+      print ctrlfix("# Key $k is in $hb but not $ha"), "\n";
+      $good = 0;
+    }
+  }
+
+  $good;
+}
+
+
+sub check_contents {
+  my $x = shift;
+
+  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+  print $integrity ? "ok $N\n" : "not ok $N\n";
+  $N++;
+
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+
+  my $a;
+  { local $/; $a = <FH> }
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    my $msg = ctrlfix("# expected <$x>, got <$a>");
+    print "not ok $N\n$msg\n";
+  }
+  $N++;
+}
+
+sub expect {
+  if (@_ == 1) {
+    print $_[0] ? "ok $N\n" : "not ok $N\n";
+  } elsif (@_ == 2) {
+    my ($a, $x) = @_;
+    if    (! defined($a) && ! defined($x)) { print "ok $N\n" }
+    elsif (  defined($a) && ! defined($x)) { 
+      ctrlfix(my $msg = "expected UNDEF, got <$a>");
+      print "not ok $N \# $msg\n";
+    }
+    elsif (! defined($a) &&   defined($x)) { 
+      ctrlfix(my $msg = "expected <$x>, got UNDEF");
+      print "not ok $N \# $msg\n";
+    } elsif ($a eq $x) { print "ok $N\n" }
+    else {
+      ctrlfix(my $msg = "expected <$x>, got <$a>");
+      print "not ok $N \# $msg\n";
+    }
+  } else {
+    die "expect() got ", scalar(@_), " args, should have been 1 or 2";
+  }
+  $N++;
+}
+
+sub ctrlfix {
+  local $_ = shift;
+  s/\n/\\n/g;
+  s/\r/\\r/g;
+  $_;
+}
+
+END {
+  1 while unlink $file;
+}
+