{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Misc process handling code for SysTools -- -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- module GHC.SysTools.Process where #include "HsVersions.h" import GHC.Utils.Exception import GHC.Utils.Error import GHC.Driver.Session import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Prelude import GHC.Utils.Misc import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan ) import Control.Concurrent import Data.Char import System.Exit import System.Environment import System.FilePath import System.IO import System.IO.Error as IO import System.Process import GHC.SysTools.FileCleanup -- | Enable process jobs support on Windows if it can be expected to work (e.g. -- @process >= 1.6.9.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) #if MIN_VERSION_process(1,6,9) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif #else enableProcessJobs opts = opts #endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. readCreateProcessWithExitCode' :: CreateProcess -> IO (ExitCode, String) -- ^ stdout readCreateProcessWithExitCode' proc = do (_, Just outh, _, pid) <- createProcess $ enableProcessJobs $ proc{ std_out = CreatePipe } -- fork off a thread to start consuming the output output <- hGetContents outh outMVar <- newEmptyMVar _ <- forkIO $ evaluate (length output) >> putMVar outMVar () -- wait on the output takeMVar outMVar hClose outh -- wait on the process ex <- waitForProcess pid return (ex, output) replaceVar :: (String, String) -> [(String, String)] -> [(String, String)] replaceVar (var, value) env = (var, value) : filter (\(var',_) -> var /= var') env -- | Version of @System.Process.readProcessWithExitCode@ that takes a -- key-value tuple to insert into the environment. readProcessEnvWithExitCode :: String -- ^ program path -> [String] -- ^ program args -> (String, String) -- ^ addition to the environment -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr) readProcessEnvWithExitCode prog args env_update = do current_env <- getEnvironment readCreateProcessWithExitCode (proc prog args) { env = Just (replaceVar env_update current_env) } "" -- Don't let gcc localize version info string, #8825 c_locale_env :: (String, String) c_locale_env = ("LANGUAGE", "C") -- If the -B