|
|
a15483d |
From 9aace0eaf6279f17368a1753b65afbdc466e8291 Mon Sep 17 00:00:00 2001
|
|
|
a15483d |
From: Sylvain Henry <sylvain@haskus.fr>
|
|
|
a15483d |
Date: Sat, 10 Apr 2021 14:48:16 +0200
|
|
|
a15483d |
Subject: [PATCH] Produce constant file atomically (#19684)
|
|
|
a15483d |
|
|
|
a15483d |
---
|
|
|
a15483d |
utils/deriveConstants/Main.hs | 21 ++++++++++++++++-----
|
|
|
a15483d |
utils/deriveConstants/deriveConstants.cabal | 3 ++-
|
|
|
a15483d |
2 files changed, 18 insertions(+), 6 deletions(-)
|
|
|
a15483d |
|
|
|
a15483d |
diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs
|
|
|
a15483d |
index 8bf8ae7b44d..9db673a9852 100644
|
|
|
a15483d |
--- a/utils/deriveConstants/Main.hs
|
|
|
a15483d |
+++ b/utils/deriveConstants/Main.hs
|
|
|
a15483d |
@@ -34,9 +34,10 @@ import Data.Maybe (catMaybes, mapMaybe, fromMaybe)
|
|
|
a15483d |
import Numeric (readHex)
|
|
|
a15483d |
import System.Environment (getArgs)
|
|
|
a15483d |
import System.Exit (ExitCode(ExitSuccess), exitFailure)
|
|
|
a15483d |
-import System.FilePath (())
|
|
|
a15483d |
+import System.FilePath ((),(<.>))
|
|
|
a15483d |
import System.IO (stderr, hPutStrLn)
|
|
|
a15483d |
import System.Process (showCommandForUser, readProcess, rawSystem)
|
|
|
a15483d |
+import System.Directory (renameFile)
|
|
|
a15483d |
|
|
|
a15483d |
main :: IO ()
|
|
|
a15483d |
main = do opts <- parseArgs
|
|
|
a15483d |
@@ -79,6 +80,16 @@ data Options = Options {
|
|
|
a15483d |
o_targetOS :: Maybe String
|
|
|
a15483d |
}
|
|
|
a15483d |
|
|
|
a15483d |
+-- | Write a file atomically
|
|
|
a15483d |
+--
|
|
|
a15483d |
+-- This avoids other processes seeing the file while it is being written into.
|
|
|
a15483d |
+atomicWriteFile :: FilePath -> String -> IO ()
|
|
|
a15483d |
+atomicWriteFile fn s = do
|
|
|
a15483d |
+ let tmp = fn <.> "tmp"
|
|
|
a15483d |
+ writeFile tmp s
|
|
|
a15483d |
+ renameFile tmp fn
|
|
|
a15483d |
+
|
|
|
a15483d |
+
|
|
|
a15483d |
parseArgs :: IO Options
|
|
|
a15483d |
parseArgs = do args <- getArgs
|
|
|
a15483d |
opts <- f emptyOptions args
|
|
|
a15483d |
@@ -670,7 +681,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
|
|
|
a15483d |
= do let cStuff = unlines (headers ++ concatMap (doWanted . snd) (wanteds os))
|
|
|
a15483d |
cFile = tmpdir "tmp.c"
|
|
|
a15483d |
oFile = tmpdir "tmp.o"
|
|
|
a15483d |
- writeFile cFile cStuff
|
|
|
a15483d |
+ atomicWriteFile cFile cStuff
|
|
|
a15483d |
execute verbose gccProgram (gccFlags ++ ["-c", cFile, "-o", oFile])
|
|
|
a15483d |
xs <- case os of
|
|
|
a15483d |
"openbsd" -> readProcess objdumpProgam ["--syms", oFile] ""
|
|
|
a15483d |
@@ -855,7 +866,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
|
|
|
a15483d |
= return (w, FieldTypeGcptrMacro name)
|
|
|
a15483d |
|
|
|
a15483d |
writeHaskellType :: FilePath -> [What Fst] -> IO ()
|
|
|
a15483d |
-writeHaskellType fn ws = writeFile fn xs
|
|
|
a15483d |
+writeHaskellType fn ws = atomicWriteFile fn xs
|
|
|
a15483d |
where xs = unlines [header, body, footer, parser]
|
|
|
a15483d |
header = "module GHC.Platform.Constants where\n\n\
|
|
|
a15483d |
\import Prelude\n\
|
|
|
a15483d |
@@ -920,7 +931,7 @@ writeHaskellType fn ws = writeFile fn xs
|
|
|
a15483d |
|
|
|
a15483d |
|
|
|
a15483d |
writeHaskellValue :: FilePath -> [What Snd] -> IO ()
|
|
|
a15483d |
-writeHaskellValue fn rs = writeFile fn xs
|
|
|
a15483d |
+writeHaskellValue fn rs = atomicWriteFile fn xs
|
|
|
a15483d |
where xs = unlines [header, body, footer]
|
|
|
a15483d |
header = "PlatformConstants {"
|
|
|
a15483d |
footer = " }"
|
|
|
a15483d |
@@ -937,7 +948,7 @@ writeHaskellValue fn rs = writeFile fn xs
|
|
|
a15483d |
doWhat (FieldTypeGcptrMacro {}) = []
|
|
|
a15483d |
|
|
|
a15483d |
writeHeader :: FilePath -> [(Where, What Snd)] -> IO ()
|
|
|
a15483d |
-writeHeader fn rs = writeFile fn xs
|
|
|
a15483d |
+writeHeader fn rs = atomicWriteFile fn xs
|
|
|
a15483d |
where xs = headers ++ hs ++ unlines body
|
|
|
a15483d |
headers = "/* This file is created automatically. Do not edit by hand.*/\n\n"
|
|
|
a15483d |
haskellRs = fmap snd $ filter (\r -> fst r `elem` [Haskell,Both]) rs
|
|
|
a15483d |
diff --git a/utils/deriveConstants/deriveConstants.cabal b/utils/deriveConstants/deriveConstants.cabal
|
|
|
a15483d |
index 50b5b695c30..36ba7ebe1f7 100644
|
|
|
a15483d |
--- a/utils/deriveConstants/deriveConstants.cabal
|
|
|
a15483d |
+++ b/utils/deriveConstants/deriveConstants.cabal
|
|
|
a15483d |
@@ -20,4 +20,5 @@ Executable deriveConstants
|
|
|
a15483d |
Build-Depends: base >= 4 && < 5,
|
|
|
a15483d |
containers,
|
|
|
a15483d |
process,
|
|
|
a15483d |
- filepath
|
|
|
a15483d |
+ filepath,
|
|
|
a15483d |
+ directory
|
|
|
a15483d |
--
|
|
|
a15483d |
GitLab
|
|
|
a15483d |
|