content: import Control.Concurrent.MVar  (readMVar)
  import System.Environment       (getArgs)
  import System.Exit              (ExitCode (ExitFailure), exitFailure)
  import System.IO                (hClose, hGetLine, hPutStrLn)
  import System.Posix.Process     (exitImmediately, getProcessID)
  import System.Posix.Signals     (Handler (Catch), installHandler, sigHUP,
                                   signalProcess)
  import System.Process           (StdStream (CreatePipe), createProcess, proc,
                                   std_in, std_out, waitForProcess)
  import System.Process.Internals (ProcessHandle (..),
                                   ProcessHandle__ (OpenHandle))
  import System.Timeout           (timeout)
  
  main :: IO ()
  main = do
      args <- getArgs
      case args of
          ["--runghc", runghc] -> runParent runghc
          ["child"] -> runChild
          _ -> error $ "Unknown args: " ++ show args
  
  runParent :: FilePath -> IO ()
  runParent runghc = do
      (Just inH, Just outH, Nothing, ph@(ProcessHandle mvar _ _)) <-
          createProcess (proc runghc ["T-signals-child.hs", "child"])
              { std_in = CreatePipe
              , std_out = CreatePipe
              }
  
      -- Get the PID of the actual child process. This will initially be
      -- runghc. If executeFile is used by runghc, that same process
      -- will become the ghc process running our code from
      -- runChild. Otherwise, runChild will run in a child of this
      -- process.
      OpenHandle childPid <- readMVar mvar
  
      -- Get the PID of the process actually running the runChild code,
      -- by reading it from its stdout (see runChild below).
      pidS <- hGetLine outH
      let pid = fromIntegral (read pidS :: Int)
  
      -- Send the child process the HUP signal. We know this is after
      -- the signal handler has been installed, since we already got the
      -- PID from the process.
      signalProcess sigHUP childPid
  
      -- Send the child some input so that it will exit if it didn't
      -- have a sigHUP handler installed.
      hPutStrLn inH ""
      hClose inH
  
      -- Read out the rest of stdout from the child, which will be
      -- either "NOSIGNAL\n" or "HUP\n"
      rest <- hGetLine outH
  
      -- Get the exit code of the child
      ec <- waitForProcess ph
  
      -- Check that everything matches
      if childPid /= pid || rest /= hupMessage || ec /= hupExitCode
          then do
              -- Debugging display
              putStrLn $ concat
                  [ "Child process: "
                  , show childPid
                  , ", real process: "
                  , show pid
                  ]
              putStrLn $ concat
                  [ "Expected "
                  , show hupMessage
                  , ", received: "
                  , show rest
                  ]
              putStrLn $ concat
                  [ "Expected "
                  , show hupExitCode
                  , ", received "
                  , show ec
                  ]
              exitFailure
          else return ()
  
  runChild :: IO ()
  runChild = do
      -- Install our sigHUP handler: print the HUP message and exit with
      -- the HUP exit code.
      let handler = Catch $ do
              putStrLn hupMessage
              exitImmediately hupExitCode
      _ <- installHandler sigHUP handler Nothing
  
      -- Get our actual process ID and print it to stdout.
      pid <- getProcessID
      print (fromIntegral pid :: Int)
  
      -- Block until we receive input, giving a chance for the signal
      -- handler to be triggered, and if the signal handler isn't
      -- triggered, gives us an escape route from this function.
      --
      -- Include a reasonable timeout to prevent this from running for
      -- too long
      _ <- timeout 10000000 getLine
  
      -- Reaching this point indicates a failure of the test. Print some
      -- non HUP message and exit with a non HUP exit
      -- code. Interestingly, in a failure, this exit code will _not_
      -- be received by the parent process, since the runghc process
      -- itself will exit with ExitFailure -1, indicating that it was
      -- killed by signal 1 (SIGHUP).
      putStrLn "No signal received"
      exitImmediately $ ExitFailure 41
  
  hupExitCode :: ExitCode
  hupExitCode = ExitFailure 42
  
  hupMessage :: String
  hupMessage = "HUP"
  