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