From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 2 Apr 2002 21:01:41 +0000 (+0000)
Subject: Upgrade to Tie::File 0.92, from mjd.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf9197502f8e76577f32269ca7a71113358bb22a;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Tie::File 0.92, from mjd.

p4raw-id: //depot/perl@15692
---

diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm
index 6fd8ff2..533f5b9 100644
--- a/lib/Tie/File.pm
+++ b/lib/Tie/File.pm
@@ -6,7 +6,7 @@ use POSIX 'SEEK_SET';
 use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'O_WRONLY', 'O_RDONLY';
 sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY }
 
-$VERSION = "0.91";
+$VERSION = "0.92";
 my $DEFAULT_MEMORY_SIZE = 1<<21;    # 2 megabytes
 my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
 my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
@@ -76,6 +76,7 @@ sub TIEARRAY {
 
   $opts{mode} = O_CREAT|O_RDWR unless defined $opts{mode};
   $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
+  $opts{sawlastrec} = undef;
 
   my $fh;
 
@@ -306,7 +307,7 @@ sub STORESIZE {
   $#{$self->{offsets}} = $len;
 #  $self->{offsets}[0] = 0;      # in case we just chopped this
 
-  $self->{cache}->remove(grep $_ >= $len, $self->{cache}->keys);
+  $self->{cache}->remove(grep $_ >= $len, $self->{cache}->ckeys);
 }
 
 sub PUSH {
@@ -440,6 +441,12 @@ sub _splice {
       return unless @data;
       $pos = $oldsize;          # This is what perl does for normal arrays
     }
+
+    # The manual is very unclear here
+    if ($nrecs < 0) {
+      $nrecs = $oldsize - $pos + $nrecs;
+      $nrecs = 0 if $nrecs < 0;
+    }
   }
 
   $self->_fixrecs(@data);
@@ -517,7 +524,7 @@ sub _splice {
   # need to be renumbered
   # Maybe merge this with the previous block?
   {
-    my @oldkeys = grep $_ >= $pos + $nrecs, $self->{cache}->keys;
+    my @oldkeys = grep $_ >= $pos + $nrecs, $self->{cache}->ckeys;
     my @newkeys = map $_-$nrecs+@data, @oldkeys;
     $self->{cache}->rekey(\@oldkeys, \@newkeys);
   }
@@ -654,6 +661,7 @@ sub _fill_offsets_to {
 sub _write_record {
   my ($self, $rec) = @_;
   my $fh = $self->{fh};
+  local $\ = "";
   print $fh $rec
     or die "Couldn't write record: $!";  # "Should never happen."
 #  $self->{_written} += length($rec);
@@ -667,11 +675,14 @@ sub _read_record {
     $rec = <$fh>;
   }
   return unless defined $rec;
-  if (substr($rec, -$self->{recseplen}) ne $self->{recsep}) {
+  if (! $self->{sawlastrec} && 
+      substr($rec, -$self->{recseplen}) ne $self->{recsep}) {
     # improperly terminated final record --- quietly fix it.
 #    my $ac = substr($rec, -$self->{recseplen});
 #    $ac =~ s/\n/\\n/g;
+    $self->{sawlastrec} = 1;
     unless ($self->{rdonly}) {
+      local $\ = "";
       my $fh = $self->{fh};
       print $fh $self->{recsep};
     }
@@ -994,6 +1005,7 @@ sub _check_integrity {
   if (not defined $self->{offsets}[0]) {
     _ci_warn("offset 0 is missing!");
     $good = 0;
+
   } elsif ($self->{offsets}[0] != 0) {
     _ci_warn("rec 0: offset <$self->{offsets}[0]> s/b 0!");
     $good = 0;
@@ -1035,7 +1047,7 @@ sub _check_integrity {
     }
 
     my $deferring = $self->_is_deferring;
-    for my $n ($self->{cache}->keys) {
+    for my $n ($self->{cache}->ckeys) {
       my $r = $self->{cache}->_produce($n);
       $cached += length($r);
       next if $n+1 <= $.;         # checked this already
@@ -1049,6 +1061,7 @@ sub _check_integrity {
     }
   }
 
+  # That cache has its own set of tests
   $good = 0 unless $self->{cache}->_check_integrity;
 
   # Now let's check the deferbuffer
@@ -1288,7 +1301,7 @@ sub rekey {
   }
 }
 
-sub keys {
+sub ckeys {
   my $self = shift;
   my @a = keys %{$self->[HASH]};
   @a;
@@ -1319,9 +1332,58 @@ sub _produce_lru {
   $self->[HEAP]->expire_order;
 }
 
-sub _check_integrity {
+BEGIN { *_ci_warn = \&Tie::File::_ci_warn }
+
+sub _check_integrity {          # For CACHE
   my $self = shift;
-  $self->[HEAP]->_check_integrity;
+  my $good = 1;
+
+  # Test HEAP
+  $self->[HEAP]->_check_integrity or $good = 0;
+
+  # Test HASH
+  my $bytes = 0;
+  for my $k (keys %{$self->[HASH]}) {
+    if ($k ne '0' && $k !~ /^[1-9][0-9]*$/) {
+      $good = 0;
+      _ci_warn "Cache hash key <$k> is non-numeric";
+    }
+
+    my $h = $self->[HASH]{$k};
+    if (! defined $h) {
+      $good = 0;
+      _ci_warn "Heap index number for key $k is undefined";
+    } elsif ($h == 0) {
+      $good = 0;
+      _ci_warn "Heap index number for key $k is zero";
+    } else {
+      my $j = $self->[HEAP][$h];
+      if (! defined $j) {
+        $good = 0;
+        _ci_warn "Heap contents key $k (=> $h) are undefined";
+      } else {
+        $bytes += length($j->[2]);
+        if ($k ne $j->[1]) {
+          $good = 0;
+          _ci_warn "Heap contents key $k (=> $h) is $j->[1], should be $k";
+        }
+      }
+    }
+  }
+
+  # Test BYTES
+  if ($bytes != $self->[BYTES]) {
+    $good = 0;
+    _ci_warn "Total data in cache is $bytes, expected $self->[BYTES]";
+  }
+
+  # Test MAX
+  if ($bytes > $self->[MAX]) {
+    $good = 0;
+    _ci_warn "Total data in cache is $bytes, exceeds maximum $self->[MAX]";
+  }
+
+  return $good;
 }
 
 sub delink {
@@ -1418,7 +1480,7 @@ sub _insert_new {
 # If $i is omitted, default to 1 (the top element.)
 sub _insert {
   my ($self, $item, $i) = @_;
-  $self->_check_loc($i) if defined $i;
+#  $self->_check_loc($i) if defined $i;
   $i = 1 unless defined $i;
   until (! defined $self->[$i]) {
     if ($self->[$i][SEQ] > $item->[SEQ]) { # inserted item is older
@@ -1479,7 +1541,7 @@ sub popheap {
 # bottom.
 sub promote {
   my ($self, $n) = @_;
-  $self->_check_loc($n);
+#  $self->_check_loc($n);
   $self->[$n][SEQ] = $self->_nseq;
   my $i = $n;
   while (1) {
@@ -1502,7 +1564,7 @@ sub promote {
 # Return item $n from the heap, promoting its LRU status
 sub lookup {
   my ($self, $n) = @_;
-  $self->_check_loc($n);
+#  $self->_check_loc($n);
   my $val = $self->[$n];
   $self->promote($n);
   $val->[DAT];
@@ -1512,7 +1574,7 @@ sub lookup {
 # Assign a new value for node $n, promoting it to the bottom of the heap
 sub set_val {
   my ($self, $n, $val) = @_;
-  $self->_check_loc($n);
+#  $self->_check_loc($n);
   my $oval = $self->[$n][DAT];
   $self->[$n][DAT] = $val;
   $self->promote($n);
@@ -1523,32 +1585,47 @@ sub set_val {
 # alter the heap's record of the hash key
 sub rekey {
   my ($self, $n, $new_key) = @_;
-  $self->_check_loc($n);
+#  $self->_check_loc($n);
   $self->[$n][KEY] = $new_key;
 }
 
 sub _check_loc {
   my ($self, $n) = @_;
-  unless (defined $self->[$n]) {
+  unless (1 || defined $self->[$n]) {
     confess "_check_loc($n) failed";
   }
 }
 
+BEGIN { *_ci_warn = \&Tie::File::_ci_warn }
+
 sub _check_integrity {
   my $self = shift;
   my $good = 1;
+  my %seq;
+
   unless (eval {$self->[0][1]->isa("Tie::File::Cache")}) {
-    print "# Element 0 of heap corrupt\n";
+    _ci_warn "Element 0 of heap corrupt";
     $good = 0;
   }
   $good = 0 unless $self->_satisfies_heap_condition(1);
   for my $i (2 .. $#{$self}) {
     my $p = int($i/2);          # index of parent node
     if (defined $self->[$i] && ! defined $self->[$p]) {
-      print "# Element $i of heap defined, but parent $p isn't\n";
+      _ci_warn "Element $i of heap defined, but parent $p isn't";
       $good = 0;
     }
+
+    if (defined $self->[$i]) {
+      if ($seq{$self->[$i][SEQ]}) {
+        my $seq = $self->[$i][SEQ];
+        _ci_warn "Nodes $i and $seq{$seq} both have SEQ=$seq";
+        $good = 0;
+      } else {
+        $seq{$self->[$i][SEQ]} = $i;
+      }
+    }
   }
+
   return $good;
 }
 
@@ -1560,7 +1637,7 @@ sub _satisfies_heap_condition {
     my $c = $n*2 + $_;
     next unless defined $self->[$c];
     if ($self->[$n][SEQ] >= $self->[$c]) {
-      print "# Node $n of heap does not predate node $c\n";
+      _ci_warn "Node $n of heap does not predate node $c";
       $good = 0 ;
     }
     $good = 0 unless $self->_satisfies_heap_condition($c);
@@ -1590,7 +1667,7 @@ Tie::File - Access the lines of a disk file via a Perl array
 
 =head1 SYNOPSIS
 
-	# This file documents Tie::File version 0.90
+	# This file documents Tie::File version 0.92
 
 	tie @array, 'Tie::File', filename or die ...;
 
@@ -2085,7 +2162,7 @@ any news of importance, will be available at
 
 =head1 LICENSE
 
-C<Tie::File> version 0.90 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.92 is copyright (C) 2002 Mark Jason Dominus.
 
 This library is free software; you may redistribute it and/or modify
 it under the same terms as Perl itself.
@@ -2113,7 +2190,7 @@ For licensing inquiries, contact the author at:
 
 =head1 WARRANTY
 
-C<Tie::File> version 0.90 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.92 comes with ABSOLUTELY NO WARRANTY.
 For details, see the license.
 
 =head1 THANKS
diff --git a/lib/Tie/File/t/00_version.t b/lib/Tie/File/t/00_version.t
index a4135fe..afab13f 100644
--- a/lib/Tie/File/t/00_version.t
+++ b/lib/Tie/File/t/00_version.t
@@ -2,7 +2,7 @@
 
 print "1..1\n";
 
-my $testversion = "0.91";
+my $testversion = "0.92";
 use Tie::File;
 
 if ($Tie::File::VERSION != $testversion) {
diff --git a/lib/Tie/File/t/01_gen.t b/lib/Tie/File/t/01_gen.t
index b91a074..0fc0176 100644
--- a/lib/Tie/File/t/01_gen.t
+++ b/lib/Tie/File/t/01_gen.t
@@ -2,7 +2,7 @@
 
 my $file = "tf$$.txt";
 
-print "1..72\n";
+print "1..75\n";
 
 my $N = 1;
 use Tie::File;
@@ -104,6 +104,13 @@ check_contents("", "whoops", "", "rec3");
   $N++; $good = 1;
 }
 
+# (73-75) What if the user has tampered with $\ ?
+{ {  local $\ = "stop messing with the funny variables!";
+     @a = (0..2);
+   }
+  check_contents(0..2);
+}
+
 use POSIX 'SEEK_SET';
 sub check_contents {
   my @c = @_;
diff --git a/lib/Tie/File/t/04_splice.t b/lib/Tie/File/t/04_splice.t
index 601f1f2..2ef95cc 100644
--- a/lib/Tie/File/t/04_splice.t
+++ b/lib/Tie/File/t/04_splice.t
@@ -15,7 +15,7 @@
 my $file = "tf$$.txt";
 $: = Tie::File::_default_recsep();
 my $data = "rec0$:rec1$:rec2$:";
-print "1..106\n";
+print "1..118\n";
 
 init_file($data);
 
@@ -177,7 +177,7 @@ check_contents("");
 @a = (0..11);
 splice @a, -1, 1000;
 check_contents("0$:1$:2$:3$:4$:5$:6$:7$:8$:9$:10$:");
-    
+
 # (104-106) make sure that undefs are treated correctly---they should
 # be converted to empty records, and should not raise any warnings.
 # (Some of these failed in 0.90.  The change to _fixrec fixed them.)
@@ -198,6 +198,27 @@ check_contents("0$:1$:2$:3$:4$:5$:6$:7$:8$:9$:10$:");
   $N++; $good = 1;
 }
 
+# (107-118) splice with negative length was treated wrong
+# 20020402 Reported by Juerd Waalboer
+@a = (0..8) ;
+splice @a, 0, -3;
+check_contents("6$:7$:8$:");
+@a = (0..8) ;
+splice @a, 1, -3;
+check_contents("0$:6$:7$:8$:");
+@a = (0..8) ;
+splice @a, 7, -3;
+check_contents("0$:1$:2$:3$:4$:5$:6$:7$:8$:");
+@a = (0..2) ;
+splice @a, 0, -3;
+check_contents("0$:1$:2$:");
+@a = (0..2) ;
+splice @a, 1, -3;
+check_contents("0$:1$:2$:");
+@a = (0..2) ;
+splice @a, 7, -3;
+check_contents("0$:1$:2$:");
+
 sub init_file {
   my $data = shift;
   open F, "> $file" or die $!;
diff --git a/lib/Tie/File/t/07_rv_splice.t b/lib/Tie/File/t/07_rv_splice.t
index acc4341..e5c09b1 100644
--- a/lib/Tie/File/t/07_rv_splice.t
+++ b/lib/Tie/File/t/07_rv_splice.t
@@ -9,7 +9,7 @@ my $file = "tf$$.txt";
 $: = Tie::File::_default_recsep();
 my $data = "rec0$:rec1$:rec2$:";
 
-print "1..50\n";
+print "1..56\n";
 
 my $N = 1;
 use Tie::File;
@@ -154,6 +154,27 @@ check_result(4..11);
 @r = splice @a;
 check_result(0..3);
 
+# (51-56) splice with negative length was treated wrong
+# 20020402 Reported by Juerd Waalboer
+@a = (0..8) ;
+@r = splice @a, 0, -3;
+check_result(0..5);
+@a = (0..8) ;
+@r = splice @a, 1, -3;
+check_result(1..5);
+@a = (0..8) ;
+@r = splice @a, 7, -3;
+check_result();
+@a = (0..2) ;
+@r = splice @a, 0, -3;
+check_result();
+@a = (0..2) ;
+@r = splice @a, 1, -3;
+check_result();
+@a = (0..2) ;
+@r = splice @a, 7, -3;
+check_result();
+
 sub init_file {
   my $data = shift;
   open F, "> $file" or die $!;
diff --git a/lib/Tie/File/t/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t
index 37a5bc9..7d70e3e 100644
--- a/lib/Tie/File/t/09_gen_rs.t
+++ b/lib/Tie/File/t/09_gen_rs.t
@@ -2,7 +2,7 @@
 
 my $file = "tf$$.txt";
 
-print "1..56\n";
+print "1..58\n";
 
 my $N = 1;
 use Tie::File;
@@ -128,6 +128,18 @@ if (setup_badly_terminated_file(4)) {
   check_contents("x", "y");
 }
 
+# (57-58) 20020402 The modifiaction would have failed if $\ were set wrong.
+# I hate $\.
+if (setup_badly_terminated_file(2)) {
+  $o = tie @a, 'Tie::File', $file,
+    recsep => $RECSEP, autochomp => 0, autodefer => 0
+    or die "Couldn't tie file: $!";
+  { local $\ = "I hate \$\\.";
+    my $z = $a[0];
+  }
+  check_contents($badrec);
+}
+
 sub setup_badly_terminated_file {
   my $NTESTS = shift;
   open F, "> $file" or die "Couldn't open $file: $!";
diff --git a/lib/Tie/File/t/10_splice_rs.t b/lib/Tie/File/t/10_splice_rs.t
index e4d472a..f901bc8 100644
--- a/lib/Tie/File/t/10_splice_rs.t
+++ b/lib/Tie/File/t/10_splice_rs.t
@@ -139,7 +139,7 @@ splice(@a, 0, 17);
 check_contents("");
 
 # (89-92) In the past, splicing past the end was not correctly detected
-# (1.14)
+# (0.14)
 splice(@a, 89, 3);
 check_contents("");
 splice(@a, @a, 3);
@@ -164,7 +164,7 @@ if ($] > 5.008) {
   print "ok $N \# skipped (5.6.0 through 5.8 dump core here.)\n";
 }
 $N++;
-       
+
 # (98-101) Test default arguments
 splice @a, 0, 0, (0..11);
 splice @a, 4;
diff --git a/lib/Tie/File/t/16_handle.t b/lib/Tie/File/t/16_handle.t
index ed15384..72ff10b 100644
--- a/lib/Tie/File/t/16_handle.t
+++ b/lib/Tie/File/t/16_handle.t
@@ -78,15 +78,15 @@ close F;
 undef $o;
 untie @a;
 
-if ($] < 5.006) {
-  print "ok 39 # skipped - 5.005_03 panics after this test\n";
-  exit 0;
-}
 # (39) Does it correctly detect a non-seekable handle?
 {  if ($^O =~ /^(MSWin32|dos|BeOS)$/) {
      print "ok $N # skipped ($^O has broken pipe semantics)\n";
      last;
    }
+   if ($] < 5.006) {
+     print "ok $N # skipped - 5.005_03 panics after this test\n";
+     last;
+   }
    my $pipe_succeeded = eval {pipe *R, *W};
    if ($@) {
      chomp $@;
diff --git a/lib/Tie/File/t/20_cache_full.t b/lib/Tie/File/t/20_cache_full.t
index 4d3c432..8b3bf0b 100644
--- a/lib/Tie/File/t/20_cache_full.t
+++ b/lib/Tie/File/t/20_cache_full.t
@@ -31,7 +31,7 @@ my @z = @a;                     # force cache to contain all ten records
 # It should now contain only the *last* three records, 7, 8, and 9
 {
   my $x = "7 8 9";
-  my $a = join " ", sort $o->{cache}->keys;
+  my $a = join " ", sort $o->{cache}->ckeys;
   if ($a eq $x) { print "ok $N\n" }
   else { print "not ok $N # cache keys were <$a>; expected <$x>\n" }
   $N++;
@@ -182,7 +182,7 @@ for (5, 6, 1) { my $z = $a[$_] }
   else { print "not ok $N # LRU was <$a>; expected <$x>\n" }
   $N++;
   $x = "1 5 6";
-  $a = join " ", sort $o->{cache}->keys;
+  $a = join " ", sort $o->{cache}->ckeys;
   if ($a eq $x) { print "ok $N\n" }
   else { print "not ok $N # cache keys were <$a>; expected <$x>\n" }
   $N++;
diff --git a/lib/Tie/File/t/30_defer.t b/lib/Tie/File/t/30_defer.t
index 541b97f..7503829 100644
--- a/lib/Tie/File/t/30_defer.t
+++ b/lib/Tie/File/t/30_defer.t
@@ -254,7 +254,7 @@ sub check_caches {
 
   # Copy the contents of the cache into a regular hash
   my %cache;
-  for my $k ($o->{cache}->keys) {
+  for my $k ($o->{cache}->ckeys) {
     $cache{$k} = $o->{cache}->_produce($k);
   }
 
diff --git a/lib/Tie/File/t/40_abs_cache.t b/lib/Tie/File/t/40_abs_cache.t
index c4123b7..137c9bb 100644
--- a/lib/Tie/File/t/40_abs_cache.t
+++ b/lib/Tie/File/t/40_abs_cache.t
@@ -21,7 +21,7 @@
 #
 
 # print "1..0\n"; exit;
-print "1..26\n";
+print "1..42\n";
 
 my ($N, @R, $Q, $ar) = (1);
 
@@ -37,7 +37,7 @@ $N++;
 {
   my $good = 1;
   for my $meth (qw(new is_empty empty lookup remove
-                 insert update rekey expire keys bytes
+                 insert update rekey expire ckeys bytes
                    set_limit adj_limit flush  reduce_size_to
                    _produce _produce_lru )) {
     unless ($h->can($meth)) {
@@ -49,7 +49,7 @@ $N++;
   $N++;
 }
 
-# (4) Straight insert and removal FIFO test
+# (4-5) Straight insert and removal FIFO test
 $ar = 'a0';
 for (1..10) {
   $h->insert($_, $ar++);
@@ -62,13 +62,15 @@ $iota = iota('a',9);
 print "@R" eq $iota
   ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
 $N++;
+check($h);
 
-# (5) Remove from empty heap
+# (6-7) Remove from empty heap
 $n = $h->expire;
 print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
 $N++;
+check($h);
 
-# (6) Interleaved insert and removal
+# (8-9) Interleaved insert and removal
 $Q = 0;
 @R = ();
 for my $i (1..4) {
@@ -83,12 +85,13 @@ for my $i (1..4) {
 $iota = iota('b', 9);
 print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
 $N++;
+check($h);
 
-# (7) It should be empty now
+# (10) It should be empty now
 print $h->is_empty ? "ok $N\n" : "not ok $N\n";
 $N++;
 
-# (8) Insert and delete
+# (11-12) Insert and delete
 $Q = 1;
 for (1..10) {
   $h->insert($_, "c$Q");
@@ -102,8 +105,9 @@ push @R, $n while defined ($n = $h->expire);
 print "@R" eq "c1 c3 c5 c7 c9" ? 
   "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
 $N++;
+check($h);
 
-# (9) Interleaved insert and delete
+# (13-14) Interleaved insert and delete
 $Q = 1; my $QQ = 1;
 @R = ();
 for my $i (1..4) {
@@ -120,8 +124,9 @@ push @R, $n while defined ($n = $h->expire);
 print "@R" eq "d1 d3 d5 d7 d9" ? 
   "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
 $N++;
+check($h);
 
-# (10) Promote
+# (15-16) Promote
 $h->empty;
 $Q = 1;
 for (1..10) {
@@ -141,8 +146,9 @@ print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ?
     "ok $N\n" : 
     "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
 $N++;
+check($h);
 
-# (11-15) Lookup
+# (17-22) Lookup
 $Q = 1;
 for (1..10) {
   $h->insert($_, "f$Q");
@@ -154,20 +160,22 @@ for (2, 4, 6, 4, 8) {
   print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n";
   $N++;
 }
+check($h);
 
-# (16) It shouldn't be empty
+# (23) It shouldn't be empty
 print ! $h->is_empty ? "ok $N\n" : "not ok $N\n";
 $N++;
 
-# (17) Lookup should have promoted the looked-up records
+# (24-25) Lookup should have promoted the looked-up records
 @R = ();
 push @R, $n while defined ($n = $h->expire);
 print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ?
   "ok $N\n" : 
   "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
 $N++;
+check($h);
 
-# (18-19) Typical 'rekey' operation
+# (26-29) Typical 'rekey' operation
 $Q = 1;
 for (1..10) {
   $h->insert($_, "g$Q");
@@ -189,6 +197,7 @@ my %x = qw(1 g1 2 g2  3 g3  4 g4  5 g5
   print $good ? "ok $N\n" : "not ok $N\n";
   $N++;
 }
+check($h);
 {
   my $good = 1;
   for my $k (6, 7) {
@@ -201,51 +210,63 @@ my %x = qw(1 g1 2 g2  3 g3  4 g4  5 g5
   print $good ? "ok $N\n" : "not ok $N\n";
   $N++;
 }
+check($h);
 
-# (20) keys
-@R = sort { $a <=> $b } $h->keys;
+# (30-31) ckeys
+@R = sort { $a <=> $b } $h->ckeys;
 print "@R" eq "1 2 3 4 5 8 9 10 11 12" ?
   "ok $N\n" : 
   "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
 $N++;
+check($h);
 1;
-# (21) update
+# (32-33) update
 for (1..5, 8..12) {
   $h->update($_, "h$_");
 }
 @R = ();
-for (sort { $a <=> $b } $h->keys) {
+for (sort { $a <=> $b } $h->ckeys) {
   push @R, $h->lookup($_);
 }
 print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ?
   "ok $N\n" : 
   "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
 $N++;
+check($h);
 
-# (22-23) bytes
+# (34-37) bytes
 my $B;
 $B = $h->bytes;
 print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
 $N++;
+check($h);
 $h->update('12', "yobgorgle");
 $B = $h->bytes;
 print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
 $N++;
+check($h);
 
-# (24-25) empty
+# (38-41) empty
 $h->empty;
 print $h->is_empty ? "ok $N\n" : "not ok $N\n";
 $N++;
+check($h);
 $n = $h->expire;
 print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
 $N++;
+check($h);
 
-# (26) very weak testing of DESTROY
+# (42) very weak testing of DESTROY
 undef $h;
 # are we still alive?
 print "ok $N\n";
 $N++;
 
+sub check {
+  my $h = shift;
+  print $h->_check_integrity ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
 
 sub iota {
   my ($p, $n) = @_;