[commit: ghc] wip/nfs-locking: Track wrapped binary. (49521c0)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:20:29 UTC 2017


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

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

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

commit 49521c02bdd181b57713c8f3e2bf111416b0df37
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Dec 31 02:28:23 2015 +0000

    Track wrapped binary.


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

49521c02bdd181b57713c8f3e2bf111416b0df37
 src/Rules/Program.hs | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs
index 93c6a97..a1aaa2f 100644
--- a/src/Rules/Program.hs
+++ b/src/Rules/Program.hs
@@ -29,6 +29,11 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
     let match file = case programPath stage pkg of
             Nothing      -> False
             Just program -> program == file
+        matchWrapped file = case programPath stage pkg of
+            Nothing      -> False
+            Just program -> case computeWrappedPath program of
+                Nothing             -> False
+                Just wrappedProgram -> wrappedProgram == file
 
     match ?> \bin -> do
         windows <- windowsHost
@@ -37,15 +42,16 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
         else case find ((== target) . fst) wrappers of
             Nothing -> buildBinary target bin -- No wrapper found
             Just (_, wrapper) -> do
-                wrappedBin <- moveToLib bin
-                buildBinary target wrappedBin
+                let Just wrappedBin = computeWrappedPath bin
+                need [wrappedBin]
                 buildWrapper target wrapper bin wrappedBin
 
+    matchWrapped ?> \bin -> buildBinary target bin
+
 -- Replace programInplacePath with programInplaceLibPath in a given path
-moveToLib :: FilePath -> Action FilePath
-moveToLib path = case stripPrefix programInplacePath path of
-    Just suffix -> return $ programInplaceLibPath ++ suffix
-    Nothing     -> putError $ "moveToLib: cannot move " ++ path
+computeWrappedPath :: FilePath -> Maybe FilePath
+computeWrappedPath =
+    fmap (programInplaceLibPath ++) . stripPrefix programInplacePath
 
 buildWrapper :: PartialTarget -> Wrapper -> FilePath -> FilePath -> Action ()
 buildWrapper target @ (PartialTarget stage pkg) wrapper wrapperPath binPath = do



More information about the ghc-commits mailing list