[commit: ghc] wip/nfs-locking: Fix missing dependency on package configuration (c6d7b2a)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:00:38 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/c6d7b2a33e6ff987e7112c57555425c285c380e9/ghc

>---------------------------------------------------------------

commit c6d7b2a33e6ff987e7112c57555425c285c380e9
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Sep 29 00:37:35 2017 +0100

    Fix missing dependency on package configuration
    
    Also a minor revision.
    
    See #421


>---------------------------------------------------------------

c6d7b2a33e6ff987e7112c57555425c285c380e9
 src/Base.hs                     |  7 ++++++-
 src/Builder.hs                  | 12 ++++++------
 src/Settings/Builders/Common.hs |  8 +++-----
 src/Settings/Builders/Ghc.hs    | 14 +++++++++-----
 src/Settings/Default.hs         |  2 +-
 5 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 76e8f2b..38c8792 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -22,7 +22,7 @@ module Base (
     hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
     generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
     inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir,
-    inplacePackageDbPath, packageDbStamp
+    inplacePackageDbPath, packageDbPath, packageDbStamp
     ) where
 
 import Control.Applicative
@@ -82,6 +82,11 @@ stage0PackageDbDir = "stage0/bootstrapping.conf"
 inplacePackageDbPath :: FilePath
 inplacePackageDbPath = "inplace/lib/package.conf.d"
 
+-- | Path to the package database used in a given 'Stage'.
+packageDbPath :: Stage -> Action FilePath
+packageDbPath Stage0 = buildRoot <&> (-/- stage0PackageDbDir)
+packageDbPath _      = return inplacePackageDbPath
+
 -- | We use a stamp file to track the existence of a package database.
 packageDbStamp :: FilePath
 packageDbStamp = ".stamp"
diff --git a/src/Builder.hs b/src/Builder.hs
index 355878f..fdd73e7 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -149,13 +149,13 @@ instance H.Builder Builder where
         Just context -> programPath context
 
     needBuilder :: Builder -> Action ()
-    needBuilder (Configure dir) = need [dir -/- "configure"]
-    needBuilder Hsc2Hs          = do path <- H.builderPath Hsc2Hs
-                                     need [path, templateHscPath]
-    needBuilder (Make      dir) = need [dir -/- "Makefile"]
-    needBuilder builder         = when (isJust $ builderProvenance builder) $ do
+    needBuilder builder = do
         path <- H.builderPath builder
-        need [path]
+        case builder of
+            Configure dir -> need [dir -/- "configure"]
+            Hsc2Hs        -> need [path, templateHscPath]
+            Make dir      -> need [dir -/- "Makefile"]
+            _             -> when (isJust $ builderProvenance builder) $ need [path]
 
     runBuilderWith :: Builder -> BuildInfo -> Action ()
     runBuilderWith builder BuildInfo {..} = do
diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs
index 6da7ea8..e7af38b 100644
--- a/src/Settings/Builders/Common.hs
+++ b/src/Settings/Builders/Common.hs
@@ -49,11 +49,9 @@ cWarnings = do
 
 bootPackageDatabaseArgs :: Args
 bootPackageDatabaseArgs = do
-    root  <- getBuildRoot
-    stage <- getStage
-    let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
-              | otherwise       = inplacePackageDbPath
-    expr $ need [dbDir -/- packageDbStamp]
+    stage  <- getStage
+    dbPath <- expr $ packageDbPath stage
+    expr $ need [dbPath -/- packageDbStamp]
     stage0 ? do
         top    <- expr topDirectory
         root   <- getBuildRoot
diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs
index 7f942f6..94b5b21 100644
--- a/src/Settings/Builders/Ghc.hs
+++ b/src/Settings/Builders/Ghc.hs
@@ -1,5 +1,5 @@
 module Settings.Builders.Ghc (
-    ghcBuilderArgs, ghcMBuilderArgs, haddockGhcArgs, ghcCbuilderArgs
+    ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs, haddockGhcArgs
     ) where
 
 import Hadrian.Haskell.Cabal
@@ -24,9 +24,8 @@ needTouchy = notStage0 ? windowsHost ? do
     touchyPath <- expr $ programPath (vanillaContext Stage0 touchy)
     expr $ need [touchyPath]
 
-ghcCbuilderArgs :: Args
-ghcCbuilderArgs =
-  builder (Ghc CompileCWithGhc) ? do
+ghcCBuilderArgs :: Args
+ghcCBuilderArgs = builder (Ghc CompileCWithGhc) ? do
     way <- getWay
     let ccArgs = [ getPkgDataList CcArgs
                  , getStagedSettingList ConfCcArgs
@@ -83,11 +82,16 @@ ghcMBuilderArgs = builder (Ghc FindHsDependencies) ? do
 haddockGhcArgs :: Args
 haddockGhcArgs = mconcat [ commonGhcArgs, getPkgDataList HsArgs ]
 
--- This is included into ghcBuilderArgs, ghcMBuilderArgs and haddockGhcArgs.
+-- Used in ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs and haddockGhcArgs.
 commonGhcArgs :: Args
 commonGhcArgs = do
     way     <- getWay
     path    <- getBuildPath
+    pkg     <- getPackage
+    when (isLibrary pkg) $ do
+        context <- getContext
+        conf <- expr $ pkgConfFile context
+        expr $ need [conf]
     mconcat [ arg "-hisuf", arg $ hisuf way
             , arg "-osuf" , arg $  osuf way
             , arg "-hcsuf", arg $ hcsuf way
diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs
index 10ec84f..cf0047f 100644
--- a/src/Settings/Default.hs
+++ b/src/Settings/Default.hs
@@ -148,8 +148,8 @@ defaultBuilderArgs = mconcat
     , deriveConstantsBuilderArgs
     , genPrimopCodeBuilderArgs
     , ghcBuilderArgs
-    , ghcCbuilderArgs
     , ghcCabalBuilderArgs
+    , ghcCBuilderArgs
     , ghcMBuilderArgs
     , ghcPkgBuilderArgs
     , haddockBuilderArgs



More information about the ghc-commits mailing list