1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use POSIX 'SEEK_SET'; 7 8my $file = "tf18-$$.txt"; 9$/ = "blah"; 10 11print "1..5\n"; 12 13my $N = 1; 14use Tie::File; 15print "ok $N\n"; $N++; 16 17my @a; 18my $o = tie @a, 'Tie::File', $file, autodefer => 0; 19print $o ? "ok $N\n" : "not ok $N\n"; 20$N++; 21 22$a[0] = 'rec0'; 23check_contents("rec0blah"); 24$a[1] = "rec1blah"; 25check_contents("rec0blahrec1blah"); 26$a[2] = "rec2blahblah"; # should we detect this? 27check_contents("rec0blahrec1blahrec2blahblah"); 28 29sub check_contents { 30 my $x = shift; 31 local *FH = $o->{fh}; 32 seek FH, 0, SEEK_SET; 33 my $a; 34 { local $/; $a = <FH> } 35 $a = "" unless defined $a; 36 if ($a eq $x) { 37 print "ok $N\n"; 38 } else { 39 my $msg = "not ok $N # expected <$x>, got <$a>"; 40 ctrlfix($msg); 41 print "$msg\n"; 42 } 43 $N++; 44} 45 46sub ctrlfix { 47 for (@_) { 48 s/\n/\\n/g; 49 s/\r/\\r/g; 50 } 51} 52 53END { 54 undef $o; 55 untie @a; 56 1 while unlink $file; 57} 58 59