[commit: ghc] wip/nfs-locking: Add missing path unifications. (bc5b5e1)

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


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

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

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

commit bc5b5e167368ecbf4e53cbbf9833cdfca9604211
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu May 12 01:05:08 2016 +0100

    Add missing path unifications.


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

bc5b5e167368ecbf4e53cbbf9833cdfca9604211
 src/Oracles/ModuleFiles.hs | 20 +++++++++++---------
 src/Rules/Data.hs          |  6 ++++--
 src/Rules/Selftest.hs      |  8 ++++----
 3 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs
index e77d2ba..233cdc0 100644
--- a/src/Oracles/ModuleFiles.hs
+++ b/src/Oracles/ModuleFiles.hs
@@ -28,20 +28,22 @@ determineBuilder file = case takeExtension file of
 
 -- | Given a module name extract the directory and file name, e.g.:
 --
--- > decodeModule "Data.Functor.Identity" == ("Data/Functor/", "Identity")
--- > decodeModule "Prelude"               == ("./", "Prelude")
+-- > decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
+-- > decodeModule "Prelude"               == ("", "Prelude")
 decodeModule :: String -> (FilePath, String)
-decodeModule = splitFileName . replaceEq '.' '/'
+decodeModule modName = (intercalate "/" (init xs), last xs)
+  where
+    xs = words $ replaceEq '.' ' ' modName
 
 -- | Given the directory and file name find the corresponding module name, e.g.:
 --
--- > encodeModule "Data/Functor/" "Identity.hs" == "Data.Functor.Identity"
--- > encodeModule "./" "Prelude"                == "Prelude"
--- > uncurry encodeModule (decodeModule name)   == name
+-- > encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
+-- > encodeModule "" "Prelude"                 == "Prelude"
+-- > uncurry encodeModule (decodeModule name)  == name
 encodeModule :: FilePath -> String -> String
 encodeModule dir file
-    | dir == "./" = replaceEq '/' '.' $        takeBaseName file
-    | otherwise   = replaceEq '/' '.' $ dir ++ takeBaseName file
+    | dir == "" =                                takeBaseName file
+    | otherwise = replaceEq '/' '.' dir ++ '.' : takeBaseName file
 
 -- | Find the generator for a given 'Context' and a source file. For example:
 -- findGenerator (Context Stage1 compiler vanilla)
@@ -102,7 +104,7 @@ moduleFilesOracle = void $ do
         result <- fmap concat . forM dirs $ \dir -> do
             todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
             forM todo $ \(mDir, mFiles) -> do
-                let fullDir = dir -/- mDir
+                let fullDir = unifyPath $ dir -/- mDir
                 files <- getDirectoryFiles fullDir ["*"]
                 let noBoot   = filter (not . (isSuffixOf "-boot")) files
                     cmp fe f = compare (dropExtension fe) f
diff --git a/src/Rules/Data.hs b/src/Rules/Data.hs
index 719352f..f901069 100644
--- a/src/Rules/Data.hs
+++ b/src/Rules/Data.hs
@@ -44,7 +44,8 @@ buildPackageData context at Context {..} = do
         copyFile inTreeMk mk
         autogenFiles <- getDirectoryFiles (oldPath -/- "build") ["autogen/*"]
         createDirectory $ buildPath context -/- "autogen"
-        forM_ autogenFiles $ \file -> do
+        forM_ autogenFiles $ \file' -> do
+            let file = unifyPath file'
             copyFile (oldPath -/- "build" -/- file) (buildPath context -/- file)
         let haddockPrologue = "haddock-prologue.txt"
         copyFile (oldPath -/- haddockPrologue) (buildPath context -/- haddockPrologue)
@@ -111,7 +112,8 @@ buildPackageData context at Context {..} = do
                           ++ [ "posix" | not windows ]
                           ++ [ "win32" |     windows ]
                 -- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
-                cSrcs   <- getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
+                cSrcs   <- map unifyPath <$>
+                           getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
                 cmmSrcs <- getDirectoryFiles (pkgPath package) ["*.cmm"]
                 buildAdjustor   <- anyTargetArch ["i386", "powerpc", "powerpc64"]
                 buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
diff --git a/src/Rules/Selftest.hs b/src/Rules/Selftest.hs
index 8037682..9ba4524 100644
--- a/src/Rules/Selftest.hs
+++ b/src/Rules/Selftest.hs
@@ -61,11 +61,11 @@ testMatchVersionedFilePath = do
 testModuleNames :: Action ()
 testModuleNames = do
     putBuild $ "==== Encode/decode module name"
-    test $ encodeModule "Data/Functor/" "Identity.hs" == "Data.Functor.Identity"
-    test $ encodeModule "./" "Prelude"                == "Prelude"
+    test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
+    test $ encodeModule "" "Prelude"                 == "Prelude"
 
-    test $ decodeModule "Data.Functor.Identity" == ("Data/Functor/", "Identity")
-    test $ decodeModule "Prelude"               == ("./", "Prelude")
+    test $ decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
+    test $ decodeModule "Prelude"               == ("", "Prelude")
 
     test $ forAll names $ \n -> uncurry encodeModule (decodeModule n) == n
   where



More information about the ghc-commits mailing list