From 396624fefcc569e3aebb073f6a7dfeea72d83938 Mon Sep 17 00:00:00 2001
From: Andrew Johnson <anj@anl.gov>
Date: Fri, 19 Mar 2021 20:20:06 -0500
Subject: [PATCH] Timeouts for running unit test programs

The generated .t file now kills the test program if it hasn't
completed within a defined interval, 5 minutes by default.
Separate implementations for Windows and Unix hosts.
---
 src/tools/makeTestfile.pl | 116 ++++++++++++++++++++++++++++----------
 1 file changed, 86 insertions(+), 30 deletions(-)

diff --git a/src/tools/makeTestfile.pl b/src/tools/makeTestfile.pl
index 7a8234962..9afb24e73 100644
--- a/src/tools/makeTestfile.pl
+++ b/src/tools/makeTestfile.pl
@@ -23,6 +23,16 @@
 
 use strict;
 
+use File::Basename;
+my $tool = basename($0);
+
+# Test programs that need more than 5 minutes to run should have the
+# EPICS_UNITTEST_TIMEOUT environment variable set in their Makefile:
+#   longRunningTest.t: EPICS_UNITTEST_TIMEOUT=3600
+# The above embeds it into the .t file. It can also be set at runtime,
+# which will then override that compiled-in setting (so not recommended).
+my $timeout = $ENV{EPICS_UNITTEST_TIMEOUT} // 5*60;
+
 my ($TA, $HA, $target, $exe) = @ARGV;
 my $exec;
 
@@ -43,21 +53,45 @@ if( $TA =~ /^win32-x86/ && $HA !~ /^win/ ) {
 
 # Explicitly fail for other RTEMS targets
 } elsif( $TA =~ /^RTEMS-/ ) {
-  die "$0: I don't know how to create scripts for testing $TA on $HA\n";
+  die "$tool: I don't know how to create scripts for testing $TA on $HA\n";
 
 } else {
   $exec = "./$exe";
 }
 
-# Ensure that Windows interactive error handling is disabled.
-# This setting is inherited by the test process.
-# Set SEM_FAILCRITICALERRORS (1) Disable critical-error-handler dialog
-# Clear SEM_NOGPFAULTERRORBOX (2) Enabled WER to allow automatic post mortem debugging (AeDebug)
-# Clear SEM_NOALIGNMENTFAULTEXCEPT (4) Allow alignment fixups
-# Set SEM_NOOPENFILEERRORBOX (0x8000) Prevent dialog on some I/O errors
-# https://docs.microsoft.com/en-us/windows/win32/api/errhandlingapi/nf-errhandlingapi-seterrormode?redirectedfrom=MSDN
-my $sem = $^O ne 'MSWin32' ? '' : <<ENDBEGIN;
+# Create the $target.t file
+open(my $OUT, '>', $target)
+    or die "$tool: Can't create $target: $!\n";
+
+print $OUT <<__EOT__;
+#!/usr/bin/env perl
+# This file was generated by $tool
+
+use strict;
+use Cwd 'abs_path';
+use File::Basename;
+my \$tool = basename(\$0);
+
+\$ENV{HARNESS_ACTIVE} = 1 if scalar \@ARGV && shift eq '-tap';
+\$ENV{TOP} = abs_path(\$ENV{TOP}) if exists \$ENV{TOP};
+
+my \$timeout = \$ENV{EPICS_UNITTEST_TIMEOUT} // $timeout;
+__EOT__
+
+if ($^O eq 'MSWin32') {
+    ######################################## Code for Windows run-hosts
+    print $OUT <<__WIN32__;
+
+use Win32::Job;
+
 BEGIN {
+  # Ensure that Windows interactive error handling is disabled.
+  # This setting is inherited by the test process.
+  # Set SEM_FAILCRITICALERRORS (1) Disable critical-error-handler dialog
+  # Clear SEM_NOGPFAULTERRORBOX (2) Enabled WER to allow automatic post mortem debugging (AeDebug)
+  # Clear SEM_NOALIGNMENTFAULTEXCEPT (4) Allow alignment fixups
+  # Set SEM_NOOPENFILEERRORBOX (0x8000) Prevent dialog on some I/O errors
+  # https://docs.microsoft.com/en-us/windows/win32/api/errhandlingapi/nf-errhandlingapi-seterrormode
   my \$sem = 'SetErrorMode';
   eval {
     require Win32::ErrorMode;
@@ -69,30 +103,52 @@ BEGIN {
   } if \$@;
   SetErrorMode(0x8001) unless \$@;
 }
-ENDBEGIN
 
-open(my $OUT, '>', $target) or die "Can't create $target: $!\n";
+my \$job = Win32::Job->new;
+die "\$tool: Can't create Win32::Job: \$^E\\n"
+    unless \$job;
+my \$pid = \$job->spawn(undef, '$exec');
+die "\$tool: Can't spawn Process '$exec': \$^E\\n"
+    unless defined(\$pid);
 
-print $OUT <<EOF;
-#!/usr/bin/env perl
+if (! \$job->run(\$timeout)) {
+    print "\\n#### Test stopped by \$tool after \$timeout seconds\\n";
+    die "\$tool: Timed out '$exec' after \$timeout seconds\\n";
+}
+my \$status = \$job->status();
+exit \$status->{\$pid}->{exitcode};
 
-use strict;
-use Cwd 'abs_path';
-$sem
-
-\$ENV{HARNESS_ACTIVE} = 1 if scalar \@ARGV && shift eq '-tap';
-\$ENV{TOP} = abs_path(\$ENV{TOP}) if exists \$ENV{TOP};
-
-if (\$^O eq 'MSWin32') {
-    # Use system on Windows, exec doesn't work the same there and
-    # GNUmake thinks the test has finished too soon.
-    my \$status = system('$exec');
-    die "Can't run $exec: \$!\\n" if \$status == -1;
-    exit \$status >> 8;
+__WIN32__
 }
 else {
-    exec '$exec' or die "Can't run $exec: \$!\\n";
-}
-EOF
+    ######################################## Code for Unix run-hosts
+    print $OUT <<__UNIX__;
 
-close $OUT or die "Can't close $target: $!\n";
+my \$pid = fork();
+die "\$tool: Can't fork for '$exec': \$!\\n"
+    unless defined \$pid;
+
+if (\$pid) {
+    # Parent process
+    \$SIG{ALRM} = sub {
+        # Time's up, kill the child
+        kill 9, \$pid;
+        print "\\n#### Test stopped by \$tool after \$timeout seconds\\n";
+        die "\$tool: Timed out '$exec' after \$timeout seconds\\n";
+    };
+
+    alarm \$timeout;
+    waitpid \$pid, 0;
+    alarm 0;
+    exit \$? >> 8;
+}
+else {
+    # Child process
+    exec '$exec'
+        or die "\$tool: Can't run '$exec': \$!\\n";
+}
+__UNIX__
+}
+
+close $OUT
+    or die "$tool: Can't close '$target': $!\n";