diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 98f10df1d7f..03fd00b9290 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -98,6 +98,10 @@ extra-source-files: tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs + tests/PackageTests/BuildToolsPath/A.hs + tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs + tests/PackageTests/BuildToolsPath/build-tools-path.cabal + tests/PackageTests/BuildToolsPath/hello/Hello.hs tests/PackageTests/BuildableField/BuildableField.cabal tests/PackageTests/BuildableField/Main.hs tests/PackageTests/CMain/Bar.hs diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 598c00932f7..ab08940fea0 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -425,6 +425,7 @@ testSuiteLibV09AsLibAndExe pkg_descr libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi , componentInternalDeps = componentInternalDeps clbi + , componentExeDeps = componentExeDeps clbi , componentLocalName = CSubLibName (testName test) , componentIsPublic = False , componentIncludes = componentIncludes clbi @@ -465,6 +466,7 @@ testSuiteLibV09AsLibAndExe pkg_descr -- (doesn't clobber something) we won't run into trouble componentUnitId = mkUnitId (stubName test), componentInternalDeps = [componentUnitId clbi], + componentExeDeps = [], componentLocalName = CExeName (stubName test), componentPackageDeps = deps, componentIncludes = zip (map fst deps) (repeat defaultRenaming) @@ -488,6 +490,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } componentUnitId = componentUnitId clbi, componentLocalName = CExeName (benchmarkName bm), componentInternalDeps = componentInternalDeps clbi, + componentExeDeps = componentExeDeps clbi, componentPackageDeps = componentPackageDeps clbi, componentIncludes = componentIncludes clbi } diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 0f7d53c6e88..bd6ad077589 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1778,14 +1778,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ foldM go [] graph where go z (component, dep_cnames) = do - -- NB: We want to preserve cdeps because it contains extra - -- information like build-tools ordering - let dep_uids = [ componentUnitId dep_clbi - | cname <- dep_cnames - -- Being in z relies on topsort! - , dep_clbi <- z - , componentLocalName dep_clbi == cname ] - clbi <- componentLocalBuildInfo z component dep_uids + clbi <- componentLocalBuildInfo z component dep_cnames return (clbi:z) -- The allPkgDeps contains all the package deps for the whole package @@ -1794,8 +1787,19 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ -- needs. Note, this only works because we cannot yet depend on two -- versions of the same package. componentLocalBuildInfo :: [ComponentLocalBuildInfo] - -> Component -> [UnitId] -> IO ComponentLocalBuildInfo - componentLocalBuildInfo internalComps component dep_uids = + -> Component -> [ComponentName] -> IO ComponentLocalBuildInfo + componentLocalBuildInfo internalComps component dep_cnames = + -- NB: We want to preserve cdeps because it contains extra + -- information like build-tools ordering + let dep_uids = [ componentUnitId dep_clbi + | cname <- dep_cnames + , dep_clbi <- internalComps + , componentLocalName dep_clbi == cname ] + dep_exes = [ componentUnitId dep_clbi + | cname@(CExeName _) <- dep_cnames + , dep_clbi <- internalComps + , componentLocalName dep_clbi == cname ] + in -- (putStrLn $ "configuring " ++ display (componentName component)) >> case component of CLib lib -> do @@ -1812,6 +1816,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return LibComponentLocalBuildInfo { componentPackageDeps = cpds, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentUnitId = uid, componentLocalName = componentName component, componentIsPublic = libName lib == Nothing, @@ -1824,6 +1829,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return ExeComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes @@ -1832,6 +1838,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return TestComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes @@ -1840,6 +1847,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return BenchComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 669f62ccca5..2bed4040e36 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -46,6 +46,8 @@ import Distribution.Simple.Setup import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program import Distribution.Simple.LocalBuildInfo +import Distribution.Types.LocalBuildInfo +import Distribution.Types.TargetInfo import Distribution.Simple.Utils import Distribution.Simple.BuildPaths import Distribution.System @@ -304,6 +306,7 @@ componentGhcOptions verbosity lbi bi clbi odir = ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi), ghcOptExtra = toNubListR $ hcOptions GHC bi, + ghcOptExtraPath = toNubListR $ exe_paths, ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), -- Unsupported extensions have already been checked by configure ghcOptExtensions = toNubListR $ usedExtensions bi, @@ -320,6 +323,11 @@ componentGhcOptions verbosity lbi bi clbi odir = toGhcDebugInfo NormalDebugInfo = toFlag True toGhcDebugInfo MaximalDebugInfo = toFlag True + exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt) + | uid <- componentExeDeps clbi + -- TODO: Ugh, localPkgDescr + , Just exe_tgt <- [unitIdTarget' (localPkgDescr lbi) lbi uid] ] + -- | Strip out flags that are not supported in ghci filterGhciFlags :: [String] -> [String] filterGhciFlags = filter supported diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index ac6ba0b6538..b4d58dc7fd7 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -210,6 +210,10 @@ data GhcOptions = GhcOptions { -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. ghcOptVerbosity :: Flag Verbosity, + -- | Put the extra folders in the PATH environment variable we invoke + -- GHC with + ghcOptExtraPath :: NubListR FilePath, + -- | Let GHC know that it is Cabal that's calling it. -- Modifies some of the GHC error messages. ghcOptCabal :: Flag Bool @@ -251,7 +255,9 @@ runGHC verbosity ghcProg comp platform opts = do ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> ProgramInvocation ghcInvocation prog comp platform opts = - programInvocation prog (renderGhcOptions comp platform opts) + (programInvocation prog (renderGhcOptions comp platform opts)) { + progInvokePathEnv = fromNubListR (ghcOptExtraPath opts) + } renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] renderGhcOptions comp _platform@(Platform _arch os) opts diff --git a/Cabal/Distribution/Simple/Program/Run.hs b/Cabal/Distribution/Simple/Program/Run.hs index 5da7ec05612..3e54b585a9a 100644 --- a/Cabal/Distribution/Simple/Program/Run.hs +++ b/Cabal/Distribution/Simple/Program/Run.hs @@ -32,6 +32,7 @@ import Distribution.Verbosity import Distribution.Compat.Environment import qualified Data.Map as Map +import System.FilePath import System.Exit ( ExitCode(..), exitWith ) @@ -46,6 +47,8 @@ data ProgramInvocation = ProgramInvocation { progInvokePath :: FilePath, progInvokeArgs :: [String], progInvokeEnv :: [(String, Maybe String)], + -- Extra paths to add to PATH + progInvokePathEnv :: [FilePath], progInvokeCwd :: Maybe FilePath, progInvokeInput :: Maybe String, progInvokeInputEncoding :: IOEncoding, @@ -61,6 +64,7 @@ emptyProgramInvocation = progInvokePath = "", progInvokeArgs = [], progInvokeEnv = [], + progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing, progInvokeInputEncoding = IOEncodingText, @@ -91,6 +95,7 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = [], + progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing } = @@ -101,10 +106,12 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Nothing } = do - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) exitCode <- rawSystemIOWithEnv verbosity path args mcwd menv @@ -117,11 +124,13 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Just inputStr, progInvokeInputEncoding = encoding } = do - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) (_, errors, exitCode) <- rawSystemStdInOut verbosity path args mcwd menv @@ -141,6 +150,7 @@ getProgramInvocationOutput verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = minputStr, progInvokeOutputEncoding = encoding @@ -148,7 +158,8 @@ getProgramInvocationOutput verbosity let utf8 = case encoding of IOEncodingUTF8 -> True; _ -> False decode | utf8 = fromUTF8 . normaliseLineEndings | otherwise = id - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) (output, errors, exitCode) <- rawSystemStdInOut verbosity path args mcwd menv @@ -166,6 +177,18 @@ getProgramInvocationOutput verbosity IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for utf8 +getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)] +getExtraPathEnv _ [] = return [] +getExtraPathEnv env extras = do + mb_path <- case lookup "PATH" env of + Just x -> return x + Nothing -> lookupEnv "PATH" + let extra = intercalate [searchPathSeparator] extras + path' = case mb_path of + Nothing -> extra + Just path -> extra ++ searchPathSeparator : path + return [("PATH", Just path')] + -- | Return the current environment extended with the given overrides. -- getEffectiveEnvironment :: [(String, Maybe String)] diff --git a/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs b/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs index b6611724cf7..79eb824623f 100644 --- a/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs +++ b/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs @@ -40,6 +40,7 @@ data ComponentLocalBuildInfo -- @-package-id@ arguments. This is a modernized version of -- 'componentPackageDeps', which is kept around for BC purposes. componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], -- | The internal dependencies which induce a graph on the -- 'ComponentLocalBuildInfo' of this package. This does NOT -- coincide with 'componentPackageDeps' because it ALSO records @@ -62,6 +63,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } | TestComponentLocalBuildInfo { @@ -69,6 +71,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } @@ -77,6 +80,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } deriving (Generic, Read, Show) diff --git a/Cabal/Distribution/Types/LocalBuildInfo.hs b/Cabal/Distribution/Types/LocalBuildInfo.hs index 15ae66a7f83..dfbaf10e720 100644 --- a/Cabal/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/Distribution/Types/LocalBuildInfo.hs @@ -29,6 +29,7 @@ module Distribution.Types.LocalBuildInfo ( -- details. componentNameTargets', + unitIdTarget', allTargetsInBuildOrder', withAllTargetsInBuildOrder', neededTargetsInBuildOrder', @@ -39,6 +40,7 @@ module Distribution.Types.LocalBuildInfo ( -- prevent someone from accidentally defining them componentNameTargets, + unitIdTarget, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, @@ -210,6 +212,12 @@ componentNameTargets' pkg_descr lbi cname = Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis Nothing -> [] +unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo +unitIdTarget' pkg_descr lbi uid = + case Graph.lookup uid (componentGraph lbi) of + Just clbi -> Just (mkTargetInfo pkg_descr lbi clbi) + Nothing -> Nothing + -- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'. -- In the presence of Backpack there may be more than one! componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo] @@ -262,11 +270,14 @@ testCoverage lbi = exeCoverage lbi && libCoverage lbi ------------------------------------------------------------------------------- -- Stub functions to prevent someone from accidentally defining them -{-# WARNING componentNameTargets, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder "By using this function, you may be introducing a bug where you retrieve a 'Component' which does not have 'HookedBuildInfo' applied to it. See the documentation for 'HookedBuildInfo' for an explanation of the issue. If you have a 'PakcageDescription' handy (NOT from the 'LocalBuildInfo'), try using the primed version of the function, which takes it as an extra argument." #-} +{-# WARNING componentNameTargets, unitIdTarget, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder "By using this function, you may be introducing a bug where you retrieve a 'Component' which does not have 'HookedBuildInfo' applied to it. See the documentation for 'HookedBuildInfo' for an explanation of the issue. If you have a 'PakcageDescription' handy (NOT from the 'LocalBuildInfo'), try using the primed version of the function, which takes it as an extra argument." #-} componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo] componentNameTargets lbi = componentNameTargets' (localPkgDescr lbi) lbi +unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo +unitIdTarget lbi = unitIdTarget' (localPkgDescr lbi) lbi + allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo] allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi diff --git a/Cabal/tests/PackageTests/BuildToolsPath/A.hs b/Cabal/tests/PackageTests/BuildToolsPath/A.hs new file mode 100644 index 00000000000..e5e075ad70c --- /dev/null +++ b/Cabal/tests/PackageTests/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/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs b/Cabal/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs new file mode 100644 index 00000000000..09c949ab176 --- /dev/null +++ b/Cabal/tests/PackageTests/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/tests/PackageTests/BuildToolsPath/build-tools-path.cabal b/Cabal/tests/PackageTests/BuildToolsPath/build-tools-path.cabal new file mode 100644 index 00000000000..12214a34357 --- /dev/null +++ b/Cabal/tests/PackageTests/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/tests/PackageTests/BuildToolsPath/hello/Hello.hs b/Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs new file mode 100644 index 00000000000..89a5e5a026d --- /dev/null +++ b/Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs @@ -0,0 +1,6 @@ +module Main where + +import A + +main :: IO () +main = putStrLn a diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 8cee8ce5dc6..20ea7061c22 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -484,6 +484,12 @@ tests config = do runExe' "hello-world" [] >>= assertOutputContains "hello from A" + -- Test PATH-munging + tc "BuildToolsPath" $ do + cabal_build [] + runExe' "hello-world" [] + >>= assertOutputContains "1111" + -- Test that executable recompilation works -- https://github.com/haskell/cabal/issues/3294 tc "Regression/T3294" $ do