Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Check FETCHSIZE and SETSIZE functions |
4 | # PUSH POP SHIFT UNSHIFT |
5 | # |
6 | |
7b6b3db1 |
7 | use POSIX 'SEEK_SET'; |
8 | |
b5aed31e |
9 | my $file = "tf$$.txt"; |
b5aed31e |
10 | my ($o, $n); |
11 | |
6fc0ea7e |
12 | print "1..16\n"; |
b5aed31e |
13 | |
14 | my $N = 1; |
15 | use Tie::File; |
16 | print "ok $N\n"; $N++; |
17 | |
18 | # 2-3 FETCHSIZE 0-length file |
19 | open F, "> $file" or die $!; |
1768807e |
20 | binmode F; |
b5aed31e |
21 | close F; |
22 | $o = tie @a, 'Tie::File', $file; |
23 | print $o ? "ok $N\n" : "not ok $N\n"; |
24 | $N++; |
b3fe5a4c |
25 | |
26 | $: = $o->{recsep}; |
27 | |
b5aed31e |
28 | $n = @a; |
29 | print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; |
30 | $N++; |
31 | |
32 | # Reset everything |
33 | undef $o; |
34 | untie @a; |
35 | |
b3fe5a4c |
36 | my $data = "rec0$:rec1$:rec2$:"; |
b5aed31e |
37 | open F, "> $file" or die $!; |
1768807e |
38 | binmode F; |
b5aed31e |
39 | print F $data; |
40 | close F; |
b3fe5a4c |
41 | |
b5aed31e |
42 | $o = tie @a, 'Tie::File', $file; |
43 | print $o ? "ok $N\n" : "not ok $N\n"; |
44 | $N++; |
b3fe5a4c |
45 | |
46 | # 4-5 FETCHSIZE positive-length file |
b5aed31e |
47 | $n = @a; |
48 | print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n"; |
49 | $N++; |
50 | |
51 | # STORESIZE |
836d9961 |
52 | # (6-7) Make it longer: |
53 | populate(); |
b5aed31e |
54 | $#a = 4; |
b3fe5a4c |
55 | check_contents("$data$:$:"); |
b5aed31e |
56 | |
836d9961 |
57 | # (8-9) Make it longer again: |
58 | populate(); |
b5aed31e |
59 | $#a = 6; |
b3fe5a4c |
60 | check_contents("$data$:$:$:$:"); |
b5aed31e |
61 | |
836d9961 |
62 | # (10-11) Make it shorter: |
63 | populate(); |
b5aed31e |
64 | $#a = 4; |
b3fe5a4c |
65 | check_contents("$data$:$:"); |
b5aed31e |
66 | |
836d9961 |
67 | # (12-13) Make it shorter again: |
68 | populate(); |
b5aed31e |
69 | $#a = 2; |
70 | check_contents($data); |
71 | |
836d9961 |
72 | # (14-15) Get rid of it completely: |
73 | populate(); |
b5aed31e |
74 | $#a = -1; |
75 | check_contents(''); |
76 | |
6fc0ea7e |
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"; |
81 | my $r = $a[3]; |
82 | $#a = -1; |
83 | $r = $a[3]; |
84 | print (! 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 | |
836d9961 |
88 | # In the past, there was a bug in STORESIZE that it didn't correctly |
a6d05634 |
89 | # remove deleted records from the cache. This wasn't detected |
836d9961 |
90 | # because these tests were all done with an empty cache. populate() |
91 | # will ensure that the cache is fully populated. |
92 | sub populate { |
93 | my $z; |
94 | $z = $a[$_] for 0 .. $#a; |
95 | } |
b5aed31e |
96 | |
97 | sub check_contents { |
98 | my $x = shift; |
7b6b3db1 |
99 | local *FH = $o->{fh}; |
100 | seek FH, 0, SEEK_SET; |
b5aed31e |
101 | my $a; |
102 | { local $/; $a = <FH> } |
7b6b3db1 |
103 | $a = "" unless defined $a; |
104 | if ($a eq $x) { |
105 | print "ok $N\n"; |
106 | } else { |
b3fe5a4c |
107 | ctrlfix($a, $x); |
7b6b3db1 |
108 | print "not ok $N\n# expected <$x>, got <$a>\n"; |
109 | } |
b5aed31e |
110 | $N++; |
836d9961 |
111 | my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY}); |
112 | print $integrity ? "ok $N\n" : "not ok $N \# integrity\n"; |
113 | $N++; |
b5aed31e |
114 | } |
115 | |
116 | |
b3fe5a4c |
117 | sub ctrlfix { |
118 | for (@_) { |
119 | s/\n/\\n/g; |
120 | s/\r/\\r/g; |
121 | } |
122 | } |
123 | |
b5aed31e |
124 | END { |
7b6b3db1 |
125 | undef $o; |
126 | untie @a; |
b5aed31e |
127 | 1 while unlink $file; |
128 | } |
129 | |