Commit | Line | Data |
b3fe5a4c |
1 | #!/usr/bin/perl |
2 | # |
3 | # Tests for various caching errors |
4 | # |
5 | |
6ae23f41 |
6 | $|=1; |
b3fe5a4c |
7 | my $file = "tf$$.txt"; |
8 | $: = Tie::File::_default_recsep(); |
9 | my $data = join $:, "rec0" .. "rec9", ""; |
10 | my $V = $ENV{INTEGRITY}; # Verbose integrity checking? |
11 | |
6ae23f41 |
12 | print "1..55\n"; |
b3fe5a4c |
13 | |
14 | my $N = 1; |
15 | use Tie::File; |
16 | print "ok $N\n"; $N++; |
17 | |
18 | open F, "> $file" or die $!; |
19 | binmode F; |
20 | print F $data; |
21 | close F; |
22 | |
23 | my $o = tie @a, 'Tie::File', $file; |
24 | print $o ? "ok $N\n" : "not ok $N\n"; |
25 | $N++; |
26 | |
27 | # (3) Through 0.18, this 'splice' call would corrupt the cache. |
28 | my @z = @a; # force cache to contain all ten records |
29 | splice @a, 0, 0, "x"; |
30 | print $o->_check_integrity($file, $V) ? "ok $N\n" : "not ok $N\n"; |
31 | $N++; |
32 | |
33 | # Here we redo *all* the splice tests, with populate() |
34 | # calls before each one, to make sure that splice() does not botch the cache. |
35 | |
36 | # (4-14) splicing at the beginning |
37 | check(); |
38 | splice(@a, 0, 0, "rec4"); |
39 | check(); |
40 | splice(@a, 0, 1, "rec5"); # same length |
41 | check(); |
42 | splice(@a, 0, 1, "record5"); # longer |
43 | check(); |
44 | splice(@a, 0, 1, "r5"); # shorter |
45 | check(); |
46 | splice(@a, 0, 1); # removal |
47 | check(); |
48 | splice(@a, 0, 0); # no-op |
49 | check(); |
50 | |
51 | splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one |
52 | check(); |
53 | splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
54 | check(); |
55 | splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert |
56 | check(); |
57 | splice(@a, 0, 2); # delete more than one |
58 | check(); |
59 | |
60 | |
61 | # (15-24) splicing in the middle |
62 | splice(@a, 1, 0, "rec4"); |
63 | check(); |
64 | splice(@a, 1, 1, "rec5"); # same length |
65 | check(); |
66 | splice(@a, 1, 1, "record5"); # longer |
67 | check(); |
68 | splice(@a, 1, 1, "r5"); # shorter |
69 | check(); |
70 | splice(@a, 1, 1); # removal |
71 | check(); |
72 | splice(@a, 1, 0); # no-op |
73 | check(); |
74 | |
75 | splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one |
76 | check(); |
77 | splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
78 | check(); |
79 | splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert |
80 | check(); |
81 | splice(@a, 1, 2); # delete more than one |
82 | check(); |
83 | |
84 | # (25-34) splicing at the end |
85 | splice(@a, 3, 0, "rec4"); |
86 | check(); |
87 | splice(@a, 3, 1, "rec5"); # same length |
88 | check(); |
89 | splice(@a, 3, 1, "record5"); # longer |
90 | check(); |
91 | splice(@a, 3, 1, "r5"); # shorter |
92 | check(); |
93 | splice(@a, 3, 1); # removal |
94 | check(); |
95 | splice(@a, 3, 0); # no-op |
96 | check(); |
97 | |
98 | splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one |
99 | check(); |
100 | splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
101 | check(); |
102 | splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert |
103 | check(); |
104 | splice(@a, 3, 2); # delete more than one |
105 | check(); |
106 | |
107 | # (35-44) splicing with negative subscript |
108 | splice(@a, -1, 0, "rec4"); |
109 | check(); |
110 | splice(@a, -1, 1, "rec5"); # same length |
111 | check(); |
112 | splice(@a, -1, 1, "record5"); # longer |
113 | check(); |
114 | splice(@a, -1, 1, "r5"); # shorter |
115 | check(); |
116 | splice(@a, -1, 1); # removal |
117 | check(); |
118 | splice(@a, -1, 0); # no-op |
119 | check(); |
120 | |
121 | splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one |
122 | check(); |
123 | splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
124 | check(); |
125 | splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert |
126 | check(); |
127 | splice(@a, -4, 3); # delete more than one |
128 | check(); |
129 | |
130 | # (45) scrub it all out |
131 | splice(@a, 0, 3); |
132 | check(); |
133 | |
134 | # (46) put some back in |
135 | splice(@a, 0, 0, "rec0", "rec1"); |
136 | check(); |
137 | |
138 | # (47) what if we remove too many records? |
139 | splice(@a, 0, 17); |
140 | check(); |
141 | |
142 | # (48-49) In the past, splicing past the end was not correctly detected |
143 | # (1.14) |
144 | splice(@a, 89, 3); |
145 | check(); |
146 | splice(@a, @a, 3); |
147 | check(); |
148 | |
149 | # (50-51) Also we did not emulate splice's freaky behavior when inserting |
150 | # past the end of the array (1.14) |
151 | splice(@a, 89, 0, "I", "like", "pie"); |
152 | check(); |
153 | splice(@a, 89, 0, "pie pie pie"); |
154 | check(); |
155 | |
156 | # (52-54) Test default arguments |
157 | splice @a, 0, 0, (0..11); |
158 | check(); |
159 | splice @a, 4; |
160 | check(); |
161 | splice @a; |
162 | check(); |
163 | |
6ae23f41 |
164 | # (55) This was broken on 20030507 when you moved the cache management |
165 | # stuff out of _oadjust back into _splice without also putting it back |
166 | # into _store. |
167 | @a = (0..11); |
168 | check(); |
b3fe5a4c |
169 | |
170 | sub init_file { |
171 | my $data = shift; |
172 | open F, "> $file" or die $!; |
173 | binmode F; |
174 | print F $data; |
175 | close F; |
176 | } |
177 | |
b3fe5a4c |
178 | sub check { |
179 | my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY}); |
180 | print $integrity ? "ok $N\n" : "not ok $N\n"; |
181 | $N++; |
182 | repopulate(); |
183 | } |
184 | |
185 | |
186 | sub ctrlfix { |
187 | for (@_) { |
188 | s/\n/\\n/g; |
189 | s/\r/\\r/g; |
190 | } |
191 | } |
192 | |
193 | sub repopulate { |
6fc0ea7e |
194 | $o->{cache}->empty; |
b3fe5a4c |
195 | my @z = @a; # refill the cache with correct data |
196 | } |
197 | |
198 | END { |
199 | undef $o; |
200 | untie @a; |
201 | 1 while unlink $file; |
202 | } |
203 | |
204 | |
205 | |