summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Driver/Main.hs3
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs9
-rw-r--r--compiler/GHC/Driver/Session.hs5
-rw-r--r--compiler/GHC/Settings.hs4
-rw-r--r--compiler/GHC/Settings/IO.hs3
-rw-r--r--compiler/GHC/SysTools/Tasks.hs3
-rw-r--r--compiler/GHC/Utils/Touch.hs29
-rw-r--r--compiler/ghc.cabal.in1
8 files changed, 38 insertions, 19 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 5ca7487c27..8fcb687822 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -250,6 +250,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Utils.TmpFs
+import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
@@ -1263,7 +1264,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
-- .hie files.
let hie_file = ml_hie_file mod_location
whenM (doesFileExist hie_file) $
- GHC.SysTools.touch logger dflags "Touching hie file" hie_file
+ GHC.Utils.Touch.touch hie_file
else
-- See Note [Strictness in ModIface]
forceModIface iface
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 2a1e877292..b1a9660647 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -74,6 +74,7 @@ import GHC.Linker.ExtraObj
import GHC.Linker.Dynamic
import Data.Version
import GHC.Utils.Panic
+import GHC.Utils.Touch
import GHC.Unit.Module.Env
import GHC.Driver.Env.KnotVars
import GHC.Driver.Config.Finder
@@ -529,7 +530,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
- HsBootFile -> touchObjectFile logger dflags o_file
+ HsBootFile -> touchObjectFile o_file
HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"
return ([], iface, emptyHomeModInfoLinkable, o_file)
@@ -1148,10 +1149,10 @@ generateMacros prefix name version =
-touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
-touchObjectFile logger dflags path = do
+touchObjectFile :: FilePath -> IO ()
+touchObjectFile path = do
createDirectoryIfMissing True $ takeDirectory path
- GHC.SysTools.touch logger dflags "Touching object file" path
+ GHC.Utils.Touch.touch path
-- Note [-fPIC for assembler]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 3e205402e9..56a90d064d 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -95,7 +95,6 @@ module GHC.Driver.Session (
sPgm_l,
sPgm_lm,
sPgm_dll,
- sPgm_T,
sPgm_windres,
sPgm_ar,
sPgm_ranlib,
@@ -129,7 +128,7 @@ module GHC.Driver.Session (
ghcUsagePath, ghciUsagePath, topDir,
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
- pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T,
+ pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll,
pgm_windres, pgm_ar, pgm_otool, pgm_install_name_tool,
pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i,
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
@@ -824,8 +823,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option])
pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags
pgm_dll :: DynFlags -> (String,[Option])
pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
-pgm_T :: DynFlags -> String
-pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags
pgm_windres :: DynFlags -> String
pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags
pgm_lcc :: DynFlags -> (String,[Option])
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
index 291c77b860..37bbf8bad3 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -32,7 +32,6 @@ module GHC.Settings
, sPgm_l
, sPgm_lm
, sPgm_dll
- , sPgm_T
, sPgm_windres
, sPgm_ar
, sPgm_otool
@@ -105,7 +104,6 @@ data ToolSettings = ToolSettings
-- merging, hence the 'Maybe'. See Note [Object merging] in
-- "GHC.Driver.Pipeline.Execute" for details.
, toolSettings_pgm_dll :: (String, [Option])
- , toolSettings_pgm_T :: String
, toolSettings_pgm_windres :: String
, toolSettings_pgm_ar :: String
, toolSettings_pgm_otool :: String
@@ -216,8 +214,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option])
sPgm_lm = toolSettings_pgm_lm . sToolSettings
sPgm_dll :: Settings -> (String, [Option])
sPgm_dll = toolSettings_pgm_dll . sToolSettings
-sPgm_T :: Settings -> String
-sPgm_T = toolSettings_pgm_T . sToolSettings
sPgm_windres :: Settings -> String
sPgm_windres = toolSettings_pgm_windres . sToolSettings
sPgm_ar :: Settings -> String
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index 074b9a791c..4889bbcd31 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -112,8 +112,6 @@ initSettings top_dir = do
install_name_tool_path <- getToolSetting "install_name_tool command"
ranlib_path <- getToolSetting "ranlib command"
- touch_path <- getToolSetting "touch command"
-
mkdll_prog <- getToolSetting "dllwrap command"
let mkdll_args = []
@@ -177,7 +175,6 @@ initSettings top_dir = do
, toolSettings_pgm_l = (ld_prog, ld_args)
, toolSettings_pgm_lm = ld_r
, toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
- , toolSettings_pgm_T = touch_path
, toolSettings_pgm_windres = windres_path
, toolSettings_pgm_ar = ar_path
, toolSettings_pgm_otool = otool_path
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index a1846980a1..1fc82cad45 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -376,6 +376,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do
mb_env <- getGccEnv cc_args
runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env
-touch :: Logger -> DynFlags -> String -> String -> IO ()
-touch logger dflags purpose arg = traceSystoolCommand logger "touch" $
- runSomething logger purpose (pgm_T dflags) [FileOption "" arg]
diff --git a/compiler/GHC/Utils/Touch.hs b/compiler/GHC/Utils/Touch.hs
new file mode 100644
index 0000000000..b6181584f0
--- /dev/null
+++ b/compiler/GHC/Utils/Touch.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE CPP #-}
+
+module GHC.Utils.Touch (touch) where
+
+import GHC.Prelude
+
+#if defined(mingw32_HOST_OS)
+import System.Win32.File
+import System.Win32.Time
+#else
+import System.Posix.Files
+import System.Posix.IO
+#endif
+
+-- | Set the mtime of the given file to the current time.
+touch :: FilePath -> IO ()
+touch file = do
+#if defined(mingw32_HOST_OS)
+ hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing
+ t <- getSystemTimeAsFileTime
+ setFileTime hdl Nothing Nothing (Just t)
+ closeHandle hdl
+#else
+ let oflags = defaultFileFlags { noctty = True }
+ fd <- openFd file WriteOnly (Just 0o666) oflags
+ touchFd fd
+ closeFd fd
+#endif
+
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a867801951..2825bda8d6 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -814,6 +814,7 @@ Library
GHC.Utils.Ppr
GHC.Utils.Ppr.Colour
GHC.Utils.TmpFs
+ GHC.Utils.Touch
GHC.Utils.Trace
GHC.Wasm.ControlFlow
GHC.Wasm.ControlFlow.FromCmm
View Lorry Controller Status