diff options
Diffstat (limited to 'hadrian')
| -rw-r--r-- | hadrian/hadrian.cabal | 1 | ||||
| -rw-r--r-- | hadrian/src/Hadrian/Builder/Tar.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Hadrian/Utilities.hs | 1 | ||||
| -rw-r--r-- | hadrian/src/Rules/Gmp.hs | 11 | ||||
| -rw-r--r-- | hadrian/src/Rules/Libffi.hs | 10 | ||||
| -rw-r--r-- | hadrian/src/Rules/Selftest.hs | 14 |
6 files changed, 29 insertions, 10 deletions
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal index 56c68aa0c3..a5a1ead0e7 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 75cf725b4b..1d8f5025a5 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 3e5d7b37db..e5fc712512 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 a78170cf6a..e4f7e53b48 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 64f63039eb..5b25aab5ba 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 68aa6e3889..b931f85ef6 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 |