diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2015-05-18 18:13:33 +0100 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2015-05-19 08:10:49 +0100 |
commit | a68d0dcb5125eb9a5a724f289abc7446dce0b12a (patch) | |
tree | 73007aa65ad905a88e46b7a7e9247ef7d6dfb543 | |
parent | 38da2237eba18b80fb53f656ed0741131eae32a3 (diff) | |
download | perl-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.pl | 33 |
1 files changed, 22 insertions, 11 deletions
@@ -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; } |