This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Tie::File 0.95.
[perl5.git] / lib / Tie / File / t / 29_downcopy.t
CommitLineData
6ae23f41
JH
1#!/usr/bin/perl
2#
3# Unit tests of _twrite function
4#
5# _downcopy($self, $data, $pos, $len)
6# Write $data into a block of length $len at position $pos,
7# moving everything in the block forwards to make room.
8# Instead of writing the last length($data) bytes from the block
9# (because there isn't room for them any longer) return them.
10#
11#
12
13my $file = "tf$$.txt";
14
15print "1..718\n";
16
17my $N = 1;
18use Tie::File;
19print "ok $N\n"; $N++;
20
21$: = Tie::File::_default_recsep();
22
23my @subtests = qw(x <x x> x><x <x> <x><x x><x> <x><x> <x><x><x> 0);
24print "ok $N\n"; $N++;
25
26# (3-144) These were generated by 'gentests.pl' to cover all possible cases
27# (I hope)
28# Legend:
29# x: data is entirely contained within one block
30# x>: data runs from the middle to the end of the block
31# <x: data runs from the start to the middle of the block
32# <x>: data occupies precisely one block
33# x><x: data overlaps one block boundary
34# <x><x: data runs from the start of one block into the middle of the next
35# x><x>: data runs from the middle of one block to the end of the next
36# <x><x>: data occupies two blocks exactly
37# <x><x><x>: data occupies three blocks exactly
38# 0: data is null
39#
40# For each possible alignment of the old and new data, we investigate
41# up to three situations: old data is shorter, old and new data are the
42# same length, and new data is shorter.
43#
44# try($pos, $old, $new) means to run a test where the data starts at
45# position $pos, the old data has length $old,
46# and the new data has length $new.
47try( 9659, 6635, 6691); # old=x , new=x ; old < new
48try( 8605, 2394, 2394); # old=x , new=x ; old = new
49try( 9768, 1361, 664); # old=x , new=x ; old > new
50try( 9955, 6429, 6429); # old=x> , new=x ; old = new
51try(10550, 5834, 4123); # old=x> , new=x ; old > new
52try(14580, 6158, 851); # old=x><x , new=x ; old > new
53try(13442, 11134, 1572); # old=x><x> , new=x ; old > new
54try( 8394, 0, 5742); # old=0 , new=x ; old < new
55try( 8192, 2819, 6738); # old=<x , new=<x ; old < new
56try( 8192, 514, 514); # old=<x , new=<x ; old = new
57try( 8192, 2196, 858); # old=<x , new=<x ; old > new
58try( 8192, 8192, 8192); # old=<x> , new=<x ; old = new
59try( 8192, 8192, 1290); # old=<x> , new=<x ; old > new
60try( 8192, 10575, 6644); # old=<x><x , new=<x ; old > new
61try( 8192, 16384, 5616); # old=<x><x> , new=<x ; old > new
62try( 8192, 24576, 6253); # old=<x><x><x>, new=<x ; old > new
63try( 8192, 0, 6870); # old=0 , new=<x ; old < new
64try( 8478, 6259, 7906); # old=x , new=x> ; old < new
65try( 9965, 6419, 6419); # old=x> , new=x> ; old = new
66try(16059, 6102, 325); # old=x><x , new=x> ; old > new
67try( 9503, 15073, 6881); # old=x><x> , new=x> ; old > new
68try( 9759, 0, 6625); # old=0 , new=x> ; old < new
69try( 8525, 2081, 8534); # old=x , new=x><x ; old < new
70try(15550, 834, 1428); # old=x> , new=x><x ; old < new
71try(14966, 1668, 3479); # old=x><x , new=x><x ; old < new
72try(16316, 1605, 1605); # old=x><x , new=x><x ; old = new
73try(16093, 4074, 993); # old=x><x , new=x><x ; old > new
74try(14739, 9837, 9837); # old=x><x> , new=x><x ; old = new
75try(14071, 10505, 7344); # old=x><x> , new=x><x ; old > new
76try(12602, 0, 8354); # old=0 , new=x><x ; old < new
77try( 8192, 2767, 8192); # old=<x , new=<x> ; old < new
78try( 8192, 8192, 8192); # old=<x> , new=<x> ; old = new
79try( 8192, 14817, 8192); # old=<x><x , new=<x> ; old > new
80try( 8192, 16384, 8192); # old=<x><x> , new=<x> ; old > new
81try( 8192, 24576, 8192); # old=<x><x><x>, new=<x> ; old > new
82try( 8192, 0, 8192); # old=0 , new=<x> ; old < new
83try( 8192, 6532, 10882); # old=<x , new=<x><x ; old < new
84try( 8192, 8192, 16044); # old=<x> , new=<x><x ; old < new
85try( 8192, 9555, 11020); # old=<x><x , new=<x><x ; old < new
86try( 8192, 9001, 9001); # old=<x><x , new=<x><x ; old = new
87try( 8192, 11760, 10274); # old=<x><x , new=<x><x ; old > new
88try( 8192, 16384, 10781); # old=<x><x> , new=<x><x ; old > new
89try( 8192, 24576, 9284); # old=<x><x><x>, new=<x><x ; old > new
90try( 8192, 0, 12488); # old=0 , new=<x><x ; old < new
91try( 8222, 6385, 16354); # old=x , new=x><x> ; old < new
92try(13500, 2884, 11076); # old=x> , new=x><x> ; old < new
93try(14069, 4334, 10507); # old=x><x , new=x><x> ; old < new
94try(14761, 9815, 9815); # old=x><x> , new=x><x> ; old = new
95try(10469, 0, 14107); # old=0 , new=x><x> ; old < new
96try( 8192, 4181, 16384); # old=<x , new=<x><x> ; old < new
97try( 8192, 8192, 16384); # old=<x> , new=<x><x> ; old < new
98try( 8192, 12087, 16384); # old=<x><x , new=<x><x> ; old < new
99try( 8192, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new
100try( 8192, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new
101try( 8192, 0, 16384); # old=0 , new=<x><x> ; old < new
102try( 8192, 4968, 24576); # old=<x , new=<x><x><x>; old < new
103try( 8192, 8192, 24576); # old=<x> , new=<x><x><x>; old < new
104try( 8192, 14163, 24576); # old=<x><x , new=<x><x><x>; old < new
105try( 8192, 16384, 24576); # old=<x><x> , new=<x><x><x>; old < new
106try( 8192, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new
107try( 8192, 0, 24576); # old=0 , new=<x><x><x>; old < new
108try( 8771, 776, 0); # old=x , new=0 ; old > new
109try( 8192, 2813, 0); # old=<x , new=0 ; old > new
110try(13945, 2439, 0); # old=x> , new=0 ; old > new
111try(14493, 6090, 0); # old=x><x , new=0 ; old > new
112try( 8192, 8192, 0); # old=<x> , new=0 ; old > new
113try( 8192, 10030, 0); # old=<x><x , new=0 ; old > new
114try(14983, 9593, 0); # old=x><x> , new=0 ; old > new
115try( 8192, 16384, 0); # old=<x><x> , new=0 ; old > new
116try( 8192, 24576, 0); # old=<x><x><x>, new=0 ; old > new
117try(10489, 0, 0); # old=0 , new=0 ; old = new
118
119# (142-223)
120# These tests all take place at the start of the file
121try( 0, 771, 1593); # old=<x , new=<x ; old < new
122try( 0, 4868, 4868); # old=<x , new=<x ; old = new
123try( 0, 147, 118); # old=<x , new=<x ; old > new
124try( 0, 8192, 8192); # old=<x> , new=<x ; old = new
125try( 0, 8192, 4574); # old=<x> , new=<x ; old > new
126try( 0, 11891, 1917); # old=<x><x , new=<x ; old > new
127try( 0, 16384, 5155); # old=<x><x> , new=<x ; old > new
128try( 0, 24576, 2953); # old=<x><x><x>, new=<x ; old > new
129try( 0, 0, 1317); # old=0 , new=<x ; old < new
130try( 0, 5609, 8192); # old=<x , new=<x> ; old < new
131try( 0, 8192, 8192); # old=<x> , new=<x> ; old = new
132try( 0, 11083, 8192); # old=<x><x , new=<x> ; old > new
133try( 0, 16384, 8192); # old=<x><x> , new=<x> ; old > new
134try( 0, 24576, 8192); # old=<x><x><x>, new=<x> ; old > new
135try( 0, 0, 8192); # old=0 , new=<x> ; old < new
136try( 0, 6265, 9991); # old=<x , new=<x><x ; old < new
137try( 0, 8192, 16119); # old=<x> , new=<x><x ; old < new
138try( 0, 10218, 11888); # old=<x><x , new=<x><x ; old < new
139try( 0, 14126, 14126); # old=<x><x , new=<x><x ; old = new
140try( 0, 12002, 9034); # old=<x><x , new=<x><x ; old > new
141try( 0, 16384, 13258); # old=<x><x> , new=<x><x ; old > new
142try( 0, 24576, 14367); # old=<x><x><x>, new=<x><x ; old > new
143try( 0, 0, 10881); # old=0 , new=<x><x ; old < new
144try( 0, 6448, 16384); # old=<x , new=<x><x> ; old < new
145try( 0, 8192, 16384); # old=<x> , new=<x><x> ; old < new
146try( 0, 15082, 16384); # old=<x><x , new=<x><x> ; old < new
147try( 0, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new
148try( 0, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new
149try( 0, 0, 16384); # old=0 , new=<x><x> ; old < new
150try( 0, 2421, 24576); # old=<x , new=<x><x><x>; old < new
151try( 0, 8192, 24576); # old=<x> , new=<x><x><x>; old < new
152try( 0, 11655, 24576); # old=<x><x , new=<x><x><x>; old < new
153try( 0, 16384, 24576); # old=<x><x> , new=<x><x><x>; old < new
154try( 0, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new
155try( 0, 0, 24576); # old=0 , new=<x><x><x>; old < new
156try( 0, 6530, 0); # old=<x , new=0 ; old > new
157try( 0, 8192, 0); # old=<x> , new=0 ; old > new
158try( 0, 14707, 0); # old=<x><x , new=0 ; old > new
159try( 0, 16384, 0); # old=<x><x> , new=0 ; old > new
160try( 0, 24576, 0); # old=<x><x><x>, new=0 ; old > new
161try( 0, 0, 0); # old=0 , new=0 ; old = new
162
163# (224-277)
164# These tests all take place at the end of the file
165$FLEN = 40960; # Force the file to be exactly 40960 bytes long
166try(32768, 8192, 8192); # old=<x> , new=<x ; old = new
167try(32768, 8192, 4026); # old=<x> , new=<x ; old > new
168try(24576, 16384, 1917); # old=<x><x> , new=<x ; old > new
169try(16384, 24576, 3818); # old=<x><x><x>, new=<x ; old > new
170try(40960, 0, 2779); # old=0 , new=<x ; old < new
171try(32768, 8192, 8192); # old=<x> , new=<x> ; old = new
172try(24576, 16384, 8192); # old=<x><x> , new=<x> ; old > new
173try(16384, 24576, 8192); # old=<x><x><x>, new=<x> ; old > new
174try(40960, 0, 8192); # old=0 , new=<x> ; old < new
175try(32768, 8192, 10724); # old=<x> , new=<x><x ; old < new
176try(24576, 16384, 12221); # old=<x><x> , new=<x><x ; old > new
177try(16384, 24576, 15030); # old=<x><x><x>, new=<x><x ; old > new
178try(40960, 0, 11752); # old=0 , new=<x><x ; old < new
179try(32768, 8192, 16384); # old=<x> , new=<x><x> ; old < new
180try(24576, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new
181try(16384, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new
182try(40960, 0, 16384); # old=0 , new=<x><x> ; old < new
183try(32768, 8192, 24576); # old=<x> , new=<x><x><x>; old < new
184try(24576, 16384, 24576); # old=<x><x> , new=<x><x><x>; old < new
185try(16384, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new
186try(40960, 0, 24576); # old=0 , new=<x><x><x>; old < new
187try(35973, 4987, 0); # old=x> , new=0 ; old > new
188try(32768, 8192, 0); # old=<x> , new=0 ; old > new
189try(29932, 11028, 0); # old=x><x> , new=0 ; old > new
190try(24576, 16384, 0); # old=<x><x> , new=0 ; old > new
191try(16384, 24576, 0); # old=<x><x><x>, new=0 ; old > new
192try(40960, 0, 0); # old=0 , new=0 ; old = new
193
194# (278-357)
195# These tests all take place at the end of the file
196$FLEN = 42000; # Force the file to be exactly 42000 bytes long
197try(41275, 725, 4059); # old=x , new=x ; old < new
198try(41683, 317, 317); # old=x , new=x ; old = new
199try(41225, 775, 405); # old=x , new=x ; old > new
200try(35709, 6291, 284); # old=x><x , new=x ; old > new
201try(42000, 0, 2434); # old=0 , new=x ; old < new
202try(40960, 1040, 1608); # old=<x , new=<x ; old < new
203try(40960, 1040, 1040); # old=<x , new=<x ; old = new
204try(40960, 1040, 378); # old=<x , new=<x ; old > new
205try(32768, 9232, 5604); # old=<x><x , new=<x ; old > new
206try(42000, 0, 6637); # old=0 , new=<x ; old < new
207try(41022, 978, 8130); # old=x , new=x> ; old < new
208try(39994, 2006, 966); # old=x><x , new=x> ; old > new
209try(42000, 0, 7152); # old=0 , new=x> ; old < new
210try(41613, 387, 10601); # old=x , new=x><x ; old < new
211try(38460, 3540, 3938); # old=x><x , new=x><x ; old < new
212try(36725, 5275, 5275); # old=x><x , new=x><x ; old = new
213try(37990, 4010, 3199); # old=x><x , new=x><x ; old > new
214try(42000, 0, 9189); # old=0 , new=x><x ; old < new
215try(40960, 1040, 8192); # old=<x , new=<x> ; old < new
216try(32768, 9232, 8192); # old=<x><x , new=<x> ; old > new
217try(42000, 0, 8192); # old=0 , new=<x> ; old < new
218try(40960, 1040, 11778); # old=<x , new=<x><x ; old < new
219try(32768, 9232, 13792); # old=<x><x , new=<x><x ; old < new
220try(32768, 9232, 9232); # old=<x><x , new=<x><x ; old = new
221try(32768, 9232, 8795); # old=<x><x , new=<x><x ; old > new
222try(42000, 0, 8578); # old=0 , new=<x><x ; old < new
223try(41531, 469, 15813); # old=x , new=x><x> ; old < new
224try(39618, 2382, 9534); # old=x><x , new=x><x> ; old < new
225try(42000, 0, 15344); # old=0 , new=x><x> ; old < new
226try(40960, 1040, 16384); # old=<x , new=<x><x> ; old < new
227try(32768, 9232, 16384); # old=<x><x , new=<x><x> ; old < new
228try(42000, 0, 16384); # old=0 , new=<x><x> ; old < new
229try(40960, 1040, 24576); # old=<x , new=<x><x><x>; old < new
230try(32768, 9232, 24576); # old=<x><x , new=<x><x><x>; old < new
231try(42000, 0, 24576); # old=0 , new=<x><x><x>; old < new
232try(41500, 500, 0); # old=x , new=0 ; old > new
233try(40960, 1040, 0); # old=<x , new=0 ; old > new
234try(35272, 6728, 0); # old=x><x , new=0 ; old > new
235try(32768, 9232, 0); # old=<x><x , new=0 ; old > new
236try(42000, 0, 0); # old=0 , new=0 ; old = new
237
238
239
240sub try {
241 my ($pos, $len, $newlen) = @_;
242 open F, "> $file" or die "Couldn't open file $file: $!";
243 binmode F;
244
245 # The record has exactly 17 characters. This will help ensure that
246 # even if _downcoopy screws up, the data doesn't coincidentally
247 # look good because the remainder accidentally lines up.
248 my $d = substr("0123456789abcdef$:", -17);
249 my $recs = defined($FLEN) ?
250 int($FLEN/length($d))+1 : # enough to make up at least $FLEN
251 int(8192*5/length($d))+1; # at least 5 blocks' worth
252 my $oldfile = $d x $recs;
253 my $flen = defined($FLEN) ? $FLEN : $recs * 17;
254 substr($oldfile, $FLEN) = "" if defined $FLEN; # truncate
255 print F $oldfile;
256 close F;
257
258 die "wrong length!" unless -s $file == $flen;
259
260 my $newdata = "-" x $newlen;
261 my $expected = $oldfile;
262 my $old = defined $len ? substr($expected, $pos, $len)
263 : substr($expected, $pos);
264 $old = "$newdata$old";
265 my $x_retval;
266 if (defined $len) {
267 substr($expected, $pos, $len, substr($old, 0, $len, ""));
268 $x_retval = $old;
269 } else {
270 substr($expected, $pos) = $old;
271 $x_retval = "";
272 }
273
274 my $o = tie my @lines, 'Tie::File', $file or die $!;
275 local $SIG{ALRM} = sub { die "Alarm clock" };
276 my $a_retval = eval { alarm(5) unless $^P; $o->_downcopy($newdata, $pos, $len) };
277 my $err = $@;
278 undef $o; untie @lines;
279 if ($err) {
280 if ($err =~ /^Alarm clock/) {
281 print "# Timeout\n";
282 print "not ok $N\n"; $N++;
283 print "not ok $N\n"; $N++;
284 return;
285 } else {
286 $@ = $err;
287 die;
288 }
289 }
290
291 open F, "< $file" or die "Couldn't open file $file: $!";
292 binmode F;
293 my $actual;
294 { local $/;
295 $actual = <F>;
296 }
297 close F;
298
299 my ($alen, $xlen) = (length $actual, length $expected);
300 unless ($alen == $xlen) {
301 my @ARGS = @_;
302 for (@ARGS) { $_ = "UNDEF" unless defined }
303 print "# try(@ARGS) expected file length $xlen, actual $alen!\n";
304 }
305 print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
306 $N++;
307 print $a_retval eq $x_retval ? "ok $N\n" : "not ok $N\n";
308 $N++;
309
310 if (defined $len) {
311 try($pos, undef, $newlen);
312 }
313}
314
315
316
317use POSIX 'SEEK_SET';
318sub check_contents {
319 my @c = @_;
320 my $x = join $:, @c, '';
321 local *FH = $o->{fh};
322 seek FH, 0, SEEK_SET;
323# my $open = open FH, "< $file";
324 my $a;
325 { local $/; $a = <FH> }
326 $a = "" unless defined $a;
327 if ($a eq $x) {
328 print "ok $N\n";
329 } else {
330 ctrlfix($a, $x);
331 print "not ok $N\n# expected <$x>, got <$a>\n";
332 }
333 $N++;
334
335 # now check FETCH:
336 my $good = 1;
337 my $msg;
338 for (0.. $#c) {
339 my $aa = $a[$_];
340 unless ($aa eq "$c[$_]$:") {
341 $msg = "expected <$c[$_]$:>, got <$aa>";
342 ctrlfix($msg);
343 $good = 0;
344 }
345 }
346 print $good ? "ok $N\n" : "not ok $N # $msg\n";
347 $N++;
348
349 print $o->_check_integrity($file, $ENV{INTEGRITY})
350 ? "ok $N\n" : "not ok $N\n";
351 $N++;
352}
353
354sub ctrlfix {
355 for (@_) {
356 s/\n/\\n/g;
357 s/\r/\\r/g;
358 }
359}
360
361END {
362 undef $o;
363 untie @a;
364 1 while unlink $file;
365}
366