From: Paul Smith Date: Mon, 17 Apr 2017 19:37:57 +0000 (-0400) Subject: Add test suite support to Windows X-Git-Tag: 4.2.90~97 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=fda00f88d3180be1a898c19bfa23b7adba6c2a9e;p=thirdparty%2Fmake.git Add test suite support to Windows * main.c (main): Sanitize program name detection on Windows. * makeint.h: 'program' is a const string on all platforms now. * tests/run_make_tests.bat: Windows bat file to invoke tests * tests/test_driver.pl: Obtain system-specific error messages. (get_osname): Compute the $port_type here. Add more $osname checks for different Windows Perl ports. (_run_command): Rewrite the timeout capability to work properly with Windows. Don't use Perl fork/exec; instead use system(1,...) which allows a more reliable/proper kill operation. Also, allow options to be given as a list instead of a string, to allow more complex quoting of command-line arguments. * tests/run_make_tests.pl (run_make_with_options): Allow options to be provided as a list in addition to a simple string. (set_more_defaults): Write sample makefiles and run make on them instead of trying to run echo and invoking make with -f-, to avoid relying on shell and echo to get basic configuration values. Also create a $sh_name variable instead of hard-coding /bin/sh. * tests/scripts/features/archives: Skip on Windows. * tests/scripts/features/escape: Use list method for passing options. * tests/scripts/features/include: Use system-specific error messages. * tests/scripts/features/output-sync: "Command not found" errors generate very different / odd output on Windows. This needs to be addressed but for now disable these tests on Windows. * tests/scripts/functions/abspath: Disable on Windows. * tests/scripts/functions/file: Use system-specific error messages. * tests/scripts/functions/shell: "Command not found" errors generate very different / odd output on Windows. This needs to be addressed but for now disable these tests on Windows. * tests/scripts/misc/close_stdout: Disable on Windows. * tests/scripts/options/dash-k: Use system-specific error messages. * tests/scripts/options/dash-l: Disable on Windows. * tests/scripts/options/eval: Use list method for passing options. * tests/scripts/options/general: Skip some non-portable tests. * tests/scripts/targets/ONESHELL: Skip some non-portable tests. * tests/scripts/targets/POSIX: Skip some non-portable tests. * tests/scripts/variables/MAKEFILES: Skip some non-portable tests. * tests/scripts/variables/SHELL: Use a makefile not -f- for testing. --- diff --git a/README.W32.template b/README.W32.template index 0ac62324..15757669 100644 --- a/README.W32.template +++ b/README.W32.template @@ -104,6 +104,28 @@ Building with (MSVC++-)cl using NMakefile (this produces WinDebug/make.exe and WinRel/make.exe). +Running the test suite +---------------------- + + 3. You will need an installation of Perl. Be sure to use a relatively + modern version: older versions will sometimes throw spurious errors. + + To run the suite after building, use: + + cd tests + .\run_make_tests.bat -make + + I've found seems to want forward-slashes in the path. + For example if building with .\build_w32.bat non-debug, use: + + cd tests + .\run_make_tests.bat -make ../WinRel/gnumake.exe + + I've tested this with the MSYS2 shell and POSIX tools installation + that you get by installing Git for Windows. + + + ------------------- -- Notes/Caveats -- ------------------- @@ -160,10 +182,8 @@ GNU make and brain-dead shells (BATCH_MODE_ONLY_SHELL): Support for parallel builds - Parallel builds (-jN) are supported in this port, with 1 - limitation: The number of concurrent processes has a hard - limit of 64, due to the way this port implements waiting for - its subprocesses. + Parallel builds (-jN) are supported in this port. The number of + concurrent processes has a hard limit of 4095. GNU make and Cygnus GNU Windows32 tools: @@ -217,13 +237,6 @@ GNU make handling of drive letters in pathnames (PATH, vpath, VPATH): both Unix and Windows systems, then no ifdef'ing will be necessary in the makefile source. -GNU make test suite: - - I verified all functionality with a slightly modified version - of make-test-%VERSION% (modifications to get test suite to run - on Windows NT). All tests pass in an environment that includes - sh.exe. Tests were performed on both Windows NT and Windows 95. - Pathnames and white space: Unlike Unix, Windows 95/NT systems encourage pathnames which diff --git a/main.c b/main.c index 5b0a8544..5dd539b8 100644 --- a/main.c +++ b/main.c @@ -503,13 +503,7 @@ static struct command_variable *command_variables; /* The name we were invoked with. */ -#ifdef WINDOWS32 -/* On MS-Windows, we chop off the .exe suffix in 'main', so this - cannot be 'const'. */ -char *program; -#else const char *program; -#endif /* Our current directory before processing any -C options. */ @@ -1201,36 +1195,29 @@ main (int argc, char **argv, char **envp) program = "make"; else { - program = strrchr (argv[0], '/'); -#if defined(__MSDOS__) || defined(__EMX__) - if (program == 0) - program = strrchr (argv[0], '\\'); +#if defined(HAVE_DOS_PATHS) + const char* start = argv[0]; + + /* Skip an initial drive specifier if present. */ + if (isalpha ((unsigned char)start[0]) && start[1] == ':') + start += 2; + + if (start[0] == '\0') + program = "make"; else { - /* Some weird environments might pass us argv[0] with - both kinds of slashes; we must find the rightmost. */ - char *p = strrchr (argv[0], '\\'); - if (p && p > program) - program = p; - } - if (program == 0 && argv[0][1] == ':') - program = argv[0] + 1; -#endif -#ifdef WINDOWS32 - if (program == 0) - { - /* Extract program from full path */ - program = strrchr (argv[0], '\\'); - if (program) - { - int argv0_len = strlen (program); - if (argv0_len > 4 && streq (&program[argv0_len - 4], ".exe")) - /* Remove .exe extension */ - program[argv0_len - 4] = '\0'; - } + program = start + strlen (start); + while (program > start && ! STOP_SET (program[-1], MAP_DIRSEP)) + --program; + + /* Remove the .exe extension if present. */ + { + size_t len = strlen (program); + if (len > 4 && streq (&program[len - 4], ".exe")) + program = xstrndup (program, len - 4); + } } -#endif -#ifdef VMS +#elif defined(VMS) set_program_name (argv[0]); program = program_name; { @@ -1277,6 +1264,7 @@ main (int argc, char **argv, char **envp) if (need_vms_symbol () && !vms_use_mcr_command) create_foreign_command (program_name, argv[0]); #else + program = strrchr (argv[0], '/'); if (program == 0) program = argv[0]; else diff --git a/makeint.h b/makeint.h index d7266cff..9fb2dd83 100644 --- a/makeint.h +++ b/makeint.h @@ -664,11 +664,7 @@ extern char cmd_prefix; extern unsigned int job_slots; extern double max_load_average; -#ifdef WINDOWS32 -extern char *program; -#else extern const char *program; -#endif #ifdef VMS const char *vms_command (const char *argv0); diff --git a/tests/run_make_tests.bat b/tests/run_make_tests.bat new file mode 100644 index 00000000..b5376b63 --- /dev/null +++ b/tests/run_make_tests.bat @@ -0,0 +1,21 @@ +@echo off +rem Copyright (C) 2017 Free Software Foundation, Inc. +rem This file is part of GNU Make. +rem +rem GNU Make is free software; you can redistribute it and/or modify it under +rem the terms of the GNU General Public License as published by the Free +rem Software Foundation; either version 3 of the License, or (at your option) +rem any later version. +rem +rem GNU Make is distributed in the hope that it will be useful, but WITHOUT +rem ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +rem FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for. +rem more details. +rem +rem You should have received a copy of the GNU General Public License along +rem with this program. If not, see . + +setlocal +cd "%~dp0" + +perl -I. .\run_make_tests.pl %* diff --git a/tests/run_make_tests.pl b/tests/run_make_tests.pl index a8440941..d0e886bc 100644 --- a/tests/run_make_tests.pl +++ b/tests/run_make_tests.pl @@ -44,6 +44,9 @@ $all_tests = 0; # Shell commands +$sh_name = '/bin/sh'; +$is_posix_sh = 1; + $CMD_rmfile = 'rm -f'; # rmdir broken in some Perls on VMS. @@ -188,12 +191,35 @@ sub run_make_test $makefile = undef; } +sub add_options { + my $cmd = shift; + + foreach (@_) { + if (ref($cmd)) { + push(@$cmd, ref($_) ? @$_ : $_); + } else { + $cmd .= ' '.(ref($_) ? "@$_" : $_); + } + } + + return $cmd; +} + +sub create_command { + return !$_[0] || ref($_[0]) ? [$make_path] : $make_path; +} + # The old-fashioned way... +# $options can be a scalar (string) or a ref to an array of options +# If it's a scalar the entire argument is passed to system/exec etc. as +# a single string. If it's a ref then the array is passed to system/exec. +# Using a ref should be preferred as it's more portable but all the older +# invocations use strings. sub run_make_with_options { my ($filename,$options,$logname,$expected_code,$timeout,@call) = @_; @call = caller unless @call; - local($code); - local($command) = $make_path; + my $code; + my $command = create_command($options); $expected_code = 0 unless defined($expected_code); @@ -201,13 +227,14 @@ sub run_make_with_options { $test_passed = 1; if ($filename) { - $command .= " -f $filename"; + $command = add_options($command, '-f', $filename); } if ($options) { - if ($^O eq 'VMS') { + if (!ref($options) && $^O eq 'VMS') { # Try to make sure arguments are properly quoted. # This does not handle all cases. + # We should convert the tests to use array refs not strings # VMS uses double quotes instead of single quotes. $options =~ s/\'/\"/g; @@ -239,20 +266,22 @@ sub run_make_with_options { print ("Options fixup = -$options-\n") if $debug; } - $command .= " $options"; + + $command = add_options($command, $options); } - $command_string = ""; + my $cmdstr = ref($command) ? "'".join("' '", @$command)."'" : $command; + if (@call) { - $command_string = "#$call[1]:$call[2]\n"; + $command_string = "#$call[1]:$call[2]\n$cmdstr\n"; + } else { + $command_string = $cmdstr; } - $command_string .= "$command\n"; if ($valgrind) { - print VALGRIND "\n\nExecuting: $command\n"; + print VALGRIND "\n\nExecuting: $cmdstr\n"; } - { my $old_timeout = $test_timeout; $timeout and $test_timeout = $timeout; @@ -260,7 +289,11 @@ sub run_make_with_options { # If valgrind is enabled, turn off the timeout check $valgrind and $test_timeout = 0; - $code = &run_command_with_output($logname,$command); + if (ref($command)) { + $code = run_command_with_output($logname, @$command); + } else { + $code = run_command_with_output($logname, $command); + } $test_timeout = $old_timeout; } @@ -283,7 +316,7 @@ sub run_make_with_options { } if ($code != $expected_code) { - print "Error running $make_path (expected $expected_code; got $code): $command\n"; + print "Error running $make_path (expected $expected_code; got $code): $cmdstr\n"; $test_passed = 0; $runf = &get_runfile; &create_file (&get_runfile, $command_string); @@ -352,47 +385,11 @@ sub set_more_defaults local($string); local($index); - # find the type of the port. We do this up front to have a single - # point of change if it needs to be tweaked. - # - # This is probably not specific enough. - # - if ($osname =~ /Windows/i || $osname =~ /MINGW32/i || $osname =~ /CYGWIN_NT/i) { - $port_type = 'W32'; - } - # Bleah, the osname is so variable on DOS. This kind of bites. - # Well, as far as I can tell if we check for some text at the - # beginning of the line with either no spaces or a single space, then - # a D, then either "OS", "os", or "ev" and a space. That should - # match and be pretty specific. - elsif ($osname =~ /^([^ ]*|[^ ]* [^ ]*)D(OS|os|ev) /) { - $port_type = 'DOS'; - } - # Check for OS/2 - elsif ($osname =~ m%OS/2%) { - $port_type = 'OS/2'; - } - - # VMS has a GNV Unix mode or a DCL mode. - # The SHELL environment variable should not be defined in VMS-DCL mode. - elsif ($osname eq 'VMS' && !defined $ENV{"SHELL"}) { - $port_type = 'VMS-DCL'; - } - # Everything else, right now, is UNIX. Note that we should integrate - # the VOS support into this as well and get rid of $vos; we'll do - # that next time. - else { - $port_type = 'UNIX'; - } - # On DOS/Windows system the filesystem apparently can't track # timestamps with second granularity (!!). Change the sleep time # needed to force a file to be considered "old". $wtime = $port_type eq 'UNIX' ? 1 : $port_type eq 'OS/2' ? 2 : 4; - print "Port type: $port_type\n" if $debug; - print "Make path: $make_path\n" if $debug; - # Find the full pathname of Make. For DOS systems this is more # complicated, so we ask make itself. if ($osname eq 'VMS') { @@ -400,24 +397,36 @@ sub set_more_defaults # On VMS pre-setup make to be found with simply 'make'. $make_path = 'make'; } else { - my $mk = `sh -c 'echo "all:;\@echo \\\$(MAKE)" | $make_path -f-'`; + create_file('make.mk', 'all:;$(info $(MAKE))'); + my $mk = `$make_path -sf make.mk`; + unlink('make.mk'); chop $mk; - $mk or die "FATAL ERROR: Cannot determine the value of \$(MAKE):\n -'echo \"all:;\@echo \\\$(MAKE)\" | $make_path -f-' failed!\n"; + $mk or die "FATAL ERROR: Cannot determine the value of \$(MAKE)\n"; $make_path = $mk; } - print "Make\t= '$make_path'\n" if $debug; - my $redir2 = '2> /dev/null'; - $redir2 = '' if os_name eq 'VMS'; - $string = `$make_path -v -f /dev/null $redir2`; + # Ask make what shell to use + create_file('shell.mk', 'all:;$(info $(SHELL))'); + $sh_name = `$make_path -sf shell.mk`; + unlink('shell.mk'); + chop $sh_name; + if (! $sh_name) { + print "Cannot determine shell\n"; + $is_posix_sh = 0; + } else { + my $o = `$sh_name -c ': do nothing' 2>&1`; + $is_posix_sh = $? == 0 && $o == ''; + } - $string =~ /^(GNU Make [^,\n]*)/; + $string = `$make_path -v`; + $string =~ /^(GNU Make [^,\n]*)/ or die "$make_path is not GNU make. Version:\n$string"; $testee_version = "$1\n"; + create_file('null.mk', ''); + my $redir = '2>&1'; $redir = '' if os_name eq 'VMS'; - $string = `sh -c "$make_path -f /dev/null $redir"`; + $string = `sh -c "$make_path -f null.mk $redir"`; if ($string =~ /(.*): \*\*\* No targets\. Stop\./) { $make_name = $1; } @@ -466,7 +475,7 @@ sub set_more_defaults $purify_errors = 0; } - $string = `sh -c "$make_path -j 2 -f /dev/null $redir"`; + $string = `sh -c "$make_path -j 2 -f null.mk $redir"`; if ($string =~ /not supported/) { $parallel_jobs = 0; } @@ -474,7 +483,11 @@ sub set_more_defaults $parallel_jobs = 1; } - %FEATURES = map { $_ => 1 } split /\s+/, `sh -c "echo '\\\$(info \\\$(.FEATURES))' | $make_path -f- 2>/dev/null"`; + unlink('null.mk'); + + create_file('features.mk', 'all:;$(info $(.FEATURES))'); + %FEATURES = map { $_ => 1 } split /\s+/, `$make_path -sf features.mk`; + unlink('features.mk'); # Set up for valgrind, if requested. @@ -492,6 +505,16 @@ sub set_more_defaults system("echo Starting on `date` 1>&".fileno(VALGRIND)); print "Enabled valgrind support.\n"; } + + if ($debug) { + print "Port type: $port_type\n"; + print "Make path: $make_path\n"; + print "Shell path: $sh_name".($is_posix_sh ? ' (POSIX)' : '')."\n"; + print "#PWD#: $pwd\n"; + print "#PERL#: $perl_name\n"; + print "#MAKEPATH#: $mkpath\n"; + print "#MAKE#: $make_name\n"; + } } sub setup_for_test diff --git a/tests/scripts/features/archives b/tests/scripts/features/archives index a064dd44..111a1ffb 100644 --- a/tests/scripts/features/archives +++ b/tests/scripts/features/archives @@ -8,6 +8,10 @@ This only works on systems that support it."; # If this instance of make doesn't support archives, skip it exists $FEATURES{archives} or return -1; +# In theory archive support exists on Windows but it doesn't use ar; +# someone will need to port this test. +$port_type eq 'W32' and return -1; + # Create some .o files to work with if ($osname eq 'VMS') { use Cwd; diff --git a/tests/scripts/features/escape b/tests/scripts/features/escape index de0ef48a..5157a977 100644 --- a/tests/scripts/features/escape +++ b/tests/scripts/features/escape @@ -10,47 +10,58 @@ Make sure that backslash before non-special characters are kept."; # TEST 1 -run_make_test(' +run_make_test(q! +ifdef NOESC +path = pre: +endif +ifdef ONEESC +path = pre\: +endif +ifdef TWOESC +path = pre\\\\: +endif + $(path)foo : ; @echo "touch ($@)" foo\ bar: ; @echo "touch ($@)" sharp: foo\#bar.ext -foo\#bar.ext: ; @echo "foo#bar.ext = ($@)"', - '', - 'touch (foo)'); +foo\#bar.ext: ; @echo "foo#bar.ext = ($@)" +!, + '', + 'touch (foo)'); # TEST 2: This one should fail, since the ":" is unquoted. run_make_test(undef, - 'path=pre:', - "#MAKEFILE#:2: *** target pattern contains no '%'. Stop.", - 512); + 'NOESC=1', + "#MAKEFILE#:12: *** target pattern contains no '%'. Stop.", + 512); # TEST 3: This one should work, since we escape the ":". run_make_test(undef, - "'path=pre\\:'", - 'touch (pre:foo)'); + 'ONEESC=1', + 'touch (pre:foo)'); # TEST 4: This one should fail, since the escape char is escaped. run_make_test(undef, - "'path=pre\\\\:'", - "#MAKEFILE#:2: *** target pattern contains no '%'. Stop.", - 512); + 'TWOESC=1', + "#MAKEFILE#:12: *** target pattern contains no '%'. Stop.", + 512); # TEST 5: This one should work run_make_test(undef, - "'foo bar'", - 'touch (foo bar)'); + ['foo bar'], + 'touch (foo bar)'); # TEST 6: Test escaped comments run_make_test(undef, - 'sharp', - 'foo#bar.ext = (foo#bar.ext)'); + 'sharp', + 'foo#bar.ext = (foo#bar.ext)'); # Test escaped colons in prerequisites # Quoting of backslashes in q!! is kind of messy. diff --git a/tests/scripts/features/include b/tests/scripts/features/include index fe404ad9..0c63c067 100644 --- a/tests/scripts/features/include +++ b/tests/scripts/features/include @@ -147,24 +147,6 @@ baz: end "#MAKE#: *** No rule to make target 'end', needed by 'baz'. Stop.\n", 512); -# Test that the diagnostics is issued even if the target has been -# tried before with the dontcare flag (include/-include case). -# -run_make_test(' -include bar --include foo - -all: - -foo: baz -bar: baz -baz: end -', -'', -"#MAKEFILE#:2: bar: $ERR_no_such_file -#MAKE#: *** No rule to make target 'end', needed by 'baz'. Stop.\n", -512); - # Test include of make-able file doesn't show an error (Savannah #102) run_make_test(q! .PHONY: default @@ -179,19 +161,6 @@ inc2:; echo > $@ rmfiles('inc1', 'inc2'); -# Test include of non-make-able file does show an error (Savannah #102) -run_make_test(q! -.PHONY: default -default:; @echo DONE - -inc1:; echo > $@ -include inc1 -include inc2 -!, - '', "#MAKEFILE#:7: inc2: $ERR_no_such_file\n#MAKE#: *** No rule to make target 'inc2'. Stop.\n", 512); - -rmfiles('inc1'); - # No target gets correct error run_make_test('', '', '#MAKE#: *** No targets. Stop.', 512); @@ -212,48 +181,83 @@ include inc1 rmfiles('inc1'); -# Included file has a prerequisite that fails to build +if (defined $ERR_no_such_file) { -run_make_test(q! + # Test that the diagnostics is issued even if the target has been + # tried before with the dontcare flag (include/-include case). + # + run_make_test(' +include bar +-include foo + +all: + +foo: baz +bar: baz +baz: end +', +'', + "#MAKEFILE#:2: bar: $ERR_no_such_file\n#MAKE#: *** No rule to make target 'end', needed by 'baz'. Stop.\n", + 512); + + # Test include of non-make-able file does show an error (Savannah #102) + run_make_test(q! +.PHONY: default +default:; @echo DONE + +inc1:; echo > $@ +include inc1 +include inc2 +!, + '', "#MAKEFILE#:7: inc2: $ERR_no_such_file\n#MAKE#: *** No rule to make target 'inc2'. Stop.\n", 512); + + rmfiles('inc1'); + + # Included file has a prerequisite that fails to build + + run_make_test(q! default:; @echo DEFAULT include inc1 inc1: foo; echo > $@ foo:; exit 1 !, - '', "exit 1\n#MAKEFILE#:3: inc1: $ERR_no_such_file\n#MAKE#: *** [#MAKEFILE#:5: foo] Error 1\n", 512); + '', "exit 1\n#MAKEFILE#:3: inc1: $ERR_no_such_file\n#MAKE#: *** [#MAKEFILE#:5: foo] Error 1\n", 512); -rmfiles('inc1'); + rmfiles('inc1'); -# Included file has a prerequisite we don't know how to build + # Included file has a prerequisite we don't know how to build -run_make_test(q! + run_make_test(q! default:; @echo DEFAULT include inc1 inc1: foo; echo > $@ !, - '', "#MAKEFILE#:3: inc1: $ERR_no_such_file\n#MAKE#: *** No rule to make target 'foo', needed by 'inc1'. Stop.\n", 512); + '', "#MAKEFILE#:3: inc1: $ERR_no_such_file\n#MAKE#: *** No rule to make target 'foo', needed by 'inc1'. Stop.\n", 512); -rmfiles('inc1'); + rmfiles('inc1'); +} # Including files that can't be read should show an error -create_file('inc1', 'FOO := foo'); -chmod 0000, 'inc1'; +if (defined $ERR_unreadable_file) { + create_file('inc1', 'FOO := foo'); + chmod 0000, 'inc1'; -run_make_test(q! + run_make_test(q! include inc1 all:;@echo $(FOO) !, - '', "#MAKEFILE#:2: inc1: $ERR_unreadable_file\n#MAKE#: *** No rule to make target 'inc1'. Stop.", 512); + '', "#MAKEFILE#:2: inc1: $ERR_unreadable_file\n#MAKE#: *** No rule to make target 'inc1'. Stop.", 512); # Unreadable files that we know how to successfully recreate should work -run_make_test(sprintf(q! + run_make_test(sprintf(q! all:;@echo $(FOO) include inc1 inc1:; @%s $@ && echo FOO := bar > $@ !, $CMD_rmfile), - '', "bar"); + '', "bar"); -rmfiles('inc1'); + rmfiles('inc1'); +} 1; diff --git a/tests/scripts/features/output-sync b/tests/scripts/features/output-sync index 9fb3adec..914b381e 100644 --- a/tests/scripts/features/output-sync +++ b/tests/scripts/features/output-sync @@ -338,12 +338,13 @@ foo: $(OBJS) ; echo $(or $(filter %.o,$^),$(error fail)) '-O', "#MAKEFILE#:2: *** fail. Stop.\n", 512); # SV 47365: Make sure exec failure error messages are shown -# Is "127" not always the same everywhere? We may have to detect it? - -run_make_test(q! +# Needs to be ported to Windows +if ($port_type ne 'W32') { + run_make_test(q! all:: ; @./foo bar baz !, '-O', "#MAKE#: ./foo: Command not found\n#MAKE#: *** [#MAKEFILE#:2: all] Error 127\n", 512); +} # This tells the test driver that the perl test script executed properly. 1; diff --git a/tests/scripts/features/quoting b/tests/scripts/features/quoting index 916681c9..b7d95268 100644 --- a/tests/scripts/features/quoting +++ b/tests/scripts/features/quoting @@ -8,7 +8,6 @@ open(MAKEFILE,"> $makefile"); # The Contents of the MAKEFILE ... print MAKEFILE <<'EOM'; -SHELL = /bin/sh TEXFONTS = NICEFONT DEFINES = -DDEFAULT_TFM_PATH=\".:$(TEXFONTS)\" test: ; @"echo" 'DEFINES = $(DEFINES)' diff --git a/tests/scripts/features/reinvoke b/tests/scripts/features/reinvoke index eb1a3492..4b26a694 100644 --- a/tests/scripts/features/reinvoke +++ b/tests/scripts/features/reinvoke @@ -41,8 +41,6 @@ run_make_test(undef, '', "rebuilding #MAKEFILE#\nrunning rules.\n"); &touch('c'); run_make_test(' -SHELL = /bin/sh - all: ; @echo hello a : b ; echo >> $@ @@ -78,3 +76,7 @@ unlink('foo30723'); # This tells the test driver that the perl test script executed properly. 1; + +### Local Variables: +### eval: (setq whitespace-action (delq 'auto-cleanup whitespace-action)) +### End: diff --git a/tests/scripts/features/targetvars b/tests/scripts/features/targetvars index a9b8dbeb..72b7ddc7 100644 --- a/tests/scripts/features/targetvars +++ b/tests/scripts/features/targetvars @@ -7,7 +7,6 @@ values, override and non-override, and using various variable expansion rules, semicolon interference, etc."; run_make_test(' -SHELL = /bin/sh export FOO = foo export BAR = bar one: override FOO = one @@ -271,3 +270,7 @@ a: ; @echo $(A) # '', "local\n"); 1; + +### Local Variables: +### eval: (setq whitespace-action (delq 'auto-cleanup whitespace-action)) +### End: diff --git a/tests/scripts/features/vpathplus b/tests/scripts/features/vpathplus index 9ade3f0c..b4857171 100644 --- a/tests/scripts/features/vpathplus +++ b/tests/scripts/features/vpathplus @@ -12,9 +12,6 @@ open(MAKEFILE,"> $makefile"); print MAKEFILE "VPATH = $VP\n"; print MAKEFILE <<'EOMAKE'; - -SHELL = /bin/sh - .SUFFIXES: .a .b .c .d .PHONY: general rename notarget intermediate @@ -86,7 +83,7 @@ cat ${VP}foo.c bar.c > foo.b 2>/dev/null || exit 1 $answer = "not creating notarget.c from notarget.d cat notarget.c > notarget.b 2>/dev/null || exit 1 -$make_name: *** [$makefile:16: notarget.b] Error 1 +$make_name: *** [$makefile:13: notarget.b] Error 1 "; &compare_output($answer,&get_logfile(1)); diff --git a/tests/scripts/functions/abspath b/tests/scripts/functions/abspath index 84c30ab8..59bd3841 100644 --- a/tests/scripts/functions/abspath +++ b/tests/scripts/functions/abspath @@ -3,6 +3,9 @@ $description = "Test the abspath functions."; $details = ""; +# Someone needs to rewrite this to be portable for Windows +$port_type eq 'W32' and return -1; + run_make_test(' ifneq ($(realpath $(abspath .)),$(CURDIR)) $(warning .: abs="$(abspath .)" real="$(realpath $(abspath .))" curdir="$(CURDIR)") diff --git a/tests/scripts/functions/file b/tests/scripts/functions/file index c3f0b565..eaabd3ac 100644 --- a/tests/scripts/functions/file +++ b/tests/scripts/functions/file @@ -48,10 +48,11 @@ x:;@cat 4touch unlink('4touch'); # Test > to a read-only file -touch('file.out'); -chmod(0444, 'file.out'); +if (defined $ERR_read_only_file) { + touch('file.out'); + chmod(0444, 'file.out'); -run_make_test(q! + run_make_test(q! define A a b @@ -59,10 +60,11 @@ endef $(file > file.out,$(A)) x:;@cat file.out !, - '', "#MAKEFILE#:6: *** open: file.out: $ERR_read_only_file. Stop.", - 512); + '', "#MAKEFILE#:6: *** open: file.out: $ERR_read_only_file. Stop.", + 512); -unlink('file.out'); + unlink('file.out'); +} # Use variables for operator and filename run_make_test(q! diff --git a/tests/scripts/functions/realpath b/tests/scripts/functions/realpath index 9b503b42..fcea5155 100644 --- a/tests/scripts/functions/realpath +++ b/tests/scripts/functions/realpath @@ -3,78 +3,88 @@ $description = "Test the realpath functions."; $details = ""; +# Check the local directory's realpath run_make_test(' ifneq ($(realpath .),$(CURDIR)) - $(error ) + $(warning $(realpath .) != $(CURDIR)) endif ifneq ($(realpath ./),$(CURDIR)) - $(error ) + $(warning $(realpath ./) != $(CURDIR)) endif ifneq ($(realpath .///),$(CURDIR)) - $(error ) + $(warning $(realpath .///) != $(CURDIR)) endif -ifneq ($(realpath /),/) - $(error ) -endif +.PHONY: all +all: ; @: +', + '', ''); -ifneq ($(realpath /.),/) - $(error ) +# Find the realpath to the root of the partition +create_file('root.mk', 'all:;$(info $(realpath /))'); +my $root = `$make_path -sf root.mk`; +unlink('root.mk'); +chomp $root; + +my $tst = ' +ifneq ($(realpath /.),#ROOT#) + $(warning $(realpath /.) != #ROOT#) endif -ifneq ($(realpath /./),/) - $(error ) +ifneq ($(realpath /./),#ROOT#) + $(warning $(realpath /./) != #ROOT#) endif -ifneq ($(realpath /.///),/) - $(error ) +ifneq ($(realpath /.///),#ROOT#) + $(warning $(realpath /.///) != #ROOT#) endif -ifneq ($(realpath /..),/) - $(error ) +ifneq ($(realpath /..),#ROOT#) + $(warning $(realpath /..) != #ROOT#) endif -ifneq ($(realpath /../),/) - $(error ) +ifneq ($(realpath /../),#ROOT#) + $(warning $(realpath /../) != #ROOT#) endif -ifneq ($(realpath /..///),/) - $(error ) +ifneq ($(realpath /..///),#ROOT#) + $(warning $(realpath /..///) != #ROOT#) endif -ifneq ($(realpath . /..),$(CURDIR) /) - $(error ) +ifneq ($(realpath . /..),$(CURDIR) #ROOT#) + $(warning $(realpath . /..) != $(CURDIR) #ROOT#) endif .PHONY: all all: ; @: -', - '', - ''); +'; +$tst =~ s/#ROOT#/$root/g; +run_make_test($tst, '', ''); -# On Windows platforms, "//" means something special. So, don't do these -# tests there. +# On Windows platforms "//" means something special. So, don't do these tests +# there. if ($port_type ne 'W32') { - run_make_test(' -ifneq ($(realpath ///),/) - $(error ) + $tst = ' +ifneq ($(realpath ///),#ROOT#) + $(warning $(realpath ///) != #ROOT#) endif -ifneq ($(realpath ///.),/) - $(error ) +ifneq ($(realpath ///.),#ROOT#) + $(warning $(realpath ///.) != #ROOT#) endif -ifneq ($(realpath ///..),/) - $(error ) +ifneq ($(realpath ///..),#ROOT#) + $(warning $(realpath ///..) != #ROOT#) endif .PHONY: all -all: ; @:', - '', - ''); +all: ; @:'; + $tst =~ s/#ROOT#/$root/g; + + run_make_test($tst, '', ''); } diff --git a/tests/scripts/functions/shell b/tests/scripts/functions/shell index 0a549a72..24e94ab8 100644 --- a/tests/scripts/functions/shell +++ b/tests/scripts/functions/shell @@ -43,13 +43,17 @@ all: ; @echo $$HI ','','hi'); # Test shell errors in recipes including offset -run_make_test(' +# This needs to be ported to Windows, or else Windows error messages +# need to converted to look like more normal make errors. +if ($port_type ne 'W32') { + run_make_test(' all: @echo hi $(shell ./basdfdfsed there) @echo there ', - '', "#MAKE#: ./basdfdfsed: Command not found\nhi\nthere\n"); + '', "#MAKE#: ./basdfdfsed: Command not found\nhi\nthere\n"); +} 1; diff --git a/tests/scripts/misc/close_stdout b/tests/scripts/misc/close_stdout index 18606c3a..b16ea8da 100644 --- a/tests/scripts/misc/close_stdout +++ b/tests/scripts/misc/close_stdout @@ -2,8 +2,8 @@ $description = "Make sure make exits with an error if stdout is full."; -if (-e '/dev/full') { - run_make_test('', '-v > /dev/full', '/^#MAKE#: write error/', 256); -} +-e '/dev/full' or return -1; + +run_make_test('', '-v > /dev/full', '/^#MAKE#: write error/', 256); 1; diff --git a/tests/scripts/options/dash-k b/tests/scripts/options/dash-k index 86c7c787..cd78e7f0 100644 --- a/tests/scripts/options/dash-k +++ b/tests/scripts/options/dash-k @@ -100,15 +100,17 @@ $make_name: Target 'all' not remade because of errors.\n"; # TEST -- make sure we keep the error code if we can't create an included # makefile. -run_make_test('all: ; @echo hi +if (defined $ERR_no_such_file) { + run_make_test('all: ; @echo hi include ifile ifile: no-such-file; @false ', - '-k', - "#MAKEFILE#:2: ifile: $ERR_no_such_file + '-k', + "#MAKEFILE#:2: ifile: $ERR_no_such_file #MAKE#: *** No rule to make target 'no-such-file', needed by 'ifile'. #MAKE#: Failed to remake makefile 'ifile'. hi\n", - 512); + 512); +} 1; diff --git a/tests/scripts/options/dash-l b/tests/scripts/options/dash-l index a36b7ae1..637c8bd8 100644 --- a/tests/scripts/options/dash-l +++ b/tests/scripts/options/dash-l @@ -16,23 +16,24 @@ that the load will be above this number and make will therefore decide that it cannot run more than one job even though -j 4 was also specified on the command line."; -open(MAKEFILE,"> $makefile"); -print MAKEFILE qq, -SHELL = /bin/sh +# On Windows a very different algorithm is used. +$port_type eq 'W32' and return -1; +open(MAKEFILE,"> $makefile"); +printf MAKEFILE q, define test -if [ ! -f test-file ]; then \\ - echo >> test-file; sleep 2; $CMD_rmfile test-file; \\ -else \\ - echo \$\@ FAILED; \\ +if [ ! -f test-file ]; then \ + echo >> test-file; sleep 2; %s test-file; \ +else \ + echo $@ FAILED; \ fi endef all : ONE TWO THREE -ONE : ; \@\$(test) -TWO : ; \@\$(test) -THREE : ; \@\$(test) -,; +ONE : ; @$(test) +TWO : ; @$(test) +THREE : ; @$(test) +,, $CMD_rmfile; close(MAKEFILE); $mkoptions = "-l 0.0001"; diff --git a/tests/scripts/options/eval b/tests/scripts/options/eval index b02b9255..54a3a4f0 100644 --- a/tests/scripts/options/eval +++ b/tests/scripts/options/eval @@ -11,17 +11,17 @@ $(info infile) BAR = bar all: ; @echo all recurse: ; @$(MAKE) -f #MAKEFILE# && echo recurse!, - '--eval=\$\(info\ eval\) FOO=\$\(BAR\)', "eval\ninfile\nall"); + ['--eval=$(info eval)', 'FOO=$(BAR)'], "eval\ninfile\nall"); # Make sure that --eval is handled correctly during recursion -run_make_test(undef, '--no-print-directory --eval=\$\(info\ eval\) recurse', +run_make_test(undef, ['--no-print-directory', '--eval=$(info eval)', 'recurse'], "eval\ninfile\neval\ninfile\nall\nrecurse"); # Make sure that --eval is not passed in MAKEFLAGS run_make_test(q! all: ; @echo "MAKEFLAGS=$$MAKEFLAGS" !, - '--eval=\$\(info\ eval\)', + ['--eval=$(info eval)'], "eval\n".'MAKEFLAGS= --eval=$$(info\ eval)'); # Make sure that --eval is handled correctly during restarting @@ -30,7 +30,7 @@ all: ; @echo $@ -include gen.mk gen.mk: ; @echo > $@ !, - '--eval=\$\(info\ eval\)', "eval\neval\nall"); + ['--eval=$(info eval)'], "eval\neval\nall"); unlink('gen.mk'); @@ -39,6 +39,6 @@ run_make_test(q! BAR = bar all: ; @echo all recurse: ; @$(MAKE) -f #MAKEFILE# && echo recurse!, - '-E \$\(info\ eval\) FOO=\$\(BAR\)', "eval\nall"); + ['-E', '$(info eval)', 'FOO=$(BAR)'], "eval\nall"); 1; diff --git a/tests/scripts/options/general b/tests/scripts/options/general index d35bb358..702fb55b 100644 --- a/tests/scripts/options/general +++ b/tests/scripts/options/general @@ -1,35 +1,30 @@ # -*-perl-*- $description = "Test generic option processing.\n"; -open(MAKEFILE, "> $makefile"); - -# The Contents of the MAKEFILE ... - -print MAKEFILE "foo 1foo: ; \@echo \$\@\n"; - -close(MAKEFILE); - # TEST 0 -&run_make_with_options($makefile, "-j 1foo", &get_logfile); if (!$parallel_jobs) { - $answer = "$make_name: Parallel jobs (-j) are not supported on this platform.\n$make_name: Resetting to single job (-j1) mode.\n1foo\n"; + $answer = "#MAKE#: Parallel jobs (-j) are not supported on this platform.\n#MAKE#: Resetting to single job (-j1) mode.\n1foo\n"; } else { $answer = "1foo\n"; } +run_make_test(q! +foo 1foo: ; @echo $@ +!, + "-j 1foo", $answer); + # TEST 1 # This test prints the usage string; I don't really know a good way to # test it. I guess I could invoke make with a known-bad option to see # what the usage looks like, then compare it to what I get here... :( -# If I were always on UNIX, I could invoke it with 2>/dev/null, then -# just check the error code. +# On UNIX I can invoke it with 2>/dev/null, then just check the error code. -&run_make_with_options($makefile, "-j1foo 2>/dev/null", &get_logfile, 512); -$answer = ""; -&compare_output($answer, &get_logfile(1)); +if ($port_type ne 'W32') { + run_make_test(undef, "-j1foo 2>/dev/null", '', 512); +} 1; diff --git a/tests/scripts/targets/ONESHELL b/tests/scripts/targets/ONESHELL index 87713da4..3876966a 100644 --- a/tests/scripts/targets/ONESHELL +++ b/tests/scripts/targets/ONESHELL @@ -4,10 +4,14 @@ $description = "Test the behaviour of the .ONESHELL target."; $details = ""; -# Some shells (*shakes fist at Solaris*) cannot handle multiple flags in -# separate arguments. -my $t = `/bin/sh -e -c true 2>/dev/null`; -my $multi_ok = $? == 0; +my $multi_ok = 0; + +if ($port_type ne 'W32') { + # Some shells (*shakes fist at Solaris*) cannot handle multiple flags in + # separate arguments. + my $t = `$sh_name -e -c true 2>/dev/null`; + my $multi_ok = $? == 0; +} # Simple @@ -71,8 +75,9 @@ all: # Now try using a different interpreter - -run_make_test(q! +# This doesn't work on Windows right now +if ($port_type ne 'W32') { + run_make_test(q! .RECIPEPREFIX = > .ONESHELL: SHELL = #PERL# @@ -83,6 +88,7 @@ all: > @y=qw(a b c); >print "a = $$a, y = (@y)\n"; !, - '', "a = 12, y = (a b c)\n"); + '', "a = 12, y = (a b c)\n"); +} 1; diff --git a/tests/scripts/targets/POSIX b/tests/scripts/targets/POSIX index 5c3c7f89..f9da8c35 100644 --- a/tests/scripts/targets/POSIX +++ b/tests/scripts/targets/POSIX @@ -11,7 +11,7 @@ $details = ""; my $script = 'false; true'; my $flags = '-ec'; -my $out = `/bin/sh $flags '$script' 2>&1`; +my $out = `$sh_name $flags '$script' 2>&1`; my $err = $? >> 8; run_make_test(qq! .POSIX: @@ -21,7 +21,7 @@ all: ; \@$script # User settings must override .POSIX $flags = '-xc'; -$out = `/bin/sh $flags '$script' 2>&1`; +$out = `$sh_name $flags '$script' 2>&1`; run_make_test(qq! .SHELLFLAGS = $flags .POSIX: @@ -36,7 +36,6 @@ my %POSIX = (AR => 'ar', ARFLAGS => '-rv', LDFLAGS => '', CC => 'c99', CFLAGS => '-O', FC => 'fort77', FFLAGS => '-O 1', - GET => 'get', GFLAGS => '', SCCSFLAGS => '', SCCSGETFLAGS => '-s'); my $make = join('', map { "\t\@echo '$_=\$($_)'\n" } sort keys %POSIX); my $r = join('', map { "$_=$POSIX{$_}\n"} sort keys %POSIX); diff --git a/tests/scripts/variables/MAKEFILES b/tests/scripts/variables/MAKEFILES index b23da8ea..564d9960 100644 --- a/tests/scripts/variables/MAKEFILES +++ b/tests/scripts/variables/MAKEFILES @@ -5,11 +5,6 @@ $description = "Test the MAKEFILES variable."; $makefile2 = &get_tmpfile; $makefile3 = &get_tmpfile; -open(MAKEFILE,"> $makefile"); -print MAKEFILE 'all: ; @echo DEFAULT RULE: M2=$(M2) M3=$(M3)', "\n"; -close(MAKEFILE); - - open(MAKEFILE,"> $makefile2"); print MAKEFILE <&1`; +my $out = `$sh_name $flags '$script' 2>&1`; run_make_test(qq! .SHELLFLAGS = $flags @@ -74,7 +79,7 @@ all: ; \@$script # Some shells (*shakes fist at Solaris*) cannot handle multiple flags in # separate arguments. -my $t = `/bin/sh -e -c true 2>/dev/null`; +my $t = `$sh_name -e -c true 2>/dev/null`; my $multi_ok = $? == 0; if ($multi_ok) { @@ -90,7 +95,7 @@ all: ; \@$script # different exit code--once again Solaris: false exits with 255 not 1 $script = 'true; false; true'; $flags = '-xec'; -$out = `/bin/sh $flags '$script' 2>&1`; +$out = `$sh_name $flags '$script' 2>&1`; my $err = $? >> 8; run_make_test(qq! diff --git a/tests/scripts/variables/negative b/tests/scripts/variables/negative index 16a72b89..0f9abc82 100644 --- a/tests/scripts/variables/negative +++ b/tests/scripts/variables/negative @@ -18,7 +18,7 @@ all: ; @echo $y # TEST #1 # Bogus variable value passed on the command line. run_make_test(undef, - 'x=\$\(other', + ['x=$(other'], '#MAKEFILE#:4: *** unterminated variable reference. Stop.', 512); @@ -39,7 +39,7 @@ all: ; @echo $y # TEST #3 # Bogus variable value passed on the command line. run_make_test(undef, - 'x=\$\(other', + ['x=$(other'], '#MAKEFILE#:4: *** unterminated variable reference. Stop.', 512); diff --git a/tests/test_driver.pl b/tests/test_driver.pl index cb0a1b21..1824b1dc 100644 --- a/tests/test_driver.pl +++ b/tests/test_driver.pl @@ -52,8 +52,9 @@ $test_passed = 1; $test_timeout = 5; $test_timeout = 10 if $^O eq 'VMS'; -# Path to Perl +# Path to Perl--make sure it uses forward-slashes $perl_name = $^X; +$perl_name =~ tr,\\,/,; # Find the strings that will be generated for various error codes. # We want them from the C locale regardless of our current locale. @@ -64,19 +65,37 @@ if ($has_POSIX) { POSIX::setlocale(POSIX::LC_MESSAGES, 'C'); } -open(my $F, '<', 'file.none') and die "Opened non-existent file!\n"; -$ERR_no_such_file = "$!"; +$ERR_no_such_file = undef; +$ERR_read_only_file = undef; +$ERR_unreadable_file = undef; +if (open(my $F, '<', 'file.none')) { + print "Opened non-existent file! Skipping related tests.\n"; +} else { + $ERR_no_such_file = "$!"; +} + +unlink('file.out'); touch('file.out'); + chmod(0444, 'file.out'); -open(my $F, '>', 'file.out') and die "Opened read-only file!\n"; -$ERR_read_only_file = "$!"; +if (open(my $F, '>', 'file.out')) { + print "Opened read-only file! Skipping related tests.\n"; + close($F); +} else { + $ERR_read_only_file = "$!"; +} chmod(0000, 'file.out'); -open(my $F, '<', 'file.out') and die "Opened unreadable file!\n"; -$ERR_unreadable_file = "$!"; +if (open(my $F, '<', 'file.out')) { + print "Opened unreadable file! Skipping related tests.\n"; + close($F); +} else { + $ERR_unreadable_file = "$!"; +} + +unlink('file.out') or die "Failed to delete file.out: $!\n"; -unlink('file.out'); $loc and POSIX::setlocale(POSIX::LC_MESSAGES, $loc); # %makeENV is the cleaned-out environment. @@ -332,6 +351,40 @@ sub get_osname # Set up an initial value. In perl5 we can do it the easy way. $osname = defined($^O) ? $^O : ''; + # find the type of the port. We do this up front to have a single + # point of change if it needs to be tweaked. + # + # This is probably not specific enough. + # + if ($osname =~ /MSWin32/i || $osname =~ /Windows/i + || $osname =~ /MINGW32/i || $osname =~ /CYGWIN_NT/i) { + $port_type = 'W32'; + } + # Bleah, the osname is so variable on DOS. This kind of bites. + # Well, as far as I can tell if we check for some text at the + # beginning of the line with either no spaces or a single space, then + # a D, then either "OS", "os", or "ev" and a space. That should + # match and be pretty specific. + elsif ($osname =~ /^([^ ]*|[^ ]* [^ ]*)D(OS|os|ev) /) { + $port_type = 'DOS'; + } + # Check for OS/2 + elsif ($osname =~ m%OS/2%) { + $port_type = 'OS/2'; + } + + # VMS has a GNV Unix mode or a DCL mode. + # The SHELL environment variable should not be defined in VMS-DCL mode. + elsif ($osname eq 'VMS' && !defined $ENV{"SHELL"}) { + $port_type = 'VMS-DCL'; + } + # Everything else, right now, is UNIX. Note that we should integrate + # the VOS support into this as well and get rid of $vos; we'll do + # that next time. + else { + $port_type = 'UNIX'; + } + if ($osname eq 'VMS') { $vos = 0; @@ -1008,59 +1061,92 @@ sub detach_default_output open (STDERR, '>&', pop @ERRSTACK) or error("ddo: $! duping STDERR\n", 1); } +sub _run_with_timeout +{ + my $code; + if ($^O eq 'VMS') { + #local $SIG{ALRM} = sub { + # my $e = $ERRSTACK[0]; + # print $e "\nTest timed out after $test_timeout seconds\n"; + # die "timeout\n"; + #}; + #alarm $test_timeout; + system(@_); + #alarm 0; + my $severity = ${^CHILD_ERROR_NATIVE} & 7; + $code = 0; + if (($severity & 1) == 0) { + $code = 512; + } + + # Get the vms status. + my $vms_code = ${^CHILD_ERROR_NATIVE}; + + # Remove the print status bit + $vms_code &= ~0x10000000; + + # Posix code translation. + if (($vms_code & 0xFFFFF000) == 0x35a000) { + $code = (($vms_code & 0xFFF) >> 3) * 256; + } + + } elsif ($port_type eq 'W32') { + my $pid = system(1, @_); + $pid > 0 or die "Cannot execute $_[0]\n"; + local $SIG{ALRM} = sub { + my $e = $ERRSTACK[0]; + print $e "\nTest timed out after $test_timeout seconds\n"; + kill -9, $pid; + die "timeout\n"; + }; + alarm $test_timeout; + my $r = waitpid($pid, 0); + alarm 0; + $r == -1 and die "No such pid: $pid\n"; + # This shouldn't happen since we wait forever or timeout via SIGALRM + $r == 0 and die "No process exited.\n"; + $code = $?; + + } else { + my $pid = fork(); + if (! $pid) { + exec(@_) or die "exec: Cannot execute $_[0]\n"; + } + local $SIG{ALRM} = sub { + my $e = $ERRSTACK[0]; + print $e "\nTest timed out after $test_timeout seconds\n"; + # Resend the alarm to our process group to kill the children. + $SIG{ALRM} = 'IGNORE'; + kill -14, $$; + die "timeout\n"; + }; + alarm $test_timeout; + my $r = waitpid($pid, 0); + alarm 0; + $r == -1 and die "No such pid: $pid\n"; + # This shouldn't happen since we wait forever or timeout via SIGALRM + $r == 0 and die "No process exited.\n"; + $code = $?; + } + + return $code; +} + # This runs a command without any debugging info. sub _run_command { - my $code; - # We reset this before every invocation. On Windows I think there is only # one environment, not one per process, so I think that variables set in # test scripts might leak into subsequent tests if this isn't reset--??? resetENV(); - eval { - if ($^O eq 'VMS') { - local $SIG{ALRM} = sub { - my $e = $ERRSTACK[0]; - print $e "\nTest timed out after $test_timeout seconds\n"; - die "timeout\n"; }; -# alarm $test_timeout; - system(@_); - my $severity = ${^CHILD_ERROR_NATIVE} & 7; - $code = 0; - if (($severity & 1) == 0) { - $code = 512; - } - - # Get the vms status. - my $vms_code = ${^CHILD_ERROR_NATIVE}; - - # Remove the print status bit - $vms_code &= ~0x10000000; + my $orig = $SIG{ALRM}; + my $code = eval { _run_with_timeout(@_); }; + $SIG{ALRM} = $orig; - # Posix code translation. - if (($vms_code & 0xFFFFF000) == 0x35a000) { - $code = (($vms_code & 0xFFF) >> 3) * 256; - } - } else { - my $pid = fork(); - if (! $pid) { - exec(@_) or die "Cannot execute $_[0]\n"; - } - local $SIG{ALRM} = sub { my $e = $ERRSTACK[0]; print $e "\nTest timed out after $test_timeout seconds\n"; die "timeout\n"; }; - alarm $test_timeout; - waitpid($pid, 0) > 0 or die "No such pid: $pid\n"; - $code = $?; - } - alarm 0; - }; if ($@) { # The eval failed. If it wasn't SIGALRM then die. $@ eq "timeout\n" or die "Command failed: $@"; - - # Timed out. Resend the alarm to our process group to kill the children. - $SIG{ALRM} = 'IGNORE'; - kill -14, $$; $code = 14; }