summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-03-03 00:16:00 -0500
committerBen Gamari <ben@well-typed.com>2019-03-04 10:18:41 -0500
commite7080bef906b66d0e7053db99c9733aa95059d42 (patch)
treeecd7137e99df8117bc6318a89cd46f63570524e6
parent22c2713bcc30cea9da7d8b95f3ea99357d1551f7 (diff)
downloadhaskell-e7080bef906b66d0e7053db99c9733aa95059d42.tar.gz
Revert "compiler: Refactor: extract `withAtomicRename`"
This reverts commit e8a08f400744a860d1366c6680c8419d30f7cc2a.
-rw-r--r--compiler/main/DriverPipeline.hs13
-rw-r--r--compiler/utils/Util.hs24
2 files changed, 8 insertions, 29 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index f1ef637037..3f59ed3bbf 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 41f63f2246..16864fe017 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