Upgrade to Tie::File 0.93, from mjd.

p4raw-id: //depot/perl@15721

5 files changed, 14 insertions, 269 deletions

diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm
index 533f5b9d32..637d6cf8ca 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.92";
+$VERSION = "0.93";
 my $DEFAULT_MEMORY_SIZE = 1<<21;    # 2 megabytes
 my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
 my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
@@ -1667,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.92
+	# This file documents Tie::File version 0.93
 
 	tie @array, 'Tie::File', filename or die ...;
 
@@ -2162,7 +2162,7 @@ any news of importance, will be available at
 
 =head1 LICENSE
 
-C<Tie::File> version 0.92 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.93 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.
@@ -2190,7 +2190,7 @@ For licensing inquiries, contact the author at:
 
 =head1 WARRANTY
 
-C<Tie::File> version 0.92 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.93 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 afab13fde2..71c1c823f2 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.92";
+my $testversion = "0.93";
 use Tie::File;
 
 if ($Tie::File::VERSION != $testversion) {
diff --git a/lib/Tie/File/t/04_splice.t b/lib/Tie/File/t/04_splice.t
index 2ef95cc685..cb08dac464 100644
--- a/lib/Tie/File/t/04_splice.t
+++ b/lib/Tie/File/t/04_splice.t
@@ -157,12 +157,12 @@ check_contents("I$:like$:pie$:pie pie pie$:");
 # This test ignored because it causes 5.6.1 and 5.7.3 to dump core
 # It also garbles the stack under 5.005_03 (20020401)
 # NOT MY FAULT
-if ($] > 5.008) {
+if ($] > 5.007003) {
   eval { splice(@a, -7, 0) };
   print $@ =~ /^Modification of non-creatable array value attempted, subscript -7/
       ? "ok $N\n" : "not ok $N \# \$\@ was '$@'\n";
 } else { 
-  print "ok $N \# skipped (5.6.0 through 5.8 dump core here.)\n";
+  print "ok $N \# skipped (versions through 5.7.3 dump core here.)\n";
 }
 $N++;
        
diff --git a/lib/Tie/File/t/10_splice_rs.t b/lib/Tie/File/t/10_splice_rs.t
index f901bc876f..50b8b0a7ee 100644
--- a/lib/Tie/File/t/10_splice_rs.t
+++ b/lib/Tie/File/t/10_splice_rs.t
@@ -156,12 +156,12 @@ check_contents("Iblahlikeblahpieblahpie pie pieblah");
 # This test ignored because it causes 5.6.1 and 5.7.3 to dump core
 # It also garbles the stack under 5.005_03 (20020401)
 # NOT MY FAULT
-if ($] > 5.008) {
+if ($] > 5.007003) {
   eval { splice(@a, -7, 0) };
   print $@ =~ /^Modification of non-creatable array value attempted, subscript -7/
       ? "ok $N\n" : "not ok $N \# \$\@ was '$@'\n";
 } else { 
-  print "ok $N \# skipped (5.6.0 through 5.8 dump core here.)\n";
+  print "ok $N \# skipped (versions through 5.7.3 dump core here.)\n";
 }
 $N++;
 
diff --git a/lib/Tie/File/t/41_heap.t b/lib/Tie/File/t/41_heap.t
index efd34caeac..9e7ad2516c 100644
--- a/lib/Tie/File/t/41_heap.t
+++ b/lib/Tie/File/t/41_heap.t
@@ -17,12 +17,11 @@
 
 
 # Finish these later.
-# They're nonurgent because the important heap stuff is extensively tested by 
-# test 19, 20, 24, 30, 32, 33, and 40, as well as pretty much everything else.
-print "1..0\n"; exit;
 
-__END__
-print "1..19\n";
+# They're nonurgent because the important heap stuff is extensively
+# tested by tests 19, 20, 24, 30, 32, 33, and 40, as well as by pretty
+# much everything else.
+print "1..1\n";
 
 
 my ($N, @R, $Q, $ar) = (1);
@@ -30,263 +29,9 @@ my ($N, @R, $Q, $ar) = (1);
 use Tie::File;
 print "ok $N\n";
 $N++;
