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
2025-01-27 04:40:33 +08:00 · 2019-10-12 16:22:01 -04:00 · 2019-10-12 16:22:01 -04:00 · 3822f77c1d
commit 3822f77c1d
parent 1cf3932a39
6 changed files with 186 additions and 141 deletions
--- a/Makefile.am
+++ b/Makefile.am
@ -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) \
--- a/tests/jhelp.pl
+++ b/tests/jhelp.pl
@ -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);
--- a/tests/run_make_tests.pl
+++ b/tests/run_make_tests.pl
@ -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}
--- a/tests/scripts/features/output-sync
+++ b/tests/scripts/features/output-sync
@ -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();

--- a/tests/scripts/features/parallelism
+++ b/tests/scripts/features/parallelism
@ -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');

--- a/tests/thelp.pl
+++ b/tests/thelp.pl
@ -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);