Handle absolute paths to build roots in Hadrian.
authorP.C. Shyamshankar <shyam@galois.com>
Thu, 24 Jan 2019 18:07:34 +0000 (13:07 -0500)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Wed, 6 Mar 2019 14:17:22 +0000 (09:17 -0500)
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.

hadrian/hadrian.cabal
hadrian/src/Hadrian/Builder/Tar.hs
hadrian/src/Hadrian/Utilities.hs
hadrian/src/Rules/Gmp.hs
hadrian/src/Rules/Libffi.hs
hadrian/src/Rules/Selftest.hs

index 56c68aa..a5a1ead 100644 (file)
@@ -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
index 75cf725..1d8f502 100644 (file)
@@ -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"
index 3e5d7b3..e5fc712 100644 (file)
@@ -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
index a78170c..e4f7e53 100644 (file)
@@ -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
index 64f6303..5b25aab 100644 (file)
@@ -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 <//> "*"]
index 68aa6e3..b931f85 100644 (file)
@@ -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