test.pl: watchdog: Simplify, clarify, recover from failure

t/test.pl

@@ -1836,34 +1836,35 @@ sub warning_like {
 # NOTE:  If the test file uses 'threads', then call the watchdog() function
 #        _AFTER_ the 'threads' module is loaded.
 { # Closure
-    my $watchdog;
+    my $watchdog_process;
     my $watchdog_thread;
+    my $watchdog_alarm;
+
+    # Add END block to terminate and clean up any watchdog
+    END { watchdog(0); };
 
 sub watchdog ($;$)
 {
     my $timeout = shift;
 
-    # If cancelling, use the state variables to know which method was used to
-    # create the watchdog.
-    if ($timeout == 0) {
-        if ($watchdog_thread) {
-            $watchdog_thread->kill('KILL');
-            undef $watchdog_thread;
-        }
-        elsif ($watchdog) {
-            kill('KILL', $watchdog);
-            undef $watchdog;
-        }
-        else {
-            alarm(0);
-        }
-
-        return;
+    # Cancel any existing timer, so the caller can set multiple ones without
+    # cancelling first.  For safety, handle the case where somehow more than
+    # one type of watchdog got set.
+    if ($watchdog_thread) {
+        $watchdog_thread->kill('KILL');
+        undef $watchdog_thread;
+    }
+    if ($watchdog_process) {
+        kill('KILL', $watchdog_process);
+        undef $watchdog_process;
+    }
+    if ($watchdog_alarm) {
+        alarm(0);
+        undef $watchdog_alarm;
     }
 
-    # Make sure these aren't defined.
-    undef $watchdog;
-    undef $watchdog_thread;
+    # We are done if this call was just to cancel
+    return if $timeout == 0;
 
     my $method = shift || "";
 
@@ -1890,10 +1891,12 @@ ($;$)
     # shut up use only once warning
     my $threads_on = $threads::threads && $threads::threads;
 
-    # Don't use a watchdog process if 'threads' is loaded -
-    #   use a watchdog thread instead
-    if (!$threads_on || $method eq "process") {
-
+    # Use a watchdog process unless 'threads' is loaded and is killable by a
+    # signal
+    if (   ! $threads_on
+        || (defined $ENV{PERL_SIGNALS} && $ENV{PERL_SIGNALS} eq "unsafe")
+        || $method eq "process")
+    {
         # On Windows and VMS, try launching a watchdog process
         #   using system(1, ...) (see perlport.pod).  system() returns
         #   immediately on these platforms with effectively a pid of the new
@@ -1911,12 +1914,11 @@ ($;$)
             return if ($pid_to_kill <= 0);
 
             # Launch watchdog process
-            undef $watchdog;
             eval {
                 local $SIG{'__WARN__'} = sub {
-                    _diag("Watchdog warning: $_[0]");
-                };
-                my $sig = $is_vms ? 'TERM' : 'KILL';
+                                             _diag("Watchdog warning: $_[0]");
+                                             };
+                my $sig = ($is_vms) ? 'TERM' : 'KILL';
                 my $prog = "sleep($timeout);" .
                            "warn qq/# $timeout_msg" . '\n/;' .
                            "kill(q/$sig/, $pid_to_kill);";
@@ -1938,38 +1940,29 @@ ($;$)
                     if ($runperl =~ m/\s/) {
                         $runperl = qq{"$runperl"};
                     }
-                    $watchdog = system({ $runperl } 1, $runperl, '-e', $prog);
+                    $watchdog_process =
+                                system({ $runperl } 1, $runperl, '-e', $prog);
                 }
                 else {
                     my $cmd = _create_runperl(prog => $prog);
-                    $watchdog = system(1, $cmd);
+                    $watchdog_process = system(1, $cmd);
                 }
             };
-            if ($@ || ($watchdog <= 0)) {
-                _diag('Failed to start watchdog');
-                _diag($@) if $@;
-                undef($watchdog);
-                return;
+
+            if ($@ || $watchdog_process <= 0) {
+                $@ = "\n$@" if $@;
+                _diag("Failed to start watchdog$@\nTrying alternate method");
+                undef($watchdog_process);
+                goto WATCHDOG_VIA_ALARM;
             }
 
-            # Add END block to parent to terminate and
-            #   clean up watchdog process
-            eval("END { local \$! = 0; local \$? = 0;
-                        wait() if kill('KILL', $watchdog); };");
             return;
         }
 
         # Try using fork() to generate a watchdog process
-        undef $watchdog;
-        eval { $watchdog = fork() };
-        if (defined($watchdog)) {
-            if ($watchdog) {   # Parent process
-                # Add END block to parent to terminate and
-                #   clean up watchdog process
-                eval "END { local \$! = 0; local \$? = 0;
-                            wait() if kill('KILL', $watchdog); };";
-                return;
-            }
+        eval { $watchdog_process = fork() };
+        if (defined($watchdog_process)) {
+            return if $watchdog_process;  # Parent process
 
             ### Watchdog process code
 
@@ -2002,8 +1995,8 @@ ($;$)
         # fork() failed - fall through and try using a thread
     }
 
-    # Use a watchdog thread because either 'threads' is loaded,
-    #   or fork() failed
+    # Use a watchdog thread because either 'threads' is loaded, or fork()
+    # failed
     if (eval {require threads; 1}) {
         $watchdog_thread = 'threads'->create(sub {
                 # Load POSIX if available
@@ -2042,20 +2035,21 @@ ($;$)
         return;
     }
 
-    # If everything above fails, then just use an alarm timeout
+    # If everything above fails, then just use an alarm timeout.
 WATCHDOG_VIA_ALARM:
     if (eval { alarm($timeout); 1; }) {
         # Load POSIX if available
         eval { require POSIX; };
 
         # Alarm handler will do the actual 'killing'
         $SIG{'ALRM'} = sub {
-            select(STDERR); $| = 1;
-            _diag($timeout_msg);
-            POSIX::_exit(1) if (defined(&POSIX::_exit));
-            my $sig = $is_vms ? 'TERM' : 'KILL';
-            kill($sig, $pid_to_kill);
-        };
+                             select(STDERR); $| = 1;
+                             _diag($timeout_msg);
+                             POSIX::_exit(1) if (defined(&POSIX::_exit));
+                             my $sig = ($is_vms) ? 'TERM' : 'KILL';
+                             kill($sig, $pid_to_kill);
+                           };
+        $watchdog_alarm = 1;
     }
 }
 } # End closure

t/test_pl.pod

@@ -489,8 +489,8 @@ Note: currently only used by F<test.pl> itself.
 
 =item watchdog($timeout, $method);
 
-Start a watchdog timer for C<$timeout> seconds.  If C<$timeout> is
-zero then disables any existing watchdog timer.
+Start a watchdog timer for C<$timeout> seconds, while disabling any
+existing one.  If C<$timeout> is zero no new timer is created.
 
 The timeout may be scaled by setting C<PERL_TEST_TIME_OUT_FACTOR> or
 C<PERL_TEST_TIMEOUT_FACTOR> in the environment.  If C<PERL_VALGRIND>