From da15a6f4134adccbb868b08b32565ecb6614c61a Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@cs.stanford.edu>
Date: Tue, 16 Aug 2016 00:09:34 -0700
Subject: [PATCH] Fix build-tools PATH usage with per-component new-build
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
---
.../Distribution/Client/Configure.hs | 1 +
.../Distribution/Client/ProjectBuilding.hs | 2 +
.../Distribution/Client/ProjectPlanning.hs | 39 +++++++++++++++----
.../Client/ProjectPlanning/Types.hs | 7 ++++
.../Distribution/Client/SetupWrapper.hs | 18 ++++++---
cabal-install/Distribution/Client/Utils.hs | 25 ++++++++++--
cabal-install/cabal-install.cabal | 6 +++
.../new-build/BuildToolsPath.sh | 3 ++
.../new-build/BuildToolsPath/A.hs | 5 +++
.../BuildToolsPath/MyCustomPreprocessor.hs | 11 ++++++
.../BuildToolsPath/build-tools-path.cabal | 25 ++++++++++++
.../new-build/BuildToolsPath/cabal.project | 1 +
.../new-build/BuildToolsPath/hello/Hello.hs | 6 +++
13 files changed, 131 insertions(+), 18 deletions(-)
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project
create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs
diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs
index 4737b51ab2..81f6faaa56 100644
--- a/cabal-install/Distribution/Client/Configure.hs
+++ b/cabal-install/Distribution/Client/Configure.hs
@@ -203,6 +203,7 @@ configureSetupScript packageDBs
, useDistPref = distPref
, useLoggingHandle = Nothing
, useWorkingDir = Nothing
+ , useExtraPathEnv = []
, setupCacheLock = lock
, useWin32CleanHack = False
, forceExternalSetupMethod = forceExternal
diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs
index 737e250e81..df60ac99c2 100644
--- a/cabal-install/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/Distribution/Client/ProjectBuilding.hs
@@ -1199,6 +1199,8 @@ buildInplaceUnpackedPackage verbosity
pkg buildStatus
allSrcFiles buildResult
+ -- PURPOSELY omitted: no copy!
+
mipkg <- whenReRegister $
annotateFailureNoLog InstallFailed $ do
-- Register locally
diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
index 3b90cfbb88..d75256632c 100644
--- a/cabal-install/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -1060,9 +1060,9 @@ elaborateInstallPlan platform compiler compilerprogdb
internalPkgSet = pkgInternalPackages pkg
comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet
- buildComponent :: (Map PackageName ConfiguredId, Map String ConfiguredId)
+ buildComponent :: (Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath))
-> (Cabal.Component, [Cabal.ComponentName])
- -> ((Map PackageName ConfiguredId, Map String ConfiguredId),
+ -> ((Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)),
ElaboratedComponent)
buildComponent (internal_map, exe_map) (comp, _cdeps) =
((internal_map', exe_map'), ecomp)
@@ -1079,6 +1079,8 @@ elaborateInstallPlan platform compiler compilerprogdb
internal_lib_deps,
elabComponentExeDependencies =
internal_exe_deps,
+ elabComponentExeDependencyPaths =
+ internal_exe_dep_paths,
elabComponentInstallDirs = installDirs,
-- These are filled in later
elabComponentBuildTargets = [],
@@ -1106,11 +1108,12 @@ elaborateInstallPlan platform compiler compilerprogdb
= [ confid'
| Dependency pkgname _ <- PD.targetBuildDepends bi
, Just confid' <- [Map.lookup pkgname internal_map] ]
- internal_exe_deps
- = [ confInstId confid'
+ (internal_exe_deps, internal_exe_dep_paths)
+ = unzip $
+ [ (confInstId confid', path)
| Dependency (PackageName toolname) _ <- PD.buildTools bi
, toolname `elem` map PD.exeName (PD.executables pd)
- , Just confid' <- [Map.lookup toolname exe_map]
+ , Just (confid', path) <- [Map.lookup toolname exe_map]
]
internal_map' = case cname of
CLibName
@@ -1119,8 +1122,25 @@ elaborateInstallPlan platform compiler compilerprogdb
-> Map.insert (PackageName libname) confid internal_map
_ -> internal_map
exe_map' = case cname of
- CExeName exename -> Map.insert exename confid exe_map
- _ -> exe_map
+ CExeName exename
+ -> Map.insert exename (confid, inplace_bin_dir) exe_map
+ _ -> exe_map
+ -- NB: For inplace NOT InstallPaths.bindir installDirs; for an
+ -- inplace build those values are utter nonsense. So we
+ -- have to guess where the directory is going to be.
+ -- Fortunately this is "stable" part of Cabal API.
+ -- But the way we get the build directory is A HORRIBLE
+ -- HACK.
+ inplace_bin_dir
+ | shouldBuildInplaceOnly spkg
+ = distBuildDirectory
+ (elabDistDirParams elaboratedSharedConfig (ElabComponent ecomp)) </>
+ "build" </> case Cabal.componentNameString cname of
+ Just n -> n
+ Nothing -> ""
+ | otherwise
+ = InstallDirs.bindir installDirs
+
installDirs
| shouldBuildInplaceOnly spkg
@@ -2044,7 +2064,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage
-> SetupScriptOptions
-- TODO: Fix this so custom is a separate component. Custom can ALWAYS
-- be a separate component!!!
-setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..}))
+setupHsScriptOptions (ReadyPackage pkg_or_comp)
ElaboratedSharedConfig{..} srcdir builddir
isParallelBuild cacheLock =
SetupScriptOptions {
@@ -2062,10 +2082,13 @@ setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..
useDistPref = builddir,
useLoggingHandle = Nothing, -- this gets set later
useWorkingDir = Just srcdir,
+ useExtraPathEnv = elabExeDependencyPaths pkg_or_comp,
useWin32CleanHack = False, --TODO: [required eventually]
forceExternalSetupMethod = isParallelBuild,
setupCacheLock = Just cacheLock
}
+ where
+ ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp
-- | To be used for the input for elaborateInstallPlan.
diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
index 2a415b7083..3629590bc7 100644
--- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
@@ -17,6 +17,7 @@ module Distribution.Client.ProjectPlanning.Types (
elabInstallDirs,
elabDistDirParams,
elabRequiresRegistration,
+ elabExeDependencyPaths,
elabBuildTargets,
elabReplTarget,
elabBuildHaddocks,
@@ -170,6 +171,10 @@ elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg
elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp
+elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath]
+elabExeDependencyPaths (ElabPackage _) = [] -- TODO: not implemented
+elabExeDependencyPaths (ElabComponent comp) = elabComponentExeDependencyPaths comp
+
getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage
getElaboratedPackage (ElabPackage pkg) = pkg
getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp
@@ -209,6 +214,8 @@ data ElaboratedComponent
-- | The order-only dependencies of this component; e.g.,
-- if you depend on an executable it goes here.
elabComponentExeDependencies :: [ComponentId],
+ -- | The file paths of all our executable dependencies.
+ elabComponentExeDependencyPaths :: [FilePath],
-- | The 'ElaboratedPackage' this component came from
elabComponentPackage :: ElaboratedPackage,
-- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets')
diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs
index 106e514f77..985c21034e 100644
--- a/cabal-install/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/Distribution/Client/SetupWrapper.hs
@@ -52,7 +52,7 @@ import Distribution.Simple.Program
, getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram
, ghcjsProgram )
import Distribution.Simple.Program.Find
- ( programSearchPathAsPATHVar )
+ ( programSearchPathAsPATHVar, ProgramSearchPathEntry(ProgramSearchPathDir) )
import Distribution.Simple.Program.Run
( getEffectiveEnvironment )
import qualified Distribution.Simple.Program.Strip as Strip
@@ -80,7 +80,7 @@ import Distribution.Simple.Utils
, createDirectoryIfMissingVerbose, installExecutableFile
, copyFileVerbose, rewriteFile, intercalate )
import Distribution.Client.Utils
- ( inDir, tryCanonicalizePath
+ ( inDir, tryCanonicalizePath, withExtraPathEnv
, existsAndIsMoreRecentThan, moreRecentFile, withEnv
#if mingw32_HOST_OS
, canonicalizePathNoThrow
@@ -160,6 +160,8 @@ data SetupScriptOptions = SetupScriptOptions {
useDistPref :: FilePath,
useLoggingHandle :: Maybe Handle,
useWorkingDir :: Maybe FilePath,
+ -- | Extra things to add to PATH when invoking the setup script.
+ useExtraPathEnv :: [FilePath],
forceExternalSetupMethod :: Bool,
-- | List of dependencies to use when building Setup.hs.
@@ -228,6 +230,7 @@ defaultSetupScriptOptions = SetupScriptOptions {
useDistPref = defaultDistPref,
useLoggingHandle = Nothing,
useWorkingDir = Nothing,
+ useExtraPathEnv = [],
useWin32CleanHack = False,
forceExternalSetupMethod = False,
setupCacheLock = Nothing
@@ -304,9 +307,10 @@ internalSetupMethod verbosity options _ bt mkargs = do
let args = mkargs cabalVersion
info verbosity $ "Using internal setup method with build-type " ++ show bt
++ " and args:\n " ++ show args
- inDir (useWorkingDir options) $
+ inDir (useWorkingDir options) $ do
withEnv "HASKELL_DIST_DIR" (useDistPref options) $
- buildTypeAction bt args
+ withExtraPathEnv (useExtraPathEnv options) $
+ buildTypeAction bt args
buildTypeAction :: BuildType -> ([String] -> IO ())
buildTypeAction Simple = Simple.defaultMainArgs
@@ -335,7 +339,8 @@ selfExecSetupMethod verbosity options _pkg bt mkargs = do
++ show logHandle
searchpath <- programSearchPathAsPATHVar
- (getProgramSearchPath (useProgramConfig options))
+ (map ProgramSearchPathDir (useExtraPathEnv options) ++
+ getProgramSearchPath (useProgramConfig options))
env <- getEffectiveEnvironment [("PATH", Just searchpath)
,("HASKELL_DIST_DIR", Just (useDistPref options))]
@@ -689,7 +694,8 @@ externalSetupMethod verbosity options pkg bt mkargs = do
where
doInvoke path' = do
searchpath <- programSearchPathAsPATHVar
- (getProgramSearchPath (useProgramConfig options'))
+ (map ProgramSearchPathDir (useExtraPathEnv options') ++
+ getProgramSearchPath (useProgramConfig options'))
env <- getEffectiveEnvironment [("PATH", Just searchpath)
,("HASKELL_DIST_DIR", Just (useDistPref options))]
diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs
index 4fa8719556..80b37b8d83 100644
--- a/cabal-install/Distribution/Client/Utils.hs
+++ b/cabal-install/Distribution/Client/Utils.hs
@@ -4,6 +4,7 @@ module Distribution.Client.Utils ( MergeResult(..)
, mergeBy, duplicates, duplicatesBy
, readMaybe
, inDir, withEnv, logDirChange
+ , withExtraPathEnv
, determineNumJobs, numberOfProcessors
, removeExistingFile
, withTempFileName
@@ -18,7 +19,7 @@ module Distribution.Client.Utils ( MergeResult(..)
, relaxEncodingErrors)
where
-import Distribution.Compat.Environment ( lookupEnv, setEnv, unsetEnv )
+import Distribution.Compat.Environment
import Distribution.Compat.Exception ( catchIO )
import Distribution.Compat.Time ( getModTime )
import Distribution.Simple.Setup ( Flag(..) )
@@ -31,6 +32,7 @@ import Control.Monad
( when )
import Data.Bits
( (.|.), shiftL, shiftR )
+import System.FilePath
import Data.Char
( ord, chr )
#if MIN_VERSION_base(4,6,0)
@@ -38,7 +40,7 @@ import Text.Read
( readMaybe )
#endif
import Data.List
- ( isPrefixOf, sortBy, groupBy )
+ ( isPrefixOf, sortBy, groupBy, intercalate )
import Data.Word
( Word8, Word32)
import Foreign.C.Types ( CInt(..) )
@@ -47,8 +49,6 @@ import qualified Control.Exception as Exception
import System.Directory
( canonicalizePath, doesFileExist, getCurrentDirectory
, removeFile, setCurrentDirectory )
-import System.FilePath
- ( (</>), isAbsolute, takeDrive, splitPath, joinPath )
import System.IO
( Handle, hClose, openTempFile
#if MIN_VERSION_base(4,4,0)
@@ -153,6 +153,23 @@ withEnv k v m = do
Nothing -> unsetEnv k
Just old -> setEnv k old)
+-- | Executes the action, increasing the PATH environment
+-- in some way
+--
+-- Warning: This operation is NOT thread-safe, because the
+-- environment variables are a process-global concept.
+withExtraPathEnv :: [FilePath] -> IO a -> IO a
+withExtraPathEnv paths m = do
+ oldPathSplit <- getSearchPath
+ let newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit)
+ oldPath = mungePath $ intercalate [searchPathSeparator] oldPathSplit
+ -- TODO: This is a horrible hack to work around the fact that
+ -- setEnv can't take empty values as an argument
+ mungePath p | p == "" = "/dev/null"
+ | otherwise = p
+ setEnv "PATH" newPath
+ m `Exception.finally` setEnv "PATH" oldPath
+
-- | Log directory change in 'make' compatible syntax
logDirChange :: (String -> IO ()) -> Maybe FilePath -> IO a -> IO a
logDirChange _ Nothing m = m
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index a157308386..a7e0612e53 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -77,6 +77,12 @@ Extra-Source-Files:
tests/IntegrationTests/multiple-source/p/p.cabal
tests/IntegrationTests/multiple-source/q/Setup.hs
tests/IntegrationTests/multiple-source/q/q.cabal
+ tests/IntegrationTests/new-build/BuildToolsPath.sh
+ tests/IntegrationTests/new-build/BuildToolsPath/A.hs
+ tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs
+ tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal
+ tests/IntegrationTests/new-build/BuildToolsPath/cabal.project
+ tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs
tests/IntegrationTests/new-build/T3460.sh
tests/IntegrationTests/new-build/T3460/C.hs
tests/IntegrationTests/new-build/T3460/Setup.hs
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh
new file mode 100644
index 0000000000..90f3107853
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh
@@ -0,0 +1,3 @@
+. ./common.sh
+cd BuildToolsPath
+cabal new-build build-tools-path hello-world
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs
new file mode 100644
index 0000000000..e5e075ad70
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -F -pgmF my-custom-preprocessor #-}
+module A where
+
+a :: String
+a = "0000"
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs
new file mode 100644
index 0000000000..09c949ab17
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs
@@ -0,0 +1,11 @@
+module Main where
+
+import System.Environment
+import System.IO
+
+main :: IO ()
+main = do
+ (_:source:target:_) <- getArgs
+ let f '0' = '1'
+ f c = c
+ writeFile target . map f =<< readFile source
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal
new file mode 100644
index 0000000000..12214a3435
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal
@@ -0,0 +1,25 @@
+name: build-tools-path
+version: 0.1.0.0
+synopsis: Checks build-tools are put in PATH
+license: BSD3
+category: Testing
+build-type: Simple
+cabal-version: >=1.10
+
+executable my-custom-preprocessor
+ main-is: MyCustomPreprocessor.hs
+ build-depends: base, directory
+ default-language: Haskell2010
+
+library
+ exposed-modules: A
+ build-depends: base
+ build-tools: my-custom-preprocessor
+ -- ^ Note the internal dependency.
+ default-language: Haskell2010
+
+executable hello-world
+ main-is: Hello.hs
+ build-depends: base, build-tools-path
+ default-language: Haskell2010
+ hs-source-dirs: hello
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project
new file mode 100644
index 0000000000..e6fdbadb43
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs
new file mode 100644
index 0000000000..89a5e5a026
--- /dev/null
+++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import A
+
+main :: IO ()
+main = putStrLn a
--
GitLab