mirror of
https://git.savannah.gnu.org/git/make.git
synced 2025-01-27 01:27:58 +00:00
Rename jhelp.pl to thelp.pl and make it a generic test helper.
* tests/thelp.pl: Rename from tests/jhelp.pl. (op): Use names instead of options for the operations. (op): Add new operations for sleep, mkdir, and rm. (op): Enhance wait to time out * tests/run_make_tests.pl: Add a new #HELPER# replacement (subst_make_string): Use fully-qualified path to thelp.pl * tests/scripts/features/parallelism: Update to use thelp.pl and the new named operations. Use thelp.pl sleep instead of system-specific sleep commands. * tests/scripts/features/output-sync: Update to use thelp.pl instead of complex shell scripts. * Makefile.am: Distribute tests/thelp.pl instead of tests/jhelp.pl
This commit is contained in:
parent
1cf3932a39
commit
3822f77c1d
6 changed files with 186 additions and 141 deletions
|
@ -95,7 +95,7 @@ test_FILES = tests/run_make_tests tests/run_make_tests.bat \
|
|||
tests/run_make_tests.pl tests/test_driver.pl \
|
||||
tests/config-flags.pm.in tests/config_flags_pm.com \
|
||||
tests/config-flags.pm.W32 \
|
||||
tests/mkshadow tests/jhelp.pl tests/guile.supp tests/README
|
||||
tests/mkshadow tests/thelp.pl tests/guile.supp tests/README
|
||||
# test/scripts are added via dist-hook below.
|
||||
|
||||
EXTRA_DIST = ChangeLog README build.sh build.cfg.in $(man_MANS) \
|
||||
|
|
|
@ -1,63 +0,0 @@
|
|||
#!/usr/bin/env perl
|
||||
# -*-perl-*-
|
||||
#
|
||||
# This script helps us test jobserver/parallelism without a lot of unreliable
|
||||
# (and slow) sleep calls. Written in Perl to get portable sub-second sleep.
|
||||
#
|
||||
# It can run the following steps based on arguments:
|
||||
# -t <secs> : maximum # of seconds the script can run; else we fail.
|
||||
# Default is 4 seconds.
|
||||
# -e <word> : echo <word> to stdout
|
||||
# -f <word> : echo <word> to stdout AND create an (empty) file named <word>
|
||||
# -w <word> : wait for a file named <word> to exist
|
||||
|
||||
# Force flush
|
||||
$| = 1;
|
||||
|
||||
my $timeout = 4;
|
||||
|
||||
sub op {
|
||||
my ($op, $nm) = @_;
|
||||
|
||||
defined $nm or die "Missing value for $op\n";
|
||||
|
||||
if ($op eq '-e') {
|
||||
print "$nm\n";
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($op eq '-f') {
|
||||
print "$nm\n";
|
||||
open(my $fh, '>', $nm) or die "$nm: open: $!\n";
|
||||
close(my $fh);
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($op eq '-w') {
|
||||
if (-f $nm) {
|
||||
return 1;
|
||||
}
|
||||
select(undef, undef, undef, 0.1);
|
||||
return 0;
|
||||
}
|
||||
|
||||
if ($op eq '-t') {
|
||||
$timeout = $nm;
|
||||
return 1;
|
||||
}
|
||||
|
||||
die("Invalid command: $op $nm\n");
|
||||
}
|
||||
|
||||
my $start = time();
|
||||
while (@ARGV) {
|
||||
if (op($ARGV[0], $ARGV[1])) {
|
||||
shift;
|
||||
shift;
|
||||
}
|
||||
if ($start + $timeout < time()) {
|
||||
die("Timeout after ".(time()-$start-1)." seconds\n");
|
||||
}
|
||||
}
|
||||
|
||||
exit(0);
|
|
@ -31,6 +31,8 @@
|
|||
use FindBin;
|
||||
use lib "$FindBin::Bin";
|
||||
|
||||
our $testsroot = $FindBin::Bin;
|
||||
|
||||
require "test_driver.pl";
|
||||
|
||||
use File::Spec;
|
||||
|
@ -52,10 +54,12 @@ $pure_log = undef;
|
|||
|
||||
# The location of the GNU make source directory
|
||||
$srcdir = undef;
|
||||
$fqsrcdir = undef;
|
||||
$srcvol = undef;
|
||||
|
||||
# The location of the build directory
|
||||
$blddir = undef;
|
||||
$fqblddir = undef;
|
||||
$bldvol = undef;
|
||||
|
||||
$make_path = undef;
|
||||
|
@ -226,6 +230,9 @@ sub subst_make_string
|
|||
s/#MAKE#/$make_name/g;
|
||||
s/#PERL#/$perl_name/g;
|
||||
s/#PWD#/$cwdpath/g;
|
||||
my $help = File::Spec->catfile($fqsrcdir, 'tests', 'thelp.pl');
|
||||
# If we're using a shell
|
||||
s/#HELPER#/$perl_name $help/g;
|
||||
return $_;
|
||||
}
|
||||
|
||||
|
@ -604,6 +611,10 @@ sub set_more_defaults
|
|||
-f File::Spec->catfile($1, 'src', 'gnumake.h') and $srcdir = $1;
|
||||
}
|
||||
|
||||
# At this point we should have srcdir and blddir: get fq versions
|
||||
$fqsrcdir = File::Spec->rel2abs($srcdir);
|
||||
$fqblddir = File::Spec->rel2abs($blddir);
|
||||
|
||||
# Get Purify log info--if any.
|
||||
|
||||
if (exists $ENV{PURIFYOPTIONS}
|
||||
|
|
|
@ -11,13 +11,6 @@ exists $FEATURES{'output-sync'} or return -1;
|
|||
$parallel_jobs or return -1;
|
||||
|
||||
|
||||
if ($vos) {
|
||||
$sleep_command = "sleep -seconds";
|
||||
}
|
||||
else {
|
||||
$sleep_command = "sleep";
|
||||
}
|
||||
|
||||
# The following subdirectories with Makefiles are used in several
|
||||
# of the following tests. The model is:
|
||||
# foo/Makefile - has a "foo" target that waits for the bar target
|
||||
|
@ -45,10 +38,10 @@ sub output_sync_clean {
|
|||
# reliable. If things are too fast, then sometimes a different job will steal
|
||||
# the output sync lock and the output is mis-ordered from what we expect.
|
||||
sub output_sync_wait {
|
||||
return "while [ ! -f ../mksync.$_[0] ]; do :; done; $CMD_rmfile ../mksync.$_[0].wait; $sleep_command 1";
|
||||
return subst_make_string("#HELPER# -q wait ../mksync.$_[0] sleep 1");
|
||||
}
|
||||
sub output_sync_set {
|
||||
return "date > ../mksync.$_[0]";
|
||||
return subst_make_string("#HELPER# -q file ../mksync.$_[0]");
|
||||
}
|
||||
|
||||
@syncfiles = qw(mksync.foo mksync.foo_start mksync.bar mksync.bar_start);
|
||||
|
@ -158,10 +151,10 @@ all: make-foo make-bar
|
|||
|
||||
make-foo: ; \$(MAKE) -C foo
|
||||
|
||||
make-bar: ; $sleep_command 1 ; \$(MAKE) -C bar!,
|
||||
make-bar: ; #HELPER# -q sleep 1 ; \$(MAKE) -C bar!,
|
||||
'-j --output-sync=target',
|
||||
"#MAKEPATH# -C foo
|
||||
$sleep_command 1 ; #MAKEPATH# -C bar
|
||||
#HELPER# -q sleep 1 ; #MAKEPATH# -C bar
|
||||
#MAKE#[1]: Entering directory '#PWD#/bar'
|
||||
bar: start
|
||||
bar: end
|
||||
|
@ -179,7 +172,7 @@ baz: end
|
|||
unlink(@syncfiles);
|
||||
run_make_test(undef, '-j --output-sync=target x=',
|
||||
"#MAKEPATH# -C foo
|
||||
$sleep_command 1 ; #MAKEPATH# -C bar
|
||||
#HELPER# -q sleep 1 ; #MAKEPATH# -C bar
|
||||
bar: start
|
||||
bar: end
|
||||
foo: start
|
||||
|
@ -195,10 +188,10 @@ all: make-foo-fail make-bar-bar
|
|||
|
||||
make-foo-fail: ; \$(MAKE) -C foo foo-fail
|
||||
|
||||
make-bar-bar: ; $sleep_command 1 ; \$(MAKE) -C bar bar!,
|
||||
make-bar-bar: ; #HELPER# -q sleep 1 ; \$(MAKE) -C bar bar!,
|
||||
'-j -O',
|
||||
"#MAKEPATH# -C foo foo-fail
|
||||
$sleep_command 1 ; #MAKEPATH# -C bar bar
|
||||
#HELPER# -q sleep 1 ; #MAKEPATH# -C bar bar
|
||||
#MAKE#[1]: Entering directory '#PWD#/bar'
|
||||
bar: start
|
||||
bar: end
|
||||
|
@ -223,10 +216,10 @@ all: make-foo make-bar
|
|||
|
||||
make-foo: ; \$(MAKE) -C foo foo-job
|
||||
|
||||
make-bar: ; $sleep_command 1 ; \$(MAKE) -C bar bar-job!,
|
||||
make-bar: ; #HELPER# -q sleep 1 ; \$(MAKE) -C bar bar-job!,
|
||||
'-j --output-sync=line',
|
||||
"#MAKEPATH# -C foo foo-job
|
||||
$sleep_command 1 ; #MAKEPATH# -C bar bar-job
|
||||
#HELPER# -q sleep 1 ; #MAKEPATH# -C bar bar-job
|
||||
#MAKE#[1]: Entering directory '#PWD#/foo'
|
||||
foo: start
|
||||
#MAKE#[1]: Leaving directory '#PWD#/foo'
|
||||
|
@ -240,7 +233,6 @@ bar: end
|
|||
foo: end
|
||||
#MAKE#[1]: Leaving directory '#PWD#/foo'\n", 0, $tmout);
|
||||
|
||||
|
||||
# Remove temporary directories and contents.
|
||||
output_sync_clean();
|
||||
|
||||
|
|
|
@ -7,55 +7,48 @@ if (!$parallel_jobs) {
|
|||
return -1;
|
||||
}
|
||||
|
||||
if ($vos) {
|
||||
$sleep_command = "sleep -seconds";
|
||||
}
|
||||
else {
|
||||
$sleep_command = "sleep";
|
||||
}
|
||||
|
||||
rmfiles(qw(ONE TWO THREE FOUR));
|
||||
|
||||
run_make_test("
|
||||
all : def_1 def_2 def_3
|
||||
def_1 : ; \@#PERL# jhelp.pl -f ONE -w THREE -e TWO
|
||||
def_2 : ; \@#PERL# jhelp.pl -w FOUR -f THREE
|
||||
def_3 : ; \@#PERL# jhelp.pl -w ONE -f FOUR",
|
||||
'-j4', "ONE\nFOUR\nTHREE\nTWO");
|
||||
def_1 : ; \@#HELPER# file ONE wait THREE out TWO
|
||||
def_2 : ; \@#HELPER# wait FOUR file THREE
|
||||
def_3 : ; \@#HELPER# wait ONE file FOUR",
|
||||
'-j4', "file ONE\nwait ONE\nfile FOUR\nwait FOUR\nfile THREE\nwait THREE\nTWO");
|
||||
rmfiles(qw(ONE TWO THREE FOUR));
|
||||
|
||||
# Verify -j added to MAKEFLAGS in the makefile
|
||||
run_make_test("
|
||||
MAKEFLAGS += -j4
|
||||
all : def_1 def_2 def_3
|
||||
def_1 : ; \@#PERL# jhelp.pl -f ONE -w THREE -e TWO
|
||||
def_2 : ; \@#PERL# jhelp.pl -w FOUR -f THREE
|
||||
def_3 : ; \@#PERL# jhelp.pl -w ONE -f FOUR",
|
||||
'', "ONE\nFOUR\nTHREE\nTWO");
|
||||
def_1 : ; \@#HELPER# file ONE wait THREE out TWO
|
||||
def_2 : ; \@#HELPER# wait FOUR file THREE
|
||||
def_3 : ; \@#HELPER# wait ONE file FOUR",
|
||||
'', "file ONE\nwait ONE\nfile FOUR\nwait FOUR\nfile THREE\nwait THREE\nTWO");
|
||||
rmfiles(qw(ONE TWO THREE FOUR));
|
||||
|
||||
# Command line should take precedence
|
||||
rmfiles(qw(ONE TWO THREE FOUR));
|
||||
run_make_test("
|
||||
MAKEFLAGS += -j2
|
||||
all : def_1 def_2 def_3
|
||||
def_1 : ; \@#PERL# jhelp.pl -f ONE -w THREE -e TWO
|
||||
def_2 : ; \@#PERL# jhelp.pl -w FOUR -f THREE
|
||||
def_3 : ; \@#PERL# jhelp.pl -w ONE -f FOUR",
|
||||
'-j4', "ONE\nFOUR\nTHREE\nTWO");
|
||||
def_1 : ; \@#HELPER# file ONE wait THREE out TWO
|
||||
def_2 : ; \@#HELPER# wait FOUR file THREE
|
||||
def_3 : ; \@#HELPER# wait ONE file FOUR",
|
||||
'-j4', "file ONE\nwait ONE\nfile FOUR\nwait FOUR\nfile THREE\nwait THREE\nTWO");
|
||||
rmfiles(qw(ONE TWO THREE FOUR));
|
||||
|
||||
# Test parallelism with included files. Here we sleep/echo while
|
||||
# building the included files, to test that they are being built in
|
||||
# parallel.
|
||||
run_make_test("
|
||||
all: 1 2; \@echo success
|
||||
all: 1 2; \@#HELPER# out success
|
||||
-include 1.inc 2.inc
|
||||
1.inc: ; \@#PERL# jhelp.pl -f ONE.inc -w THREE.inc -f TWO.inc; echo '1: ; \@#PERL# jhelp.pl -f ONE -w THREE -f TWO' > \$\@
|
||||
2.inc: ; \@#PERL# jhelp.pl -w ONE.inc -f THREE.inc; echo '2: ; \@#PERL# jhelp.pl -w ONE -f THREE' > \$\@",
|
||||
1.inc:
|
||||
\t\@#HELPER# file ONE.inc wait THREE.inc file TWO.inc
|
||||
\t\@echo '1: ; \@#HELPER# file ONE wait THREE file TWO' > \$\@
|
||||
2.inc:
|
||||
\t\@#HELPER# wait ONE.inc file THREE.inc
|
||||
\t\@echo '2: ; \@#HELPER# wait ONE file THREE' > \$\@",
|
||||
"-j4",
|
||||
"ONE.inc\nTHREE.inc\nTWO.inc\nONE\nTHREE\nTWO\nsuccess\n", 0, 7);
|
||||
|
||||
"file ONE.inc\nwait ONE.inc\nfile THREE.inc\nwait THREE.inc\nfile TWO.inc\nfile ONE\nwait ONE\nfile THREE\nwait THREE\nfile TWO\nsuccess\n", 0, 7);
|
||||
rmfiles(qw(ONE.inc TWO.inc THREE.inc ONE TWO THREE 1.inc 2.inc));
|
||||
|
||||
|
||||
|
@ -63,18 +56,17 @@ rmfiles(qw(ONE.inc TWO.inc THREE.inc ONE TWO THREE 1.inc 2.inc));
|
|||
# sure the jobserver works.
|
||||
run_make_test("
|
||||
recurse: ; \@\$(MAKE) --no-print-directory -f #MAKEFILE# INC=yes all
|
||||
all: 1 2; \@echo success
|
||||
all: 1 2; \@#HELPER# out success
|
||||
|
||||
INC = no
|
||||
ifeq (\$(INC),yes)
|
||||
-include 1.inc 2.inc
|
||||
endif
|
||||
|
||||
1.inc: ; \@#PERL# jhelp.pl -f ONE.inc -w THREE.inc -f TWO.inc; echo '1: ; \@#PERL# jhelp.pl -f ONE -w THREE -f TWO' > \$\@
|
||||
2.inc: ; \@#PERL# jhelp.pl -w ONE.inc -f THREE.inc; echo '2: ; \@#PERL# jhelp.pl -w ONE -f THREE' > \$\@",
|
||||
1.inc: ; \@#HELPER# file ONE.inc wait THREE.inc file TWO.inc; echo '1: ; \@#HELPER# file ONE wait THREE file TWO' > \$\@
|
||||
2.inc: ; \@#HELPER# wait ONE.inc file THREE.inc; echo '2: ; \@#HELPER# wait ONE file THREE' > \$\@",
|
||||
"-j4",
|
||||
"ONE.inc\nTHREE.inc\nTWO.inc\nONE\nTHREE\nTWO\nsuccess\n", 0, 7);
|
||||
|
||||
"file ONE.inc\nwait ONE.inc\nfile THREE.inc\nwait THREE.inc\nfile TWO.inc\nfile ONE\nwait ONE\nfile THREE\nwait THREE\nfile TWO\nsuccess\n", 0, 7);
|
||||
rmfiles(qw(ONE.inc TWO.inc THREE.inc ONE TWO THREE 1.inc 2.inc));
|
||||
|
||||
# Grant Taylor reports a problem where tokens can be lost (not written back
|
||||
|
@ -86,14 +78,14 @@ rmfiles(qw(ONE.inc TWO.inc THREE.inc ONE TWO THREE 1.inc 2.inc));
|
|||
|
||||
run_make_test("
|
||||
export HI = \$(shell \$(\$\@.CMD))
|
||||
first.CMD = echo hi
|
||||
second.CMD = $sleep_command 4; echo hi
|
||||
first.CMD = #HELPER# out hi
|
||||
second.CMD = #HELPER# sleep 4
|
||||
|
||||
.PHONY: all first second
|
||||
all: first second
|
||||
|
||||
first second: ; \@echo \$\@; $sleep_command 1; echo \$\@",
|
||||
'-j2', "first\nfirst\nsecond\nsecond", 0, 7);
|
||||
first second: ; \@#HELPER# out \$\@ sleep 1 out \$\@",
|
||||
'-j2', "first\nsleep 1\nfirst\nsecond\nsleep 1\nsecond", 0, 7);
|
||||
|
||||
# Michael Matz <matz@suse.de> reported a bug where if make is running in
|
||||
# parallel without -k and two jobs die in a row, but not too close to each
|
||||
|
@ -106,21 +98,21 @@ all: fail.1 ok fail.2 fail.3
|
|||
.RECIPEPREFIX := >
|
||||
|
||||
fail.1 fail.2 fail.3:
|
||||
> \@$sleep_command \$(patsubst fail.%,%,\$\@)
|
||||
> \@echo Fail
|
||||
> \@exit 1
|
||||
> \@#HELPER# sleep \$(patsubst fail.%,%,\$\@)
|
||||
> \@#HELPER# out Fail
|
||||
> \@#HELPER# fail 1
|
||||
|
||||
ok:
|
||||
> \@$sleep_command 4
|
||||
> \@echo Ok done",
|
||||
'-rR -j5', "Fail
|
||||
> \@#HELPER# sleep 4
|
||||
> \@#HELPER# out OK",
|
||||
'-rR -j5', "sleep 1\nFail\nfail 1
|
||||
#MAKE#: *** [#MAKEFILE#:10: fail.1] Error 1
|
||||
#MAKE#: *** Waiting for unfinished jobs....
|
||||
Fail
|
||||
sleep 2\nFail\nfail 1
|
||||
#MAKE#: *** [#MAKEFILE#:10: fail.2] Error 1
|
||||
Fail
|
||||
sleep 3\nFail\nfail 1
|
||||
#MAKE#: *** [#MAKEFILE#:10: fail.3] Error 1
|
||||
Ok done",
|
||||
sleep 4\nOK",
|
||||
512);
|
||||
|
||||
|
||||
|
@ -132,22 +124,22 @@ all:; @:
|
|||
|
||||
-include foo.d
|
||||
|
||||
foo.d: comp ; @echo building $@
|
||||
foo.d: comp ; @#HELPER# out $@
|
||||
|
||||
comp: mod_a.o mod_b.o; @:
|
||||
|
||||
mod_a.o mod_b.o: ; @exit 1
|
||||
', '-j2', '');
|
||||
mod_a.o mod_b.o: ; @#HELPER# fail 1
|
||||
', '-j2', "fail 1\nfail 1\n");
|
||||
|
||||
|
||||
# TEST #9 -- Savannah bugs 3330 and 15919
|
||||
# In earlier versions of make this will either give the wrong answer, or hang.
|
||||
|
||||
utouch(-10, 'target');
|
||||
run_make_test('target: intermed ; touch $@
|
||||
run_make_test('target: intermed ; #HELPER# file $@
|
||||
|
||||
.INTERMEDIATE: intermed
|
||||
intermed: | phony ; touch $@
|
||||
intermed: | phony ; #HELPER# file $@
|
||||
|
||||
.PHONY: phony
|
||||
phony: ; : phony', '-rR -j', ': phony');
|
||||
|
@ -161,12 +153,12 @@ $extraENV{MAKEFLAGS} = '-j4';
|
|||
run_make_test(q!
|
||||
things = thing1 thing2
|
||||
all: $(things)
|
||||
thing1:; @#PERL# jhelp.pl -w thing2start -f $@start -w thing2end -e $@end
|
||||
thing2:; @#PERL# jhelp.pl -f $@start -w thing1start -f $@end
|
||||
thing1:; @#HELPER# wait thing2start file $@start wait thing2end out $@end
|
||||
thing2:; @#HELPER# file $@start wait thing1start file $@end
|
||||
-include inc.mk
|
||||
inc.mk: ; @touch $@
|
||||
!,
|
||||
'', "thing2start\nthing1start\nthing2end\nthing1end\n");
|
||||
'', "file thing2start\nwait thing2start\nfile thing1start\nwait thing1start\nfile thing2end\nwait thing2end\nthing1end\n");
|
||||
|
||||
delete $extraENV{MAKEFLAGS};
|
||||
rmfiles(qw(inc.mk thing1start thing1end thing2start thing2end));
|
||||
|
@ -192,12 +184,12 @@ rmfiles('file1', 'file2', 'file3', 'file4');
|
|||
|
||||
run_make_test(q!
|
||||
all: one two
|
||||
one: ;@ #PERL# jhelp.pl -w TWO -f ONE
|
||||
two: ;@ #PERL# jhelp.pl -f TWO
|
||||
one: ;@ #HELPER# wait TWO file ONE
|
||||
two: ;@ #HELPER# file TWO
|
||||
include fff1.mk
|
||||
fff1.mk: ; touch $@
|
||||
!,
|
||||
'-j2', "touch fff1.mk\nTWO\nONE\n");
|
||||
'-j2', "touch fff1.mk\nfile TWO\nwait TWO\nfile ONE\n");
|
||||
|
||||
unlink('fff1.mk', 'ONE', 'TWO');
|
||||
|
||||
|
@ -207,9 +199,9 @@ unlink('fff1.mk', 'ONE', 'TWO');
|
|||
run_make_test(q!
|
||||
all: ; @$(MAKE) -f #MAKEFILE# recurse
|
||||
|
||||
recurse: one two ; @echo $@
|
||||
one: ;@ #PERL# jhelp.pl -w TWO -f ONE
|
||||
two: ;@ #PERL# jhelp.pl -f TWO
|
||||
recurse: one two ; @#HELPER# out $@
|
||||
one: ;@ #HELPER# wait TWO file ONE
|
||||
two: ;@ #HELPER# file TWO
|
||||
|
||||
mkinclude: ; touch fff1.mk
|
||||
|
||||
|
@ -218,7 +210,7 @@ include fff1.mk
|
|||
fff1.mk: ; @$(MAKE) -f #MAKEFILE# mkinclude
|
||||
endif
|
||||
!,
|
||||
'--no-print-directory -j2', "touch fff1.mk\nTWO\nONE\nrecurse\n");
|
||||
'--no-print-directory -j2', "touch fff1.mk\nfile TWO\nwait TWO\nfile ONE\nrecurse\n");
|
||||
|
||||
unlink('fff1.mk', 'ONE', 'TWO');
|
||||
|
||||
|
|
113
tests/thelp.pl
Executable file
113
tests/thelp.pl
Executable file
|
@ -0,0 +1,113 @@
|
|||
#!/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);
|
Loading…
Reference in a new issue