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