make/tests/thelp.pl

114 lines
2.8 KiB
Perl
Raw Normal View History

#!/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
# 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;
}
# 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);