29a_upcopy.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Unit tests of _upcopy function
#
# _upcopy($self, $source, $dest, $len)
#
# Take a block of data of leength $len at $source and copy it
# to $dest, which must be <= $source but which need not be <= $source - $len
# (That is, this will only copy a block to a position earlier in the file,
# but the source and destination regions may overlap.)
my $file = "tf$$.txt";
print "1..55\n";
my $N = 1;
print "ok $N\n"; $N++;
# (2-7) Trivial non-moves at start of file
try(0, 0, 0);
try(0, 0, 10);
try(0, 0, 100);
try(0, 0, 1000);
try(0, 0, 10000);
try(0, 0, 20000);
# (8-13) Trivial non-moves in middle of file
try(100, 100, 0);
try(100, 100, 10);
try(100, 100, 100);
try(100, 100, 1000);
try(100, 100, 10000);
try(100, 100, 20000);
# (14) Trivial non-move at end of file
# (15-17) Trivial non-move of tail of file
# (18-24) Moves to start of file
try(100, 0, 0);
try(100, 0, 10);
try(100, 0, 100);
try(100, 0, 1000);
try(100, 0, 10000);
try(100, 0, 20000);
# (25-31) Moves in middle of file
try(200, 100, 0);
try(200, 100, 10);
try(200, 100, 100);
try(200, 100, 1000);
try(200, 100, 10000);
try(200, 100, 20000);
# (32-43) Moves from end of file
$FLEN = 40960;
# (44-55) Moves from end of file when file ends on a block boundary
sub try {
binmode F;
# The record has exactly 17 characters. This will help ensure that
# even if _upcopy screws up, the data doesn't coincidentally
# look good because the remainder accidentally lines up.
print F $oldfile;
close F;
# If len is specified, use that. If it's undef,
# then behave *as if* we had specified the whole rest of the file
} else {
}
my $err = $@;
print "# Timeout\n";
print "not ok $N\n"; $N++;
return;
} else {
$@ = $err;
die;
}
}
binmode F;
my $actual;
{ local $/;
$actual = <F>;
}
close F;
}
$N++;
}
sub check_contents {
my @c = @_;
# my $open = open FH, "< $file";
my $a;
{ local $/; $a = <FH> }
print "ok $N\n";
} else {
print "not ok $N\n# expected <$x>, got <$a>\n";
}
$N++;
# now check FETCH:
my $good = 1;
my $msg;
for (0.. $#c) {
my $aa = $a[$_];
$good = 0;
}
}
$N++;
? "ok $N\n" : "not ok $N\n";
$N++;
}
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
s/\r/\\r/g;
}
}
END {
undef $o;
untie @a;
}