-
-my @HEAP_MOVE;
-sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
-
-my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
-print "ok $N\n";
-$N++;
-
-# (3) Are all the methods there?
-{
-  my $good = 1;
-  for my $meth (qw(new is_empty empty lookup insert remove popheap
-                   promote set_val rekey expire_order)) {
-    unless ($h->can($meth)) {
-      print STDERR "# Method '$meth' is missing.\n";
-      $good = 0;
-    }
-  }
-  print $good ? "ok $N\n" : "not ok $N\n";
-  $N++;
-}
-
-# (4) Straight insert and removal FIFO test
-$ar = 'a0';
-for (1..10) {
-  $h->insert($_, $ar++);
-}
-for (1..10) {
-  push @R, $h->popheap;
-}
-$iota = iota('a',9);
-print "@R" eq $iota
-  ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
-$N++;
-
-# (5) Remove from empty heap
-$n = $h->popheap;
-print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
-$N++;
-
-# (6) Interleaved insert and removal
-$Q = 0;
-@R = ();
-for my $i (1..4) {
-  for my $j (1..$i) {
-    $h->insert($Q, "b$Q");
-    $Q++;
-  }
-  for my $j (1..$i) {
-    push @R, $h->popheap;
-  }
-}
-$iota = iota('b', 9);
-print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
-$N++;
-
-# (7) It should be empty now
-print $h->is_empty ? "ok $N\n" : "not ok $N\n";
-$N++;
-
-# (8) Insert and delete
-$Q = 1;
-for (1..10) {
-  $h->insert($_, "c$Q");
-  $Q++;
-}
-for (2, 4, 6, 8, 10) {
-  $h->remove($_);
-}
-@R = ();
-push @R, $n while defined ($n = $h->popheap);
-print "@R" eq "c1 c3 c5 c7 c9" ? 
-  "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
-$N++;
-
-# (9) Interleaved insert and delete
-$Q = 1; my $QQ = 1;
-@R = ();
-for my $i (1..4) {
-  for my $j (1..$i) {
-    $h->insert($Q, "d$Q");
-    $Q++;
-  }
-  for my $j (1..$i) {
-    $h->remove($QQ) if $QQ % 2 == 0;
-    $QQ++;
-  }
-}
-push @R, $n while defined ($n = $h->popheap);
-print "@R" eq "d1 d3 d5 d7 d9" ? 
-  "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
-$N++;
-
-# (10) Promote
-$Q = 1;
-for (1..10) {
-  $h->insert($_, "e$Q");
-  $Q++;
-}
-for (2, 4, 6, 8, 10) {
-  $h->promote($_);
-}
-@R = ();
-push @R, $n while defined ($n = $h->popheap);
-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++;
-
-# (11-15) Lookup
-$Q = 1;
-for (1..10) {
-  $h->insert($_, "f$Q");
-  $Q++;
-}
-for (2, 4, 6, 4, 8) {
-  my $r = $h->lookup($_);
-  print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n";
-  $N++;
-}
-
-# (16) 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
-@R = ();
-push @R, $n while defined ($n = $h->popheap);
-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++;
-
-# (18-19) Typical 'rekey' operation
-$Q = 1;
-for (1..10) {
-  $h->insert($_, "g$Q");
-  $Q++;
-}
-
-$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
-my %x = qw(1 g1 2 g2  3 g3  4 g4  5 g5
-           8 g6 9 g7 10 g8 11 g9 12 g10);
-{
-  my $good = 1;
-  for my $k (keys %x) {
-    my $v = $h->lookup($k);
-    $v = "UNDEF" unless defined $v;
-    unless ($v eq $x{$k}) {
-      print "# looked up $k, got $v, expected $x{$k}\n";
-      $good = 0;
-    }
-  }
-  print $good ? "ok $N\n" : "not ok $N\n";
-  $N++;
-}
-{
-  my $good = 1;
-  for my $k (6, 7) {
-    my $v = $h->lookup($k);
-    if (defined $v) {
-      print "# looked up $k, got $v, should have been undef\n";
-      $good = 0;
-    }
-  }
-  print $good ? "ok $N\n" : "not ok $N\n";
-  $N++;
-}
-
-# (20) keys
-@R = sort { $a <=> $b } $h->keys;
-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++;
-
-# (21) update
-for (1..5, 8..12) {
-  $h->update($_, "h$_");
-}
-@R = ();
-for (sort { $a <=> $b } $h->keys) {
-  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++;
-
-# (22-23) bytes
-my $B;
-$B = $h->bytes;
-print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
-$N++;
-$h->update('12', "yobgorgle");
-$B = $h->bytes;
-print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
-$N++;
-
-# (24-25) empty
-$h->empty;
-print $h->is_empty ? "ok $N\n" : "not ok $N\n";
-$N++;
-$n = $h->popheap;
-print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
-$N++;
-
-# (26) very weak testing of DESTROY
-undef $h;
-# are we still alive?
-print "ok $N\n";
-$N++;
-
-
-sub iota {
-  my ($p, $n) = @_;
-  my $r;
-  my $i = 0;
-  while ($i <= $n) {
-    $r .= "$p$i ";
-    $i++;
-  }
-  chop $r;
-  $r;
-}
-#!/usr/bin/perl
-#
-# Unit tests for heap implementation
-#
-# Test the following methods:
-# new
-# is_empty
-# empty
-# insert
-# remove
-# popheap
-# promote
-# lookup
-# set_val
-# rekey
-# expire_order
-
-
-# Finish these later.
-# They're nonurgent because the important heap stuff is extensively tested by 
-# test 19, 20, 24, 30, 32, 33, and 40, as well as pretty much everything else.
-print "1..0\n"; exit;
+exit;
 
 __END__
-print "1..19\n";
-
-
-my ($N, @R, $Q, $ar) = (1);
-
-use Tie::File;
-print "ok $N\n";
-$N++;
 
 my @HEAP_MOVE;
 sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }