Skip to content
Snippets Groups Projects
Commit 7218270d authored by Andrey Mokhov's avatar Andrey Mokhov Committed by Ben Gamari
Browse files

Switch to the untracked version of getDirectoryFiles when scanning for GMP objects

See https://ghc.haskell.org/trac/ghc/ticket/15971.

This is work in progress: this commit does the right thing, but does not
yet fix the ticket.
parent 78ae2d5d
No related branches found
No related tags found
No related merge requests found
module Rules.Gmp (
gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH
gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH
) where
import Base
......@@ -9,6 +9,18 @@ import Packages
import Target
import Utilities
-- | Build GMP library objects and return their paths.
gmpObjects :: Action [FilePath]
gmpObjects = do
gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibraryH]
-- We need to use the untracked version of 'getDirectoryFiles', because the
-- contents of 'gmpObjectsDir' is built by Hadrian (in 'gmpRules'). Using
-- the tracked version can lead to Shake Lint failure.
-- See: https://ghc.haskell.org/trac/ghc/ticket/15971.
map unifyPath <$>
liftIO (getDirectoryFilesIO "" [gmpPath -/- gmpObjectsDir -/- "*.o"])
gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp"
......
......@@ -103,11 +103,8 @@ cObjects context = do
-- 'Context' is @integer-gmp@.
extraObjects :: Context -> Action [FilePath]
extraObjects context
| package context == integerGmp = do
gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibraryH]
map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
| otherwise = return []
| package context == integerGmp = gmpObjects
| otherwise = return []
-- | Return all the object files to be put into the library we're building for
-- the given 'Context'.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment