Commit da15a6f4 authored by Edward Z. Yang's avatar Edward Z. Yang

Fix build-tools PATH usage with per-component new-build

Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 4b4690b8
......@@ -203,6 +203,7 @@ configureSetupScript packageDBs
, useDistPref = distPref
, useLoggingHandle = Nothing
, useWorkingDir = Nothing
, useExtraPathEnv = []
, setupCacheLock = lock
, useWin32CleanHack = False
, forceExternalSetupMethod = forceExternal
......
......@@ -1199,6 +1199,8 @@ buildInplaceUnpackedPackage verbosity
pkg buildStatus
allSrcFiles buildResult
-- PURPOSELY omitted: no copy!
mipkg <- whenReRegister $
annotateFailureNoLog InstallFailed $ do
-- Register locally
......
......@@ -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.
......
......@@ -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')
......
......@@ -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))]
......
......@@ -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
......
......@@ -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
......
. ./common.sh
cd BuildToolsPath
cabal new-build build-tools-path hello-world
{-# OPTIONS_GHC -F -pgmF my-custom-preprocessor #-}
module A where
a :: String
a = "0000"
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
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
module Main where
import A
main :: IO ()
main = putStrLn a
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment