Skip to content
Snippets Groups Projects
Commit f383a242 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Modularity: pass TempDir instead of DynFlags (#17957)

parent e99cf237
No related branches found
No related tags found
No related merge requests found
......@@ -10,14 +10,14 @@ module GHC.SysTools.Process where
import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Utils.Exception
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Utils.CliOption
import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan )
import GHC.Data.FastString
......@@ -32,7 +32,6 @@ import System.IO
import System.IO.Error as IO
import System.Process
import GHC.Utils.TmpFs
-- | Enable process jobs support on Windows if it can be expected to work (e.g.
-- @process >= 1.6.9.0@).
......@@ -153,14 +152,14 @@ runSomething logger phase_name pgm args =
runSomethingResponseFile
:: Logger
-> TmpFs
-> DynFlags
-> TempDir
-> (String->String)
-> String
-> String
-> [Option]
-> Maybe [(String,String)]
-> IO ()
runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_env =
runSomethingResponseFile logger tmpfs tmp_dir filter_fn phase_name pgm args mb_env =
runSomethingWith logger phase_name pgm args $ \real_args -> do
fp <- getResponseFile real_args
let args = ['@':fp]
......@@ -168,7 +167,7 @@ runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_en
return (r,())
where
getResponseFile args = do
fp <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rsp"
fp <- newTempName logger tmpfs tmp_dir TFL_CurrentModule "rsp"
withFile fp WriteMode $ \h -> do
hSetEncoding h utf8
hPutStr h $ unlines $ map escape args
......
......@@ -117,7 +117,7 @@ runCpp logger tmpfs dflags args = traceSystoolCommand logger "cpp" $ do
userOpts_c = map Option $ getOpts dflags opt_c
args2 = args0 ++ args ++ userOpts_c
mb_env <- getGccEnv args2
runSomethingResponseFile logger tmpfs dflags cc_filter "C pre-processor" p
runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter "C pre-processor" p
args2 mb_env
-- | Run the Haskell C preprocessor.
......@@ -148,7 +148,7 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
-- We take care to pass -optc flags in args1 last to ensure that the
-- user can override flags passed by GHC. See #14452.
mb_env <- getGccEnv args2
runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2
runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter dbgstring prog args2
mb_env
where
-- force the C compiler to interpret this file as C when
......@@ -275,7 +275,7 @@ runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do
optl_args = map Option (getOpts dflags opt_l)
args2 = args0 ++ args ++ optl_args
mb_env <- getGccEnv args2
runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env
runSomethingResponseFile logger tmpfs (tmpDir dflags) ld_filter "Linker" p args2 mb_env
where
ld_filter = case (platformOS (targetPlatform dflags)) of
OSSolaris2 -> sunos_ld_filter
......@@ -339,7 +339,7 @@ runMergeObjects logger tmpfs dflags args =
if toolSettings_mergeObjsSupportsResponseFiles (toolSettings dflags)
then do
mb_env <- getGccEnv args2
runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env
runSomethingResponseFile logger tmpfs (tmpDir dflags) id "Merge objects" p args2 mb_env
else do
runSomething logger "Merge objects" p args2
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment