From 0995df8a9185c0128eb7350dae34e2c06f20aefd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 11 Sep 2021 21:32:33 +0200 Subject: Report when child process terminates --- erebos-tester.cabal | 1 + src/Main.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/erebos-tester.cabal b/erebos-tester.cabal index 3722a6e..9399c6d 100644 --- a/erebos-tester.cabal +++ b/erebos-tester.cabal @@ -47,5 +47,6 @@ executable erebos-tester-core regex-tdfa ^>=1.3.1.0, stm ^>=2.5.0.1, text ^>=1.2.4.0, + unix ^>=2.7.2.2, hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs index d4134bd..baec638 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -19,6 +19,8 @@ import System.Exit import System.FilePath import System.IO import System.IO.Error +import System.Posix.Process +import System.Posix.Signals import System.Process import Parser @@ -177,6 +179,21 @@ runTest :: String -> Test -> IO () runTest tool test = do net <- initNetwork + let sigHandler SignalInfo { siginfoSpecific = chld } = do + nodes <- readMVar (netNodes net) + forM_ nodes $ \node -> do + processes <- readMVar (nodeProcesses node) + forM_ processes $ \p -> do + mbpid <- getPid (procHandle p) + when (mbpid == Just (siginfoPid chld)) $ do + let err detail = putStrLn $ "\ESC[31m" ++ unpackNodeName (nodeName node) ++ "!!> child " ++ detail ++ "\ESC[0m" + case siginfoStatus chld of + Exited ExitSuccess -> putStrLn $ unpackNodeName (nodeName node) ++ ".> child exited successfully" + Exited (ExitFailure code) -> err $ "process exited with status " ++ show code + Terminated sig _ -> err $ "terminated with signal " ++ show sig + Stopped sig -> err $ "stopped with signal " ++ show sig + oldHandler <- installHandler processStatusChanged (CatchInfo sigHandler) Nothing + forM_ (testSteps test) $ \case Spawn pname nname -> do node <- getNode net nname @@ -195,6 +212,7 @@ runTest tool test = do hFlush stdout void $ getLine + _ <- installHandler processStatusChanged oldHandler Nothing exitNetwork net main :: IO () -- cgit v1.2.3