mirror of
https://git.savannah.gnu.org/git/make.git
synced 2024-12-26 05:57:16 +00:00
c5319e75f5
Keep a count of bytes read rather than comparing pointers since the variable_buffer might get reallocated. Bug and patch by Ken Tossell <ken@tossell.net> Regression tests by Dmitry Goncharov <dgoncharov@users.sf.net> Tweaked by Paul Smith <psmith@gnu.org> * src/function.c (func_file): Use bytes read rather than a pointer. * tests/scripts/functions/file: Provide various tests for reading empty files, files with/without newlines, and large files.
118 lines
3 KiB
Perl
Executable file
118 lines
3 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
# -*-perl-*-
|
|
#
|
|
# This script helps us write tests in a portable way, without relying on a lot
|
|
# of shell features. Since we already have Perl to run the tests, use that.
|
|
#
|
|
# The arguments represent a set of steps that will be run one at a time.
|
|
# Each step consists of an operator and argument.
|
|
#
|
|
# It supports the following operators:
|
|
# out <word> : echo <word> to stdout with a newline
|
|
# raw <word> : echo <word> to stdout without adding anything
|
|
# file <word> : echo <word> to stdout AND create the file <word>
|
|
# dir <word> : echo <word> to stdout AND create the directory <word>
|
|
# rm <word> : echo <word> to stdout AND delete the file/directory <word>
|
|
# wait <word> : wait for a file named <word> to exist
|
|
# tmout <secs> : Change the timeout for waiting. Default is 4 seconds.
|
|
# sleep <secs> : Sleep for <secs> seconds then echo <secs>
|
|
# fail <err> : echo <err> to stdout then exit with error code err
|
|
#
|
|
# If given -q only the "out" command generates output.
|
|
|
|
# Force flush
|
|
$| = 1;
|
|
|
|
my $quiet = 0;
|
|
my $timeout = 4;
|
|
|
|
sub op {
|
|
my ($op, $nm) = @_;
|
|
|
|
defined $nm or die "Missing value for $op\n";
|
|
|
|
if ($op eq 'out') {
|
|
print "$nm\n";
|
|
return 1;
|
|
}
|
|
if ($op eq 'raw') {
|
|
print "$nm";
|
|
return 1;
|
|
}
|
|
|
|
# Show the output before creating the file
|
|
if ($op eq 'file') {
|
|
print "file $nm\n" unless $quiet;
|
|
open(my $fh, '>', $nm) or die "$nm: open: $!\n";
|
|
close(my $fh);
|
|
return 1;
|
|
}
|
|
|
|
# Show the output before creating the directory
|
|
if ($op eq 'dir') {
|
|
print "dir $nm\n" unless $quiet;
|
|
mkdir($nm) or die "$nm: mkdir: $!\n";
|
|
return 1;
|
|
}
|
|
|
|
# Show the output after removing the file
|
|
if ($op eq 'rm') {
|
|
if (-f $nm) {
|
|
unlink($nm) or die "$nm: unlink: $!\n";
|
|
} elsif (-d $nm) {
|
|
rmdir($nm) or die "$nm: rmdir: $!\n";
|
|
} else {
|
|
die "$nm: not file or directory: $!\n";
|
|
}
|
|
print "rm $nm\n" unless $quiet;
|
|
return 1;
|
|
}
|
|
|
|
if ($op eq 'tmout') {
|
|
$timeout = $nm;
|
|
print "tmout $nm\n" unless $quiet;
|
|
return 1;
|
|
}
|
|
|
|
# Show the output after the file exists
|
|
if ($op eq 'wait') {
|
|
my $start = time();
|
|
my $end = $start + $timeout;
|
|
while (time() <= $end) {
|
|
if (-f $nm) {
|
|
print "wait $nm\n" unless $quiet;
|
|
return 1;
|
|
}
|
|
select(undef, undef, undef, 0.1);
|
|
}
|
|
die "wait $nm: timeout after ".(time()-$start-1)." seconds\n";
|
|
}
|
|
|
|
# Show the output after sleeping
|
|
if ($op eq 'sleep') {
|
|
sleep($nm);
|
|
print "sleep $nm\n" unless $quiet;
|
|
return 1;
|
|
}
|
|
|
|
if ($op eq 'fail') {
|
|
print "fail $nm\n";
|
|
exit($nm);
|
|
}
|
|
|
|
die("Invalid command: $op $nm\n");
|
|
}
|
|
|
|
if (@ARGV && $ARGV[0] eq '-q') {
|
|
$quiet = 1;
|
|
shift;
|
|
}
|
|
|
|
while (@ARGV) {
|
|
if (op($ARGV[0], $ARGV[1])) {
|
|
shift;
|
|
shift;
|
|
}
|
|
}
|
|
|
|
exit(0);
|