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