This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert Windows test watchdog() to kill('KILL', ...)
authorSteve Hay <steve.m.hay@googlemail.com>
Mon, 18 May 2015 17:13:33 +0000 (18:13 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Tue, 19 May 2015 07:10:49 +0000 (08:10 +0100)
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

t/test.pl

index 7063506..cda3840 100644 (file)
--- 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;
         }