[commit: ghc] wip/nfs-locking: Make fixFile more robust. (27317cf)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:19:11 UTC 2017


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

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/27317cf1ebcc6e89bd0e42b449cc2059f74673e6/ghc

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

commit 27317cf1ebcc6e89bd0e42b449cc2059f74673e6
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Feb 10 22:51:09 2016 +0000

    Make fixFile more robust.
    
    See #206.


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

27317cf1ebcc6e89bd0e42b449cc2059f74673e6
 src/Rules/Actions.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index f8f4925..e815bcf 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -5,7 +5,9 @@ module Rules.Actions (
     runMakeVerbose, renderLibrary, renderProgram, runBuilder, makeExecutable
     ) where
 
-import qualified System.Directory as IO
+import qualified System.Directory       as IO
+import qualified System.IO              as IO
+import qualified Control.Exception.Base as IO
 
 import Base
 import CmdLineFlag
@@ -96,9 +98,12 @@ moveDirectory source target = do
 fixFile :: FilePath -> (String -> String) -> Action ()
 fixFile file f = do
     putBuild $ "| Fix " ++ file
-    old <- liftIO $ readFile file
-    let new = f old
-    length new `seq` liftIO $ writeFile file new
+    contents <- liftIO $ IO.withFile file IO.ReadMode $ \h -> do
+        old <- IO.hGetContents h
+        let new = f old
+        IO.evaluate $ rnf new
+        return new
+    liftIO $ writeFile file contents
 
 runConfigure :: FilePath -> [CmdOption] -> [String] -> Action ()
 runConfigure dir opts args = do



More information about the ghc-commits mailing list