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