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 = "tf05-$$.txt"; 13my ($o, $n); 14 15print "1..16\n"; 16 17my $N = 1; 18use Tie::File; 19print "ok $N\n"; $N++; 20 21# 2-3 FETCHSIZE 0-length file 22open F, '>', $file or die $!; 23binmode F; 24close F; 25 26my @a; 27$o = tie @a, 'Tie::File', $file; 28print $o ? "ok $N\n" : "not ok $N\n"; 29$N++; 30 31$: = $o->{recsep}; 32 33$n = @a; 34print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; 35$N++; 36 37# Reset everything 38undef $o; 39untie @a; 40 41my $data = "rec0$:rec1$:rec2$:"; 42open F, '>', $file or die $!; 43binmode F; 44print F $data; 45close F; 46 47$o = tie @a, 'Tie::File', $file; 48print $o ? "ok $N\n" : "not ok $N\n"; 49$N++; 50 51# 4-5 FETCHSIZE positive-length file 52$n = @a; 53print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; 54$N++; 55 56# STORESIZE 57# (6-7) Make it longer: 58populate(); 59$#a = 4; 60check_contents("$data$:$:"); 61 62# (8-9) Make it longer again: 63populate(); 64$#a = 6; 65check_contents("$data$:$:$:$:"); 66 67# (10-11) Make it shorter: 68populate(); 69$#a = 4; 70check_contents("$data$:$:"); 71 72# (12-13) Make it shorter again: 73populate(); 74$#a = 2; 75check_contents($data); 76 77# (14-15) Get rid of it completely: 78populate(); 79$#a = -1; 80check_contents(''); 81 82# (16) 20020324 I have an idea that shortening the array will not 83# expunge a cached record at the end if one is present. 84$o->defer; 85$a[3] = "record"; 86my $r = $a[3]; 87$#a = -1; 88$r = $a[3]; 89print (! defined $r ? "ok $N\n" : "not ok $N \# was <$r>; should be UNDEF\n"); 90# Turns out not to be the case---STORESIZE explicitly removes them later 91# 20020326 Well, but happily, this test did fail today. 92 93# In the past, there was a bug in STORESIZE that it didn't correctly 94# remove deleted records from the cache. This wasn't detected 95# because these tests were all done with an empty cache. populate() 96# will ensure that the cache is fully populated. 97sub populate { 98 my $z; 99 $z = $a[$_] for 0 .. $#a; 100} 101 102sub check_contents { 103 my $x = shift; 104 local *FH = $o->{fh}; 105 seek FH, 0, SEEK_SET; 106 my $a; 107 { local $/; $a = <FH> } 108 $a = "" unless defined $a; 109 if ($a eq $x) { 110 print "ok $N\n"; 111 } else { 112 ctrlfix($a, $x); 113 print "not ok $N\n# expected <$x>, got <$a>\n"; 114 } 115 $N++; 116 my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY}); 117 print $integrity ? "ok $N\n" : "not ok $N \# integrity\n"; 118 $N++; 119} 120 121 122sub ctrlfix { 123 for (@_) { 124 s/\n/\\n/g; 125 s/\r/\\r/g; 126 } 127} 128 129END { 130 undef $o; 131 untie @a; 132 1 while unlink $file; 133} 134 135