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