[commit: ghc] master: Handle absolute paths to build roots in Hadrian. (2ff77b9)
git at git.haskell.org
git at git.haskell.org
Wed Mar 6 21:49:39 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/2ff77b9894eecf51fa619ed2266ca196e296cd1e/ghc
>---------------------------------------------------------------
commit 2ff77b9894eecf51fa619ed2266ca196e296cd1e
Author: P.C. Shyamshankar <shyam at galois.com>
Date: Thu Jan 24 13:07:34 2019 -0500
Handle absolute paths to build roots in Hadrian.
Fixes #16187.
This patch fixes various path concatenation issues to allow functioning
builds with hadrian when the build root location is specified with an
absolute path.
Remarks:
- The path concatenation operator (-/-) now handles absolute second operands
appropriately. Its behavior should match that of POSIX (</>) in this
regard.
- The `getDirectoryFiles*` family of functions only searches for matches
under the directory tree rooted by its first argument; all of the
results are also relative to this root. If the first argument is the
empty string, the current working directory is used.
This patch passes the appropriate directory (almost always either `top`
or `root`), and subsequently attaches that directory prefix so that
the paths refer to the appropriate files.
- Windows `tar` does not like colons (':') in paths to archive files, it
tries to resolve them as remote paths. The `--force-local` option
remedies this, and is applied on windows builds.
>---------------------------------------------------------------
2ff77b9894eecf51fa619ed2266ca196e296cd1e
hadrian/hadrian.cabal | 1 +
hadrian/src/Hadrian/Builder/Tar.hs | 2 ++
hadrian/src/Hadrian/Utilities.hs | 1 +
hadrian/src/Rules/Gmp.hs | 11 ++++++-----
hadrian/src/Rules/Libffi.hs | 10 +++++-----
hadrian/src/Rules/Selftest.hs | 14 ++++++++++++++
6 files changed, 29 insertions(+), 10 deletions(-)
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 56c68aa..a5a1ead 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -121,6 +121,7 @@ executable hadrian
, containers >= 0.5 && < 0.7
, directory >= 1.2 && < 1.4
, extra >= 1.4.7
+ , filepath
, mtl == 2.2.*
, parsec >= 3.1 && < 3.2
, QuickCheck >= 2.6 && < 2.13
diff --git a/hadrian/src/Hadrian/Builder/Tar.hs b/hadrian/src/Hadrian/Builder/Tar.hs
index 75cf725..1d8f502 100644
--- a/hadrian/src/Hadrian/Builder/Tar.hs
+++ b/hadrian/src/Hadrian/Builder/Tar.hs
@@ -14,6 +14,7 @@ import Development.Shake
import Development.Shake.Classes
import GHC.Generics
import Hadrian.Expression
+import Oracles.Setting
-- | Tar can be used to 'Create' an archive or 'Extract' from it.
data TarMode = Create | Extract deriving (Eq, Generic, Show)
@@ -34,6 +35,7 @@ args Create = mconcat
, getInputs ]
args Extract = mconcat
[ arg "-x"
+ , windowsHost ? arg "--force-local"
, input "*.gz" ? arg "--gzip"
, input "*.bz2" ? arg "--bzip2"
, input "*.xz" ? arg "--xz"
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 3e5d7b3..e5fc712 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -133,6 +133,7 @@ unifyPath = toStandard . normaliseEx
-- | Combine paths with a forward slash regardless of platform.
(-/-) :: FilePath -> FilePath -> FilePath
+_ -/- b | isAbsolute b && not (isAbsolute $ tail b) = b
"" -/- b = b
a -/- b
| last a == '/' = a ++ b
diff --git a/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
index a78170c..e4f7e53 100644
--- a/hadrian/src/Rules/Gmp.hs
+++ b/hadrian/src/Rules/Gmp.hs
@@ -15,8 +15,8 @@ gmpObjects = do
-- The line below causes a Shake Lint failure on Windows, which forced us to
-- disable Lint by default. See more details here:
-- https://ghc.haskell.org/trac/ghc/ticket/15971.
- map unifyPath <$>
- liftIO (getDirectoryFilesIO "" [gmpPath -/- gmpObjectsDir -/- "*.o"])
+ map (unifyPath . (gmpPath -/-)) <$>
+ liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"])
gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp"
@@ -103,18 +103,19 @@ gmpRules = do
-- Extract in-tree GMP sources and apply patches
fmap (gmpPath -/-) ["Makefile.in", "configure"] &%> \_ -> do
+ top <- topDirectory
removeDirectory gmpPath
-- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
-- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
-- That's because the doc/ directory contents are under the GFDL,
-- which causes problems for Debian.
tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
- <$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
+ <$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
withTempDir $ \dir -> do
let tmp = unifyPath dir
- need [tarball]
- build $ target gmpContext (Tar Extract) [tarball] [tmp]
+ need [top -/- tarball]
+ build $ target gmpContext (Tar Extract) [top -/- tarball] [tmp]
let patch = gmpBase -/- "gmpsrc.patch"
patchName = takeFileName patch
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
index 64f6303..5b25aab 100644
--- a/hadrian/src/Rules/Libffi.hs
+++ b/hadrian/src/Rules/Libffi.hs
@@ -114,10 +114,10 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do
build $ target context (Make libffiPath) [] []
-- Here we produce 'libffiDependencies'
- headers <- liftIO $ getDirectoryFilesIO "" [libffiPath -/- "inst/include/*"]
+ headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"]
forM_ headers $ \header -> do
let target = rtsPath -/- takeFileName header
- copyFileUntracked header target
+ copyFileUntracked (libffiPath -/- header) target
produces [target]
-- Find ways.
@@ -171,10 +171,11 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do
-- Extract libffi tar file
context <- libffiContext stage
removeDirectory libffiPath
+ top <- topDirectory
tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
- <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
+ <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"]
- need [tarball]
+ need [top -/- tarball]
-- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
let libname = takeWhile (/= '+') $ takeFileName tarball
@@ -187,7 +188,6 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do
-- And finally:
removeFiles (path) [libname <//> "*"]
- top <- topDirectory
fixFile mkIn (fixLibffiMakefile top)
files <- liftIO $ getDirectoryFilesIO "." [libffiPath <//> "*"]
diff --git a/hadrian/src/Rules/Selftest.hs b/hadrian/src/Rules/Selftest.hs
index 68aa6e3..b931f85 100644
--- a/hadrian/src/Rules/Selftest.hs
+++ b/hadrian/src/Rules/Selftest.hs
@@ -13,6 +13,8 @@ import Settings
import Target
import Utilities
+import qualified System.FilePath.Posix as Posix ((</>))
+
instance Arbitrary Way where
arbitrary = wayFromUnits <$> arbitrary
@@ -31,6 +33,7 @@ selftestRules =
testLookupAll
testModuleName
testPackages
+ testPaths
testWay
testBuilder :: Action ()
@@ -111,3 +114,14 @@ testWay :: Action ()
testWay = do
putBuild "==== Read Way, Show Way"
test $ \(x :: Way) -> read (show x) == x
+
+testPaths :: Action ()
+testPaths = do
+ putBuild "==== Absolute, Relative Path Concatenation"
+ test $ forAll paths $ \(path1, path2) ->
+ path1 -/- path2 == path1 Posix.</> path2
+ where
+ paths = (,) <$> path <*> path
+ path = frequency [(1, relativePath), (1, absolutePath)]
+ relativePath = intercalate "/" <$> listOf1 (elements ["a"])
+ absolutePath = ('/':) <$> relativePath
More information about the ghc-commits
mailing list