Bound uplc-evaluator integration test teardown and run it nightly

.github/workflows/nightly-testsuite.yml

@@ -1,4 +1,7 @@
-# This workflow runs the plutus-core-test and plutus-ir-test test suite.
+# This workflow runs the plutus-core-test and plutus-ir-test test suites with a
+# large number of hedgehog tests, plus the uplc-evaluator integration tests
+# (a non-critical on-demand tool whose tests run nightly rather than gating
+# every PR).
 #
 # This workflow runs daily at midnight, and it can also be triggered manually.
 
@@ -40,3 +43,7 @@ jobs:
           pushd plutus-core
           nix run --no-warn-dirty --accept-flake-config .#plutus-ir-test -- --hedgehog-tests $HEDGEHOG_TESTS --no-create
           popd
+
+      - name: Run UPLC Evaluator Integration Tests
+        run: |
+          nix shell --no-warn-dirty --accept-flake-config .#uplc-evaluator .#uplc-evaluator-integration-tests --command uplc-evaluator-integration-tests

nix/outputs.nix

@@ -48,6 +48,7 @@ let
     pir = project.flake'.packages."plutus-executables:exe:pir";
     plutus = project.flake'.packages."plutus-executables:exe:plutus";
     uplc-evaluator = project.flake'.packages."plutus-benchmark:exe:uplc-evaluator";
+    uplc-evaluator-integration-tests = project.flake'.packages."plutus-benchmark:test:uplc-evaluator-integration-tests"; # editorconfig-checker-disable-line
   };
 
   static-haskell-packages = {

nix/project.nix

@@ -130,6 +130,12 @@ let
             plutus-tx.components.tests.plutus-tx-test.testFlags = [ "--no-create" ];
           };
         }
