Upgrade to Tie::File 0.15.

p4raw-id: //depot/perl@14970

16 files changed, 253 insertions, 77 deletions

diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm
index 9fc7eab689..8ae70a67b7 100644
--- a/lib/Tie/File.pm
+++ b/lib/Tie/File.pm
@@ -5,7 +5,7 @@ use POSIX 'SEEK_SET';
 use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX';
 require 5.005;
 
-$VERSION = "0.14";
+$VERSION = "0.15";
 
 # Idea: The object will always contain an array of byte offsets
 # this will be filled in as is necessary and convenient.
@@ -153,7 +153,10 @@ sub PUSH {
 
 sub POP {
   my $self = shift;
-  scalar $self->SPLICE(-1, 1);
+  my $size = $self->FETCHSIZE;
+  return if $size == 0;
+#  print STDERR "# POPPITY POP POP POP\n";
+  scalar $self->SPLICE($size-1, 1);
 }
 
 sub SHIFT {
@@ -207,8 +210,13 @@ sub SPLICE {
   my ($self, $pos, $nrecs, @data) = @_;
   my @result;
 
+  $pos = 0 unless defined $pos;
+
+  # Deal with negative and other out-of-range positions
+  # Also set default for $nrecs 
   {
     my $oldsize = $self->FETCHSIZE;
+    $nrecs = $oldsize unless defined $nrecs;
     my $oldpos = $pos;
 
     if ($pos < 0) {
@@ -525,9 +533,10 @@ sub flock {
 sub _check_integrity {
   my ($self, $file, $warn) = @_;
   my $good = 1; 
-  local *F;
-  open F, $file or die "Couldn't open file $file: $!";
-  binmode F;
+  local *F = $self->{fh};
+  seek F, 0, SEEK_SET;
+#  open F, $file or die "Couldn't open file $file: $!";
+#  binmode F;
   local $/ = $self->{recsep};
   unless ($self->{offsets}[0] == 0) {
     $warn && print STDERR "# rec 0: offset <$self->{offsets}[0]> s/b 0!\n";
@@ -592,7 +601,7 @@ Tie::File - Access the lines of a disk file via a Perl array
 
 =head1 SYNOPSIS
 
-	# This file documents Tie::File version 0.14
+	# This file documents Tie::File version 0.15
 
 	tie @array, 'Tie::File', filename or die ...;
 
@@ -660,7 +669,7 @@ is C<"\n">, then the following two lines do exactly the same thing:
 
 The result is that the contents of line 17 of the file will be
 replaced with "Cherry pie"; a newline character will separate line 17
-from line 18.  This means that inparticular, this will do nothing:
+from line 18.  This means that in particular, this will do nothing:
 
 	chomp $array[17];
 
@@ -778,9 +787,9 @@ lines 1 through 999,999; the second iteration must relocate lines 2
 through 999,999, and so on.  The relocation is done using block
 writes, however, so it's not as slow as it might be.
 
-A future version of this module will provide some mechanism for
-getting better performance in such cases, by deferring the writing
-until it can be done all at once.
+A future version of this module will provide a mechanism for getting
+better performance in such cases, by deferring the writing until it
+can be done all at once.
 
 =head2 Efficiency Note 2
 
@@ -829,22 +838,25 @@ C<mjd-perl-tiefile-subscribe@plover.com>.
 
 =head1 LICENSE
 
-C<Tie::File> version 0.14 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.15 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.
 
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
+These terms include your choice of (1) the Perl Artistic Licence, or
+(2) version 2 of the GNU General Public License as published by the
+Free Software Foundation, or (3) any later version of the GNU General
+Public License.
 
-This program is distributed in the hope that it will be useful,
+This library is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
-along with this program; it should be in the file C<COPYING>.  If not,
-write to the Free Software Foundation, Inc., 59 Temple Place, Suite
-330, Boston, MA 02111 USA
+along with this library program; it should be in the file C<COPYING>.
+If not, write to the Free Software Foundation, Inc., 59 Temple Place,
+Suite 330, Boston, MA 02111 USA
 
 For licensing inquiries, contact the author at:
 
@@ -854,11 +866,13 @@ For licensing inquiries, contact the author at:
 
 =head1 WARRANTY
 
-C<Tie::File> version 0.14 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.15 comes with ABSOLUTELY NO WARRANTY.
 For details, see the license.
 
 =head1 TODO
 
+Allow tie to seekable filehandle rather than named file.
+
 Tests for default arguments to SPLICE.  Tests for CLEAR/EXTEND.
 Tests for DELETE/EXISTS.
 
diff --git a/lib/Tie/File/01_gen.t b/lib/Tie/File/t/01_gen.t
index d69d232b67..d0ccb7177d 100644
--- a/lib/Tie/File/01_gen.t
+++ b/lib/Tie/File/t/01_gen.t
@@ -63,27 +63,41 @@ check_contents("sh0", "sh1", "short2", "rec3", "rec4");
 
 # try inserting a record into the middle of an empty file
 
-
+use POSIX 'SEEK_SET';
 sub check_contents {
   my @c = @_;
   my $x = join $/, @c, '';
-  local *FH;
-  my $open = open FH, "< $file";
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+#  my $open = open FH, "< $file";
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N # file @c\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 
   # now check FETCH:
   my $good = 1;
+  my $msg;
   for (0.. $#c) {
-    $good = 0 unless $a[$_] eq "$c[$_]$/";
+    unless ($a[$_] eq "$c[$_]$/") {
+      $msg = "expected $c[$_]$/, got $a[$_]";
+      $msg =~ s{$/}{\\n}g;
+      $good = 0;
+    }
   }
-  print (($open && $good) ? "ok $N\n" : "not ok $N # fetch @c\n");
+  print $good ? "ok $N\n" : "not ok $N # $msg\n";
   $N++;
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/02_fetchsize.t b/lib/Tie/File/t/02_fetchsize.t
index b7ea3a5dbc..78fcea8809 100644
--- a/lib/Tie/File/02_fetchsize.t
+++ b/lib/Tie/File/t/02_fetchsize.t
@@ -43,6 +43,8 @@ print $q eq $data ? "ok $N\n" : "not ok $N # n=$n\n";
 $N++;
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/03_longfetch.t b/lib/Tie/File/t/03_longfetch.t
index 83f011ef82..a84890a651 100644
--- a/lib/Tie/File/03_longfetch.t
+++ b/lib/Tie/File/t/03_longfetch.t
@@ -34,6 +34,8 @@ for (2, 1, 0) {
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/04_splice.t b/lib/Tie/File/t/04_splice.t
index f8628a2e11..e291809d3f 100644
--- a/lib/Tie/File/04_splice.t
+++ b/lib/Tie/File/t/04_splice.t
@@ -13,7 +13,9 @@
 my $file = "tf$$.txt";
 my $data = "rec0$/rec1$/rec2$/";
 
-print "1..97\n";
+print "1..101\n";
+
+init_file($data);
 
 my $N = 1;
 use Tie::File;
@@ -26,8 +28,6 @@ $N++;
 my $n;
 
 # (3-22) splicing at the beginning
-init_file($data);
-
 splice(@a, 0, 0, "rec4");
 check_contents("rec4$/$data");
 splice(@a, 0, 1, "rec5");       # same length
@@ -162,6 +162,12 @@ if ($] < 5.006 || $] > 5.007002) {
 }
 $N++;
        
+# (98-101) Test default arguments
+splice @a, 0, 0, (0..11);
+splice @a, 4;
+check_contents("0$/1$/2$/3$/");
+splice @a;
+check_contents("");
     
 
 sub init_file {
@@ -172,21 +178,29 @@ sub init_file {
   close F;
 }
 
+use POSIX 'SEEK_SET';
 sub check_contents {
   my $x = shift;
-  local *FH;
   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 $open = open FH, "< $file";
-  binmode FH;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/05_size.t b/lib/Tie/File/t/05_size.t
index f7a327141e..dbc2c0a5f0 100644
--- a/lib/Tie/File/05_size.t
+++ b/lib/Tie/File/t/05_size.t
@@ -4,6 +4,8 @@
 # PUSH POP SHIFT UNSHIFT
 #
 
+use POSIX 'SEEK_SET';
+
 my $file = "tf$$.txt";
 my $data = "rec0$/rec1$/rec2$/";
 my ($o, $n);
@@ -65,17 +67,24 @@ check_contents('');
 
 sub check_contents {
   my $x = shift;
-  local *FH;
-  my $open = open FH, "< $file";
-  binmode FH;
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/06_fixrec.t b/lib/Tie/File/t/06_fixrec.t
index f191921f36..62e55798d7 100644
--- a/lib/Tie/File/06_fixrec.t
+++ b/lib/Tie/File/t/06_fixrec.t
@@ -1,5 +1,6 @@
 #!/usr/bin/perl
 
+use POSIX 'SEEK_SET';
 my $file = "tf$$.txt";
 
 print "1..5\n";
@@ -21,17 +22,24 @@ check_contents("rec0$/rec1$/rec2$/$/");
 
 sub check_contents {
   my $x = shift;
-  local *FH;
-  my $open = open FH, "< $file";
-  binmode FH;
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/07_rv_splice.t b/lib/Tie/File/t/07_rv_splice.t
index 75c8a3af51..f5da174b69 100644
--- a/lib/Tie/File/07_rv_splice.t
+++ b/lib/Tie/File/t/07_rv_splice.t
@@ -7,12 +7,14 @@
 my $file = "tf$$.txt";
 my $data = "rec0$/rec1$/rec2$/";
 
-print "1..48\n";
+print "1..50\n";
 
 my $N = 1;
 use Tie::File;
 print "ok $N\n"; $N++;  # partial credit just for showing up
 
+init_file($data);
+
 my $o = tie @a, 'Tie::File', $file;
 print $o ? "ok $N\n" : "not ok $N\n";
 $N++;
@@ -20,8 +22,6 @@ $N++;
 my $n;
 
 # (3-12) splicing at the beginning
-init_file($data);
-
 @r = splice(@a, 0, 0, "rec4");
 check_result();
 @r = splice(@a, 0, 1, "rec5");       # same length
@@ -145,6 +145,12 @@ $r = splice(@a, 0, 2);
 print $r eq "like$/" ? "ok $N\n" : "not ok $N \# return should have been 'like'\n";
 $N++;
 
+# (49-50) Test default arguments
+splice @a, 0, 0, (0..11);
+@r = splice @a, 4;
+check_result(4..11);
+@r = splice @a;
+check_result(0..3);
 
 sub init_file {
   my $data = shift;
@@ -169,6 +175,8 @@ sub check_result {
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/08_ro.t b/lib/Tie/File/t/08_ro.t
index 2dbe2397e4..245b16f70c 100644
--- a/lib/Tie/File/08_ro.t
+++ b/lib/Tie/File/t/08_ro.t
@@ -37,6 +37,8 @@ sub init_file {
 
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t
index d5afbe177d..bb2fb26c53 100644
--- a/lib/Tie/File/09_gen_rs.t
+++ b/lib/Tie/File/t/09_gen_rs.t
@@ -64,28 +64,40 @@ check_contents("sh0", "sh1", "short2", "rec3", "rec4");
 
 # try inserting a record into the middle of an empty file
 
-
+use POSIX 'SEEK_SET';
 sub check_contents {
   my @c = @_;
   my $x = join 'blah', @c, '';
-  local *FH;
-  my $open = open FH, "< $file";
-  binmode FH;
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N # file @c\n");
+
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 
   # now check FETCH:
   my $good = 1;
   for (0.. $#c) {
-    $good = 0 unless $a[$_] eq "$c[$_]blah";
+    unless ($a[$_] eq "$c[$_]blah") {
+      $msg = "expected $c[$_]blah, got $a[$_]";
+      $msg =~ s{$/}{\\n}g;
+      $good = 0;
+    }
   }
-  print (($open && $good) ? "ok $N\n" : "not ok $N # fetch @c\n");
+  print $good ? "ok $N\n" : "not ok $N # fetch @c\n";
   $N++;
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/10_splice_rs.t b/lib/Tie/File/t/10_splice_rs.t
index 94f3d01539..9e0788cddd 100644
--- a/lib/Tie/File/10_splice_rs.t
+++ b/lib/Tie/File/t/10_splice_rs.t
@@ -10,15 +10,19 @@
 # Then, it checks the actual contents of the file against the expected
 # contents.
 
+use POSIX 'SEEK_SET';
+
 my $file = "tf$$.txt";
 my $data = "rec0blahrec1blahrec2blah";
 
-print "1..88\n";
+print "1..101\n";
 
 my $N = 1;
 use Tie::File;
 print "ok $N\n"; $N++;  # partial credit just for showing up
 
+init_file($data);
+
 my $o = tie @a, 'Tie::File', $file, recsep => 'blah';
 print $o ? "ok $N\n" : "not ok $N\n";
 $N++;
@@ -26,8 +30,6 @@ $N++;
 my $n;
 
 # (3-22) splicing at the beginning
-init_file($data);
-
 splice(@a, 0, 0, "rec4");
 check_contents("rec4blah$data");
 splice(@a, 0, 1, "rec5");       # same length
@@ -136,6 +138,40 @@ check_contents("rec0blahrec1blah");
 splice(@a, 0, 17);
 check_contents("");
 
+# (89-92) In the past, splicing past the end was not correctly detected
+# (1.14)
+splice(@a, 89, 3);
+check_contents("");
+splice(@a, @a, 3);
+check_contents("");
+
+# (93-96) Also we did not emulate splice's freaky behavior when inserting
+# past the end of the array (1.14)
+splice(@a, 89, 0, "I", "like", "pie");
+check_contents("Iblahlikeblahpieblah");
+splice(@a, 89, 0, "pie pie pie");
+check_contents("Iblahlikeblahpieblahpie pie pieblah");
+
+# (97) Splicing with too large a negative number should be fatal
+# This test ignored because it causes 5.6.1 and 5.7.2 to dump core
+# NOT MY FAULT
+if ($] < 5.006 || $] > 5.007002) {
+  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.7.2 dump core here.)\n";
+}
+$N++;
+       
+# (98-101) Test default arguments
+splice @a, 0, 0, (0..11);
+splice @a, 4;
+check_contents("0blah1blah2blah3blah");
+splice @a;
+check_contents("");
+
+
 sub init_file {
   my $data = shift;
   open F, "> $file" or die $!;
@@ -146,18 +182,26 @@ sub init_file {
 
 sub check_contents {
   my $x = shift;
-  local *FH;
   my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
   print $integrity ? "ok $N\n" : "not ok $N\n";
   $N++;
-  my $open = open FH, "< $file";
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/11_rv_splice_rs.t b/lib/Tie/File/t/11_rv_splice_rs.t
index 654b661e8d..ae3c9b3141 100644
--- a/lib/Tie/File/11_rv_splice_rs.t
+++ b/lib/Tie/File/t/11_rv_splice_rs.t
@@ -7,12 +7,14 @@
 my $file = "tf$$.txt";
 my $data = "rec0blahrec1blahrec2blah";
 
-print "1..45\n";
+print "1..50\n";
 
 my $N = 1;
 use Tie::File;
 print "ok $N\n"; $N++;  # partial credit just for showing up
 
+init_file($data);
+
 my $o = tie @a, 'Tie::File', $file, recsep => 'blah';
 print $o ? "ok $N\n" : "not ok $N\n";
 $N++;
@@ -20,8 +22,6 @@ $N++;
 my $n;
 
 # (3-12) splicing at the beginning
-init_file($data);
-
 @r = splice(@a, 0, 0, "rec4");
 check_result();
 @r = splice(@a, 0, 1, "rec5");       # same length
@@ -130,6 +130,28 @@ check_result();
 @r = splice(@a, 0, 17);
 check_result('rec0', 'rec1');
 
+# (46-48) Now check the scalar context return
+splice(@a, 0, 0, qw(I like pie));
+my $r;
+$r = splice(@a, 0, 0);
+print !defined($r) ? "ok $N\n" : "not ok $N \# return should have been undef\n";
+$N++;
+
+$r = splice(@a, 2, 1);
+print $r eq "pieblah" ? "ok $N\n" : "not ok $N \# return should have been 'pie'\n";
+$N++;
+
+$r = splice(@a, 0, 2);
+print $r eq "likeblah" ? "ok $N\n" : "not ok $N \# return should have been 'like'\n";
+$N++;
+
+# (49-50) Test default arguments
+splice @a, 0, 0, (0..11);
+@r = splice @a, 4;
+check_result(4..11);
+@r = splice @a;
+check_result(0..3);
+
 sub init_file {
   my $data = shift;
   open F, "> $file" or die $!;
@@ -153,6 +175,8 @@ sub check_result {
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/12_longfetch_rs.t b/lib/Tie/File/t/12_longfetch_rs.t
index de40e923c6..2d1a3bb6b7 100644
--- a/lib/Tie/File/12_longfetch_rs.t
+++ b/lib/Tie/File/t/12_longfetch_rs.t
@@ -34,6 +34,8 @@ for (2, 1, 0) {
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/13_size_rs.t b/lib/Tie/File/t/13_size_rs.t
index 254f3ab0b0..284d2d3307 100644
--- a/lib/Tie/File/13_size_rs.t
+++ b/lib/Tie/File/t/13_size_rs.t
@@ -4,6 +4,8 @@
 # PUSH POP SHIFT UNSHIFT
 #
 
+use POSIX 'SEEK_SET';
+
 my $file = "tf$$.txt";
 my $data = "rec0blahrec1blahrec2blah";
 my ($o, $n);
@@ -63,16 +65,24 @@ check_contents('');
 
 sub check_contents {
   my $x = shift;
-  local *FH;
-  my $open = open FH, "< $file";
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/14_lock.t b/lib/Tie/File/t/14_lock.t
index a771d8deef..cab48125b0 100644
--- a/lib/Tie/File/14_lock.t
+++ b/lib/Tie/File/t/14_lock.t
@@ -8,6 +8,14 @@
 # portable test for flocking.  I checked the Perl core distribution,
 # and found that Perl doesn't test flock either!
 
+BEGIN {
+  eval { flock STDOUT, 0 };
+  if ($@ && $@ =~ /unimplemented/) {
+    print "1..0\n";
+    exit;
+  }
+}
+
 use Fcntl ':flock';             # This works at least back to 5.004_04
 
 my $file = "tf$$.txt";
@@ -35,6 +43,8 @@ $N++;
 
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/15_pushpop.t b/lib/Tie/File/t/15_pushpop.t
index 76fe4c1653..79af19a7d5 100644
--- a/lib/Tie/File/15_pushpop.t
+++ b/lib/Tie/File/t/15_pushpop.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 #
-# Check PUSH, POP, SHIF, and UNSHIFT 
+# Check PUSH, POP, SHIFT, and UNSHIFT 
 #
 # Each call to 'check_contents' actually performs two tests.
 # First, it calls the tied object's own 'check_integrity' method,
@@ -9,7 +9,8 @@
 # Then, it checks the actual contents of the file against the expected
 # contents.
 
-use lib '/home/mjd/src/perl/Tie-File2/lib';
+use POSIX 'SEEK_SET';
+
 my $file = "tf$$.txt";
 1 while unlink $file;
 my $data = "rec0$/rec1$/rec2$/";
@@ -99,29 +100,29 @@ print ! defined $n ? "ok $N\n" : "not ok $N # last rec should be undef, is $n\n"
 $N++;
 
 
-sub init_file {
-  my $data = shift;
-  open F, "> $file" or die $!;
-  binmode F;
-  print F $data;
-  close F;
-}
-
 sub check_contents {
   my $x = shift;
-  local *FH;
   my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
   print $integrity ? "ok $N\n" : "not ok $N\n";
   $N++;
-  my $open = open FH, "< $file";
-  binmode FH;
+
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
   my $a;
   { local $/; $a = <FH> }
-  print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    s{$/}{\\n}g for $a, $x;
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
   $N++;
 }
 
 END {
+  undef $o;
+  untie @a;
   1 while unlink $file;
 }