cabal-testsuite/PackageTests/NewBuild/CmdRun/Terminate/cabal.test.hs

   1 import Test.Cabal.Prelude
   2 import qualified System.Process as Process
   3 import Control.Concurrent (threadDelay)
   4 import System.Directory (removeFile)
   5 import Control.Exception (catch, throwIO)
   6 import System.IO.Error (isDoesNotExistError)
   7
   8 {-
   9 This test verifies that 'cabal run' terminates its
  10 child when it is killed. More generally, while we
  11 use the same code path for all child processes, this
  12 ensure that cabal-install cleans up after all children.
  13 (That might change if 'cabal run' is changed to exec(3)
  14 without forking in the future.)
  15 -}
  16
  17 main :: IO ()
  18 main = cabalTest $ do
  19   skipIfWindows -- test project relies on Posix
  20
  21   dir <- fmap testCurrentDir getTestEnv
  22   let runFile = dir </> "exe.run"
  23   liftIO $ removeFile runFile `catchNoExist` return ()
  24
  25   cabal_raw_action ["v2-build", "exe"] (\_ -> return ())
  26   r <- fails $ cabal_raw_action ["v2-run", "exe"] $ \cabalHandle -> do
  27     -- wait for "cabal run" to have started "exe"
  28     waitFile total runFile
  29     -- then kill "cabal run"
  30     Process.terminateProcess cabalHandle
  31
  32   -- "exe" should exit, and should have been interrupted before
  33   -- finishing its sleep
  34   assertOutputContains "exiting" r
  35   assertOutputDoesNotContain "done sleeping" r
  36
  37   where
  38     catchNoExist action handle =
  39       action `catch`
  40         (\e -> if isDoesNotExistError e then handle else throwIO e)
  41     waitFile totalWait f
  42       | totalWait <= 0 = error "waitFile timed out"
  43       | otherwise      = readFile f `catchNoExist` do
  44                            threadDelay delta
  45                            waitFile (totalWait - delta) f
  46     delta = 50000 -- 0.05s
  47     total = 10000000 -- 10s
  48
  49 cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result
  50 cabal_raw_action args action = do
  51     configured_prog <- requireProgramM cabalProgram
  52     env <- getTestEnv
  53     r <- liftIO $ runAction (testVerbosity env)
  54                  (Just (testCurrentDir env))
  55                  (testEnvironment env)
  56                  (programPath configured_prog)
  57                  args
  58                  Nothing
  59                  action
  60     recordLog r
  61     requireSuccess r