1#!/usr/bin/perl 2# 3# Unit tests of _mtwrite function 4# 5# _mtwrite($self, $d1, $s1, $l1, $d2, $s2, $l2, ...) 6# 7# 'm' here is for 'multiple'. This writes data $d1 at position $s1 8# over a block of space $l1, moving subsequent data up or down as necessary. 9 10my $file = "tf28-$$.txt"; 11$| = 1; 12 13print "1..2252\n"; 14 15my $N = 1; 16my $oldfile; 17use Tie::File; 18print "ok $N\n"; $N++; 19 20$: = Tie::File::_default_recsep(); 21 22# Only these are used for the triple-region tests 23@BASE_TRIES = ( 24 [10, 20, 30], 25 [10, 30, 20], 26 [100, 30, 20], 27 [100, 20, 30], 28 [100, 40, 20], 29 [100, 20, 40], 30 [200, 20, 30], 31 [200, 30, 20], 32 [200, 20, 60], 33 [200, 60, 20], 34 ); 35 36@TRIES = @BASE_TRIES; 37 38$FLEN = 40970; # Use files of this length 39$oldfile = mkrand($FLEN); 40print "# MOF tests\n"; 41# These were generated by 'gentests.pl' to cover all possible cases 42# (I hope) 43# Legend: 44# x: data is entirely contained within one block 45# x>: data runs from the middle to the end of the block 46# <x: data runs from the start to the middle of the block 47# <x>: data occupies precisely one block 48# x><x: data overlaps one block boundary 49# <x><x: data runs from the start of one block into the middle of the next 50# x><x>: data runs from the middle of one block to the end of the next 51# <x><x>: data occupies two blocks exactly 52# <x><x><x>: data occupies three blocks exactly 53# 0: data is null 54# 55# For each possible alignment of the old and new data, we investigate 56# up to three situations: old data is shorter, old and new data are the 57# same length, and new data is shorter. 58# 59# try($pos, $old, $new) means to run a test where the area being 60# written into starts at position $pos, the area being written into 61# has length $old, and and the new data has length $new. 62try( 8605, 2394, 2394); # old=x , new=x ; old = new 63try( 9768, 1361, 664); # old=x , new=x ; old > new 64try( 9955, 6429, 6429); # old=x> , new=x ; old = new 65try(10550, 5834, 4123); # old=x> , new=x ; old > new 66try(14580, 6158, 851); # old=x><x , new=x ; old > new 67try(13442, 11134, 1572); # old=x><x> , new=x ; old > new 68try( 8192, 514, 514); # old=<x , new=<x ; old = new 69try( 8192, 2196, 858); # old=<x , new=<x ; old > new 70try( 8192, 8192, 8192); # old=<x> , new=<x ; old = new 71try( 8192, 8192, 1290); # old=<x> , new=<x ; old > new 72try( 8192, 10575, 6644); # old=<x><x , new=<x ; old > new 73try( 8192, 16384, 5616); # old=<x><x> , new=<x ; old > new 74try( 8192, 24576, 6253); # old=<x><x><x>, new=<x ; old > new 75try( 9965, 6419, 6419); # old=x> , new=x> ; old = new 76try(16059, 6102, 325); # old=x><x , new=x> ; old > new 77try( 9503, 15073, 6881); # old=x><x> , new=x> ; old > new 78try(16316, 1605, 1605); # old=x><x , new=x><x ; old = new 79try(16093, 4074, 993); # old=x><x , new=x><x ; old > new 80try(14739, 9837, 9837); # old=x><x> , new=x><x ; old = new 81try(14071, 10505, 7344); # old=x><x> , new=x><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, 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(14761, 9815, 9815); # old=x><x> , new=x><x> ; old = new 91try( 8192, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new 92try( 8192, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new 93try( 8192, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new 94try( 8771, 776, 0); # old=x , new=0 ; old > new 95try( 8192, 2813, 0); # old=<x , new=0 ; old > new 96try(13945, 2439, 0); # old=x> , new=0 ; old > new 97try(14493, 6090, 0); # old=x><x , new=0 ; old > new 98try( 8192, 8192, 0); # old=<x> , new=0 ; old > new 99try( 8192, 10030, 0); # old=<x><x , new=0 ; old > new 100try(14983, 9593, 0); # old=x><x> , new=0 ; old > new 101try( 8192, 16384, 0); # old=<x><x> , new=0 ; old > new 102try( 8192, 24576, 0); # old=<x><x><x>, new=0 ; old > new 103try(10489, 0, 0); # old=0 , new=0 ; old = new 104 105print "# SOF tests\n"; 106# These tests all take place at the start of the file 107try( 0, 4868, 4868); # old=<x , new=<x ; old = new 108try( 0, 147, 118); # old=<x , new=<x ; old > new 109try( 0, 8192, 8192); # old=<x> , new=<x ; old = new 110try( 0, 8192, 4574); # old=<x> , new=<x ; old > new 111try( 0, 11891, 1917); # old=<x><x , new=<x ; old > new 112try( 0, 16384, 5155); # old=<x><x> , new=<x ; old > new 113try( 0, 24576, 2953); # old=<x><x><x>, new=<x ; old > new 114try( 0, 8192, 8192); # old=<x> , new=<x> ; old = new 115try( 0, 11083, 8192); # old=<x><x , new=<x> ; old > new 116try( 0, 16384, 8192); # old=<x><x> , new=<x> ; old > new 117try( 0, 24576, 8192); # old=<x><x><x>, new=<x> ; old > new 118try( 0, 14126, 14126); # old=<x><x , new=<x><x ; old = new 119try( 0, 12002, 9034); # old=<x><x , new=<x><x ; old > new 120try( 0, 16384, 13258); # old=<x><x> , new=<x><x ; old > new 121try( 0, 24576, 14367); # old=<x><x><x>, new=<x><x ; old > new 122try( 0, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new 123try( 0, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new 124try( 0, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new 125try( 0, 6530, 0); # old=<x , new=0 ; old > new 126try( 0, 8192, 0); # old=<x> , new=0 ; old > new 127try( 0, 14707, 0); # old=<x><x , new=0 ; old > new 128try( 0, 16384, 0); # old=<x><x> , new=0 ; old > new 129try( 0, 24576, 0); # old=<x><x><x>, new=0 ; old > new 130try( 0, 0, 0); # old=0 , new=0 ; old = new 131 132print "# EOF tests 1\n"; 133# These tests all take place at the end of the file 134$FLEN = 40960; # Force the file to be exactly 40960 bytes long 135$oldfile = mkrand($FLEN); 136try(32768, 8192, 8192); # old=<x> , new=<x ; old = new 137try(32768, 8192, 4026); # old=<x> , new=<x ; old > new 138try(24576, 16384, 1917); # old=<x><x> , new=<x ; old > new 139try(16384, 24576, 3818); # old=<x><x><x>, new=<x ; old > new 140try(32768, 8192, 8192); # old=<x> , new=<x> ; old = new 141try(24576, 16384, 8192); # old=<x><x> , new=<x> ; old > new 142try(16384, 24576, 8192); # old=<x><x><x>, new=<x> ; old > new 143try(24576, 16384, 12221); # old=<x><x> , new=<x><x ; old > new 144try(16384, 24576, 15030); # old=<x><x><x>, new=<x><x ; old > new 145try(24576, 16384, 16384); # old=<x><x> , new=<x><x> ; old = new 146try(16384, 24576, 16384); # old=<x><x><x>, new=<x><x> ; old > new 147try(16384, 24576, 24576); # old=<x><x><x>, new=<x><x><x>; old = new 148try(35973, 4987, 0); # old=x> , new=0 ; old > new 149try(32768, 8192, 0); # old=<x> , new=0 ; old > new 150try(29932, 11028, 0); # old=x><x> , new=0 ; old > new 151try(24576, 16384, 0); # old=<x><x> , new=0 ; old > new 152try(16384, 24576, 0); # old=<x><x><x>, new=0 ; old > new 153try(40960, 0, 0); # old=0 , new=0 ; old = new 154 155print "# EOF tests 2\n"; 156# These tests all take place at the end of the file 157$FLEN = 42000; # Force the file to be exactly 42000 bytes long 158$oldfile = mkrand($FLEN); 159try(41683, 317, 317); # old=x , new=x ; old = new 160try(41225, 775, 405); # old=x , new=x ; old > new 161try(35709, 6291, 284); # old=x><x , new=x ; old > new 162try(40960, 1040, 1040); # old=<x , new=<x ; old = new 163try(40960, 1040, 378); # old=<x , new=<x ; old > new 164try(32768, 9232, 5604); # old=<x><x , new=<x ; old > new 165try(39994, 2006, 966); # old=x><x , new=x> ; old > new 166try(36725, 5275, 5275); # old=x><x , new=x><x ; old = new 167try(37990, 4010, 3199); # old=x><x , new=x><x ; old > new 168try(32768, 9232, 8192); # old=<x><x , new=<x> ; old > new 169try(32768, 9232, 9232); # old=<x><x , new=<x><x ; old = new 170try(32768, 9232, 8795); # old=<x><x , new=<x><x ; old > new 171try(41500, 500, 0); # old=x , new=0 ; old > new 172try(40960, 1040, 0); # old=<x , new=0 ; old > new 173try(35272, 6728, 0); # old=x><x , new=0 ; old > new 174try(32768, 9232, 0); # old=<x><x , new=0 ; old > new 175try(42000, 0, 0); # old=0 , new=0 ; old = new 176 177# Now the REAL tests 178# Make sure mtwrite can properly write sequences of several intervals 179# The intervals tested above were accumulated into @TRIES. 180# try_all_doubles() tries every possible sensible pair of those intervals. 181# try_all_triples() tries every possible sensible group of 182# tree intervals from the more restrictive set @BASE_TRIES. 183$FLEN = 40970; 184$oldfile = mkrand($FLEN); 185try_all_doubles(); 186try_all_triples(); 187 188sub mkrand { 189 my $len = shift; 190 srand $len; 191 my @c = ('a' .. 'z', 'A' .. 'Z', 0..9, $:); 192 my $d = ""; 193 $d .= $c[rand @c] until length($d) >= $len; 194 substr($d, $len) = ""; # chop it off to the proper length 195 $d; 196} 197 198sub try { 199 push @TRIES, [@_] if @_ == 3; 200 201 open F, '>', $file or die "Couldn't open file $file: $!"; 202 binmode F; 203 print F $oldfile; 204 close F; 205 die "wrong length!" unless -s $file == $FLEN; 206 207 my @mt_args; 208 my $expected = $oldfile; 209 { my @a = @_; 210 my $c = "a"; 211 while (@a) { 212 my ($s, $len, $newlen) = splice @a, -3; 213 my $newdata = $c++ x $newlen; 214 substr($expected, $s, $len, $newdata); 215 unshift @mt_args, $newdata, $s, $len; 216 } 217 } 218 219 my $o = tie my @lines, 'Tie::File', $file or die $!; 220 my $actual_return = $o->_mtwrite(@mt_args); 221 undef $o; untie @lines; 222 223 open F, '<', $file or die "Couldn't open file $file: $!"; 224 binmode F; 225 my $actual; 226 { local $/; 227 $actual = <F>; 228 } 229 close F; 230 231 my ($alen, $xlen) = (length $actual, length $expected); 232 unless ($alen == $xlen) { 233 print "# try(@_) expected file length $xlen, actual $alen!\n"; 234 } 235 print $actual eq $expected ? "ok $N\n" : "not ok $N\n"; 236 $N++; 237 238# if (! defined $actual_return && ! defined $expected_return) { 239# print "ok $N\n"; 240# } elsif (! defined $actual_return || ! defined $expected_return) { 241# print "not ok $N\n"; 242# } else { 243# print $actual_return eq $expected_return ? "ok $N\n" : "not ok $N\n"; 244# } 245# $N++; 246} 247 248sub try_all_doubles { 249 print "# Trying double regions.\n"; 250 for my $a (@TRIES) { 251 next if $a->[0] + $a->[1] >= $FLEN; 252 next if $a->[0] + $a->[2] >= $FLEN; 253 for my $b (@TRIES) { 254 next if $b->[0] + $b->[1] >= $FLEN; 255 next if $b->[0] + $b->[2] >= $FLEN; 256 257 next if $b->[0] < $a->[0] + $a->[1]; # Overlapping regions 258 try(@$a, @$b); 259 } 260 } 261} 262 263sub try_all_triples { 264 print "# Trying triple regions.\n"; 265 for my $a (@BASE_TRIES) { 266 next if $a->[0] + $a->[1] >= $FLEN; 267 next if $a->[0] + $a->[2] >= $FLEN; 268 for my $b (@BASE_TRIES) { 269 next if $b->[0] + $b->[1] >= $FLEN; 270 next if $b->[0] + $b->[2] >= $FLEN; 271 272 next if $b->[0] < $a->[0] + $a->[1]; # Overlapping regions 273 274 for my $c (@BASE_TRIES) { 275 next if $c->[0] + $c->[1] >= $FLEN; 276 next if $c->[0] + $c->[2] >= $FLEN; 277 278 next if $c->[0] < $b->[0] + $b->[1]; # Overlapping regions 279 try(@$a, @$b, @$c); 280 } 281 } 282 } 283} 284 285sub ctrlfix { 286 for (@_) { 287 s/\n/\\n/g; 288 s/\r/\\r/g; 289 } 290} 291 292END { 293 1 while unlink $file; 294} 295 296