summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-04-10 14:48:16 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-13 18:43:53 -0400
commit8d87975ebe943a0461039a0cf2d4b8a2f32f436b (patch)
tree63bf1417a1e63881513f571ff5ea0806e50cf311
parentef0135934fe32da5b5bb730dbce74262e23e72e8 (diff)
downloadhaskell-8d87975ebe943a0461039a0cf2d4b8a2f32f436b.tar.gz
Produce constant file atomically (#19684)
-rw-r--r--utils/deriveConstants/Main.hs21
-rw-r--r--utils/deriveConstants/deriveConstants.cabal3
2 files changed, 18 insertions, 6 deletions
diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs
index 8bf8ae7b44..9db673a985 100644
--- a/utils/deriveConstants/Main.hs
+++ b/utils/deriveConstants/Main.hs
@@ -34,9 +34,10 @@ import Data.Maybe (catMaybes, mapMaybe, fromMaybe)
import Numeric (readHex)
import System.Environment (getArgs)
import System.Exit (ExitCode(ExitSuccess), exitFailure)
-import System.FilePath ((</>))
+import System.FilePath ((</>),(<.>))
import System.IO (stderr, hPutStrLn)
import System.Process (showCommandForUser, readProcess, rawSystem)
+import System.Directory (renameFile)
main :: IO ()
main = do opts <- parseArgs
@@ -79,6 +80,16 @@ data Options = Options {
o_targetOS :: Maybe String
}
+-- | Write a file atomically
+--
+-- This avoids other processes seeing the file while it is being written into.
+atomicWriteFile :: FilePath -> String -> IO ()
+atomicWriteFile fn s = do
+ let tmp = fn <.> "tmp"
+ writeFile tmp s
+ renameFile tmp fn
+
+
parseArgs :: IO Options
parseArgs = do args <- getArgs
opts <- f emptyOptions args
@@ -670,7 +681,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
= do let cStuff = unlines (headers ++ concatMap (doWanted . snd) (wanteds os))
cFile = tmpdir </> "tmp.c"
oFile = tmpdir </> "tmp.o"
- writeFile cFile cStuff
+ atomicWriteFile cFile cStuff
execute verbose gccProgram (gccFlags ++ ["-c", cFile, "-o", oFile])
xs <- case os of
"openbsd" -> readProcess objdumpProgam ["--syms", oFile] ""
@@ -855,7 +866,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
= return (w, FieldTypeGcptrMacro name)
writeHaskellType :: FilePath -> [What Fst] -> IO ()
-writeHaskellType fn ws = writeFile fn xs
+writeHaskellType fn ws = atomicWriteFile fn xs
where xs = unlines [header, body, footer, parser]
header = "module GHC.Platform.Constants where\n\n\
\import Prelude\n\
@@ -920,7 +931,7 @@ writeHaskellType fn ws = writeFile fn xs
writeHaskellValue :: FilePath -> [What Snd] -> IO ()
-writeHaskellValue fn rs = writeFile fn xs
+writeHaskellValue fn rs = atomicWriteFile fn xs
where xs = unlines [header, body, footer]
header = "PlatformConstants {"
footer = " }"
@@ -937,7 +948,7 @@ writeHaskellValue fn rs = writeFile fn xs
doWhat (FieldTypeGcptrMacro {}) = []
writeHeader :: FilePath -> [(Where, What Snd)] -> IO ()
-writeHeader fn rs = writeFile fn xs
+writeHeader fn rs = atomicWriteFile fn xs
where xs = headers ++ hs ++ unlines body
headers = "/* This file is created automatically. Do not edit by hand.*/\n\n"
haskellRs = fmap snd $ filter (\r -> fst r `elem` [Haskell,Both]) rs
diff --git a/utils/deriveConstants/deriveConstants.cabal b/utils/deriveConstants/deriveConstants.cabal
index 50b5b695c3..36ba7ebe1f 100644
--- a/utils/deriveConstants/deriveConstants.cabal
+++ b/utils/deriveConstants/deriveConstants.cabal
@@ -20,4 +20,5 @@ Executable deriveConstants
Build-Depends: base >= 4 && < 5,
containers,
process,
- filepath
+ filepath,
+ directory