[commit: ghc] wip/nfs-locking: Fix path separators (8be3f76)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:13:49 UTC 2017


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

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

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

commit 8be3f76d78e9806bdbef6a2d2db7bbf341aba0ea
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Oct 31 19:19:19 2016 +0000

    Fix path separators


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

8be3f76d78e9806bdbef6a2d2db7bbf341aba0ea
 src/Oracles/DirectoryContents.hs | 2 +-
 src/Rules/Compile.hs             | 2 +-
 src/Rules/SourceDist.hs          | 9 ++++-----
 3 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/src/Oracles/DirectoryContents.hs b/src/Oracles/DirectoryContents.hs
index 6dd3439..d854c7d 100644
--- a/src/Oracles/DirectoryContents.hs
+++ b/src/Oracles/DirectoryContents.hs
@@ -27,7 +27,7 @@ directoryContents expr dir = askOracle $ DirectoryContents (expr, dir)
 
 directoryContentsOracle :: Rules ()
 directoryContentsOracle = void $
-    addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $
+    addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $ map unifyPath .
         filter (matches expr) <$> listFilesInside (return . matches expr) dir
 
 instance Binary Match
diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 64f8ea9..2d3eb4a 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -14,7 +14,7 @@ import Util
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context at Context {..} = do
     let path            = buildPath context
-        nonHs extension = path </> extension <//> "*" <.> osuf way
+        nonHs extension = path -/- extension <//> "*" <.> osuf way
         compile compiler obj2src obj = do
             let src = obj2src context obj
             need [src]
diff --git a/src/Rules/SourceDist.hs b/src/Rules/SourceDist.hs
index d51fe75..d56eb38 100644
--- a/src/Rules/SourceDist.hs
+++ b/src/Rules/SourceDist.hs
@@ -15,9 +15,9 @@ sourceDistRules = do
         putSuccess "| Done. "
     "sdistprep/ghc-*-src.tar.xz" %> \fname -> do
         let tarName = takeFileName fname
-            treePath = "sdistprep/ghc" </> dropTarXz tarName
+            treePath = "sdistprep/ghc" -/- dropTarXz tarName
         prepareTree treePath
-        runBuilderWith [Cwd "sdistprep/ghc"] Tar ["cJf", ".." </> tarName, dropTarXz tarName]
+        runBuilderWith [Cwd "sdistprep/ghc"] Tar ["cJf", ".." -/- tarName, dropTarXz tarName]
     "GIT_COMMIT_ID" %> \fname ->
         setting ProjectGitCommitId >>= writeFileChanged fname
     "VERSION" %> \fname ->
@@ -25,14 +25,13 @@ sourceDistRules = do
   where
     dropTarXz = dropExtension . dropExtension
 
-
 prepareTree :: FilePath -> Action ()
 prepareTree dest = do
     mapM_ cpDir  srcDirs
     mapM_ cpFile srcFiles
   where
-    cpFile a = copyFile a (dest </> a)
-    cpDir  a = copyDirectoryContents (Not excluded) a (dest </> takeFileName a)
+    cpFile a = copyFile a (dest -/- a)
+    cpDir  a = copyDirectoryContents (Not excluded) a (dest -/- takeFileName a)
     excluded = Or
       [ Test "//.*"
       , Test "//#*"



More information about the ghc-commits mailing list