[commit: ghc] wip/nfs-locking: Add missing path unifications. (bc5b5e1)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:12:45 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