+        {
+          # The uplc-evaluator is a non-critical, on-demand tool. Its executable
+          # is still built on every PR, but the integration tests run only in
+          # the nightly testsuite rather than gating every PR.
+          packages.plutus-benchmark.components.tests.uplc-evaluator-integration-tests.doCheck = false;
+        }
         ({ lib, pkgs, ... }: lib.mkIf (pkgs.stdenv.hostPlatform.isWindows) {
           # This fixed basement compilation error on Windows (ref: https://ci.iog.io/build/8529222/nixlog/1)
           # ```

plutus-benchmark/plutus-benchmark.cabal

@@ -964,6 +964,7 @@ test-suite uplc-evaluator-integration-tests
     , tasty-hunit
     , temporary
     , text
+    , unix
     , uuid
     , with-utf8
 

plutus-benchmark/uplc-evaluator/test/Harness.hs

@@ -4,15 +4,18 @@ module Harness
   ( ServiceHandle (..)
   , withEvaluatorService
   , findEvaluatorExecutable
+  , stopProcessBounded
   ) where
 
 import Control.Concurrent (threadDelay)
 import Control.Exception (bracket)
-import System.Directory (findExecutable, removeDirectoryRecursive)
+import System.Directory (findExecutable, removePathForcibly)
 import System.Exit (ExitCode (..))
 import System.IO (hPutStrLn, stderr)
 import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory)
+import System.Posix.Signals (sigKILL, signalProcess)
 import System.Process
+import System.Timeout (timeout)
 
 -- | Handle to a running evaluator service instance
 data ServiceHandle = ServiceHandle
@@ -74,20 +77,49 @@ withEvaluatorService executablePath action =
     stopService :: ServiceHandle -> IO ()
     stopService ServiceHandle {..} = do
       hPutStrLn stderr "Stopping uplc-evaluator service"
+      stopProcessBounded gracefulShutdownMicros shProcessHandle
 
-      -- Send SIGTERM for graceful shutdown
-      terminateProcess shProcessHandle
-
-      -- Wait for process to exit
-      exitCode <- waitForProcess shProcessHandle
-      case exitCode of
-        ExitSuccess -> hPutStrLn stderr "Service stopped successfully"
-        ExitFailure code -> hPutStrLn stderr $ "Service exited with code: " ++ show code
-
-      -- Clean up temporary directories
       hPutStrLn stderr "Cleaning up temporary directories"
-      removeDirectoryRecursive shInputDir
-      removeDirectoryRecursive shOutputDir
+      removePathForcibly shInputDir
+      removePathForcibly shOutputDir
+
+-- | Grace period (microseconds) between SIGTERM and SIGKILL escalation.
+gracefulShutdownMicros :: Int
+gracefulShutdownMicros = 5000000 -- 5 seconds
+
+{- Note [Bounded service shutdown]
+A plain 'waitForProcess' never returns if the child ignores SIGTERM, hanging
+teardown and the whole test run. Every wait is therefore bounded by a timeout,
+escalating SIGTERM -> SIGKILL and, as a last resort, abandoning the process
+unreaped rather than blocking. 'timeout' can interrupt 'waitForProcess' only
+because the suite is built with -threaded, where that wait is interruptible.
+-}
+
+{-| Terminate a process without ever blocking indefinitely.
+See Note [Bounded service shutdown]. -}
+stopProcessBounded :: Int -> ProcessHandle -> IO ()
+stopProcessBounded graceMicros ph = do
+  terminateProcess ph
+  mExit <- timeout graceMicros (waitForProcess ph)
+  case mExit of
+    Just exitCode -> reportExit exitCode
+    Nothing -> do
+      -- 'timeout' may have fired just as the process exited; re-check first.
+      mExited <- getProcessExitCode ph
+      case mExited of
+        Just exitCode -> reportExit exitCode
+        Nothing -> do
+          hPutStrLn stderr "Service did not exit after SIGTERM; escalating to SIGKILL"
+          mPid <- getPid ph
+          mapM_ (signalProcess sigKILL) mPid
+          mExit' <- timeout graceMicros (waitForProcess ph)
+          case mExit' of
+            Just exitCode -> reportExit exitCode
+            Nothing -> hPutStrLn stderr "Service survived SIGKILL; abandoning it unreaped"
+  where
+    reportExit ExitSuccess = hPutStrLn stderr "Service stopped successfully"
+    reportExit (ExitFailure code) =
+      hPutStrLn stderr $ "Service exited with code: " ++ show code
 
 {-| Find the uplc-evaluator executable
 

plutus-benchmark/uplc-evaluator/test/Spec.hs

@@ -10,12 +10,19 @@ import Data.String.Interpolate (__i)
 import Data.Text qualified as T
 import Data.UUID qualified as UUID
 import Data.UUID.V4 qualified as UUID
-import Harness (ServiceHandle (..), findEvaluatorExecutable, withEvaluatorService)
+import GHC.Clock (getMonotonicTime)
+import Harness
+  ( ServiceHandle (..)
+  , findEvaluatorExecutable
+  , stopProcessBounded
+  , withEvaluatorService
+  )
 import Main.Utf8 (withUtf8)
-import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
+import System.Directory (doesDirectoryExist, doesFileExist, findExecutable, listDirectory)
 import System.FilePath ((</>))
 import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)
-import Test.Tasty (defaultMain, testGroup)
+import System.Process (createProcess, getProcessExitCode, proc)
+import Test.Tasty (Timeout (..), adjustOption, defaultMain, mkTimeout, testGroup)
 import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
 import TestHelpers
   ( EvalError (..)
@@ -40,8 +47,9 @@ main = withUtf8 do
   -- Prevent garbled output from concurrent test execution
   hSetBuffering stdout LineBuffering
   hSetBuffering stderr LineBuffering
-  defaultMain
-    ( testGroup
+  defaultMain $
+    adjustOption defaultTestTimeout $
+      testGroup
         "uplc-evaluator integration tests"
         [ testGroup
             "Infrastructure"
@@ -60,6 +68,24 @@ main = withUtf8 do
                   -- Verify output directory exists
                   outputExists <- doesDirectoryExist (shOutputDir handle)
                   assertBool "Output directory should exist" outputExists
+            , testCase "Bounded teardown kills a SIGTERM-ignoring process" do
+                -- Regression test: teardown used to wait on the service with no
+                -- timeout, so a process ignoring SIGTERM hung it indefinitely.
+                bash <-
+                  maybe (assertFailure "bash not found in PATH") pure
+                    =<< findExecutable "bash"
+                -- Ignore SIGTERM, then exec so 'sleep' inherits the ignore.
+                (_, _, _, ph) <-
+                  createProcess (proc bash ["-c", "trap '' TERM; exec sleep 600"])
+                threadDelay 200000 -- let bash install the trap and exec
+                started <- getMonotonicTime
+                stopProcessBounded 1000000 ph -- 1s grace, then SIGKILL
+                finished <- getMonotonicTime
+                assertBool
+                  ("stopProcessBounded took " ++ show (finished - started) ++ "s")
+                  (finished - started < 5)
+                mExit <- getProcessExitCode ph
+                assertBool "process should be dead and reaped" (mExit /= Nothing)
             ]
         , testGroup
             "Textual UPLC Programs"
@@ -907,4 +933,10 @@ main = withUtf8 do
                     (sampleCount >= 10)
             ]
         ]
-    )
+
+{-| Per-test timeout safety net: a wedged test fails in minutes instead of
+consuming the full CI wall clock. Applied only when no @--timeout@ was given,
+so it stays overridable. -}
+defaultTestTimeout :: Timeout -> Timeout
+defaultTestTimeout NoTimeout = mkTimeout 120000000 -- 120s
+defaultTestTimeout explicit = explicit