1#!/usr/bin/perl 2# 3# Check FETCHSIZE and SETSIZE functions 4# PUSH POP SHIFT UNSHIFT 5# 6 7use POSIX 'SEEK_SET'; 8 9my $file = "tf13-$$.txt"; 10my $data = "rec0blahrec1blahrec2blah"; 11my ($o, $n); 12 13print "1..10\n"; 14 15my $N = 1; 16use Tie::File; 17print "ok $N\n"; $N++; 18 19# 2-3 FETCHSIZE 0-length file 20open F, '>', $file or die $!; 21close F; 22$o = tie @a, 'Tie::File', $file, recsep => 'blah'; 23print $o ? "ok $N\n" : "not ok $N\n"; 24$N++; 25$n = @a; 26print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; 27$N++; 28 29# Reset everything 30undef $o; 31untie @a; 32 33# 4-5 FETCHSIZE positive-length file 34open F, '>', $file or die $!; 35print F $data; 36close F; 37$o = tie @a, 'Tie::File', $file, recsep => 'blah'; 38print $o ? "ok $N\n" : "not ok $N\n"; 39$N++; 40$n = @a; 41print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; 42$N++; 43 44# STORESIZE 45# 6 Make it longer: 46$#a = 4; 47check_contents("${data}blahblah"); 48 49# 7 Make it longer again: 50$#a = 6; 51check_contents("${data}blahblahblahblah"); 52 53# 8 Make it shorter: 54$#a = 4; 55check_contents("${data}blahblah"); 56 57# 9 Make it shorter again: 58$#a = 2; 59check_contents($data); 60 61# 10 Get rid of it completely: 62$#a = -1; 63check_contents(''); 64 65 66sub check_contents { 67 my $x = shift; 68 local *FH = $o->{fh}; 69 seek FH, 0, SEEK_SET; 70 my $a; 71 { local $/; $a = <FH> } 72 $a = "" unless defined $a; 73 if ($a eq $x) { 74 print "ok $N\n"; 75 } else { 76 ctrlfix(my $msg = "# expected <$x>, got <$a>"); 77 print "not ok $N\n$msg\n"; 78 } 79 $N++; 80} 81 82 83sub ctrlfix { 84 for (@_) { 85 s/\n/\\n/g; 86 s/\r/\\r/g; 87 } 88} 89 90END { 91 undef $o; 92 untie @a; 93 1 while unlink $file; 94} 95 96