summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Hay <steve.m.hay@googlemail.com>2015-05-18 18:13:33 +0100
committerSteve Hay <steve.m.hay@googlemail.com>2015-05-19 08:10:49 +0100
commita68d0dcb5125eb9a5a724f289abc7446dce0b12a (patch)
tree73007aa65ad905a88e46b7a7e9247ef7d6dfb543
parent38da2237eba18b80fb53f656ed0741131eae32a3 (diff)
downloadperl-a68d0dcb5125eb9a5a724f289abc7446dce0b12a.tar.gz
Revert Windows test watchdog() to kill('KILL', ...)
There are suspicions that the process tree kill('-KILL', ...) might be nuking too much. It was only done to kill the cmd.exe+perl.exe tree that was unexpectedly launched by system(1, $cmd), but by switching to system({$perl} 1, $perl, '-e', $prog) we can avoid the intermediate cmd.exe and thus revert to normal process kill('KILL', ...) instead to kill the perl.exe that is now launched directly. See http://www.nntp.perl.org/group/perl.perl5.porters/2015/05/msg227859.html
-rw-r--r--t/test.pl33
1 files changed, 22 insertions, 11 deletions
diff --git a/t/test.pl b/t/test.pl
index 7063506e27..cda3840c60 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -1589,10 +1589,27 @@ sub watchdog ($;$)
_diag("Watchdog warning: $_[0]");
};
my $sig = $is_vms ? 'TERM' : 'KILL';
- my $cmd = _create_runperl( prog => "sleep($timeout);" .
- "warn qq/# $timeout_msg" . '\n/;' .
- "kill(q/$sig/, $pid_to_kill);");
- $watchdog = system(1, $cmd);
+ my $prog = "sleep($timeout);" .
+ "warn qq/# $timeout_msg" . '\n/;' .
+ "kill(q/$sig/, $pid_to_kill);";
+
+ # On Windows use the indirect object plus LIST form to guarantee
+ # that perl is launched directly rather than via the shell (see
+ # perlfunc.pod), and ensure that the LIST has multiple elements
+ # since the indirect object plus COMMANDSTRING form seems to
+ # hang (see perl #121283). Don't do this on VMS, which doesn't
+ # support the LIST form at all.
+ if ($is_mswin) {
+ my $runperl = which_perl();
+ if ($runperl =~ m/\s/) {
+ $runperl = qq{"$runperl"};
+ }
+ $watchdog = system({ $runperl } 1, $runperl, '-e', $prog);
+ }
+ else {
+ my $cmd = _create_runperl(prog => $prog);
+ $watchdog = system(1, $cmd);
+ }
};
if ($@ || ($watchdog <= 0)) {
_diag('Failed to start watchdog');
@@ -1603,13 +1620,7 @@ sub watchdog ($;$)
# Add END block to parent to terminate and
# clean up watchdog process
- # Win32 watchdog is launched by cmd.exe shell, so use process group
- # kill, otherwise the watchdog is never killed and harness waits
- # every time for the timeout, #121395
- eval( $is_mswin ?
- "END { local \$! = 0; local \$? = 0;
- wait() if kill('-KILL', $watchdog); };"
- : "END { local \$! = 0; local \$? = 0;
+ eval("END { local \$! = 0; local \$? = 0;
wait() if kill('KILL', $watchdog); };");
return;
}