[commit: ghc] master: Revert "compiler: Refactor: extract `withAtomicRename`" (e7080be)

git at git.haskell.org git at git.haskell.org
Mon Mar 4 21:04:59 UTC 2019


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e7080bef906b66d0e7053db99c9733aa95059d42/ghc

>---------------------------------------------------------------

commit e7080bef906b66d0e7053db99c9733aa95059d42
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Mar 3 00:16:00 2019 -0500

    Revert "compiler: Refactor: extract `withAtomicRename`"
    
    This reverts commit e8a08f400744a860d1366c6680c8419d30f7cc2a.


>---------------------------------------------------------------

e7080bef906b66d0e7053db99c9733aa95059d42
 compiler/main/DriverPipeline.hs | 13 +++++++------
 compiler/utils/Util.hs          | 24 +-----------------------
 2 files changed, 8 insertions(+), 29 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index f1ef637..3f59ed3 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1341,10 +1341,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
         let local_includes = [ SysTools.Option ("-iquote" ++ p)
                              | p <- includePathsQuote cmdline_include_paths ]
         let runAssembler inputFilename outputFilename
-              = liftIO $ do
-                  withAtomicRename outputFilename $ \temp_outputFilename -> do
-                    as_prog
-                       dflags
+                = liftIO $ as_prog dflags
                        (local_includes ++ global_includes
                        -- See Note [-fPIC for assembler]
                        ++ map SysTools.Option pic_c_flags
@@ -1374,11 +1371,15 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
                           , SysTools.Option "-c"
                           , SysTools.FileOption "" inputFilename
                           , SysTools.Option "-o"
-                          , SysTools.FileOption "" temp_outputFilename
+                          , SysTools.FileOption "" outputFilename
                           ])
 
         liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
-        runAssembler input_fn output_fn
+
+        -- Atomic write by writing to temp file and then renaming
+        let temp_output_fn = output_fn <.> "tmp"
+        runAssembler input_fn temp_output_fn
+        liftIO $ renameFile temp_output_fn output_fn
 
         return (RealPhase next_phase, output_fn)
 
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 41f63f2..16864fe 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -99,7 +99,6 @@ module Util (
         doesDirNameExist,
         getModificationUTCTime,
         modificationTimeIfExists,
-        withAtomicRename,
 
         global, consIORef, globalM,
         sharedGlobal, sharedGlobalM,
@@ -146,10 +145,9 @@ import GHC.Stack (HasCallStack)
 
 import Control.Applicative ( liftA2 )
 import Control.Monad    ( liftM, guard )
-import Control.Monad.IO.Class ( MonadIO, liftIO )
 import GHC.Conc.Sync ( sharedCAF )
 import System.IO.Error as IO ( isDoesNotExistError )
-import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
+import System.Directory ( doesDirectoryExist, getModificationTime )
 import System.FilePath
 
 import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper
@@ -1306,26 +1304,6 @@ modificationTimeIfExists f = do
                         else ioError e
 
 -- --------------------------------------------------------------
--- atomic file writing by writing to a temporary file first (see #14533)
---
--- This should be used in all cases where GHC writes files to disk
--- and uses their modification time to skip work later,
--- as otherwise a partially written file (e.g. due to crash or Ctrl+C)
--- also results in a skip.
-
-withAtomicRename :: (MonadIO m) => FilePath -> (FilePath -> m a) -> m a
-withAtomicRename targetFile f = do
-  -- The temp file must be on the same file system (mount) as the target file
-  -- to result in an atomic move on most platforms.
-  -- The standard way to ensure that is to place it into the same directory.
-  -- This can still be fooled when somebody mounts a different file system
-  -- at just the right time, but that is not a case we aim to cover here.
-  let temp = targetFile <.> "tmp"
-  res <- f temp
-  liftIO $ renameFile temp targetFile
-  return res
-
--- --------------------------------------------------------------
 -- split a string at the last character where 'pred' is True,
 -- returning a pair of strings. The first component holds the string
 -- up (but not including) the last character for which 'pred' returned



More information about the ghc-commits mailing list