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 = "tf05-$$.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