From f383a242c76f90bcca8a4d7ee001dcb49c172a9a Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Wed, 11 Oct 2023 10:26:18 +0200
Subject: [PATCH] Modularity: pass TempDir instead of DynFlags (#17957)
---
compiler/GHC/SysTools/Process.hs | 11 +++++------
compiler/GHC/SysTools/Tasks.hs | 8 ++++----
2 files changed, 9 insertions(+), 10 deletions(-)
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 080c2656b6d7..0bf5f8764e7d 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -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
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index d69a52875bfb..a64a2a6a2e43 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -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
--
GitLab