Skip to content

Commit 6764810

Browse files
ezyangezyang
committed
Fix #1541, by adding internal build-tools to PATH.
Signed-off-by: Edward Z. Yang <[email protected]>
1 parent 929679c commit 6764810

File tree

15 files changed

+140
-16
lines changed

15 files changed

+140
-16
lines changed

‎Cabal/Cabal.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,10 @@ extra-source-files:
9898
tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs
9999
tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal
100100
tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs
101+
tests/PackageTests/BuildToolsPath/A.hs
102+
tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs
103+
tests/PackageTests/BuildToolsPath/build-tools-path.cabal
104+
tests/PackageTests/BuildToolsPath/hello/Hello.hs
101105
tests/PackageTests/BuildableField/BuildableField.cabal
102106
tests/PackageTests/BuildableField/Main.hs
103107
tests/PackageTests/CMain/Bar.hs

‎Cabal/Distribution/Simple/Build.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -425,6 +425,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
425425
libClbi = LibComponentLocalBuildInfo
426426
{ componentPackageDeps = componentPackageDeps clbi
427427
, componentInternalDeps = componentInternalDeps clbi
428+
, componentExeDeps = componentExeDeps clbi
428429
, componentLocalName = CSubLibName (testName test)
429430
, componentIsPublic = False
430431
, componentIncludes = componentIncludes clbi
@@ -465,6 +466,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
465466
-- (doesn't clobber something) we won't run into trouble
466467
componentUnitId = mkUnitId (stubName test),
467468
componentInternalDeps = [componentUnitId clbi],
469+
componentExeDeps = [],
468470
componentLocalName = CExeName (stubName test),
469471
componentPackageDeps = deps,
470472
componentIncludes = zip (map fst deps) (repeat defaultRenaming)
@@ -488,6 +490,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
488490
componentUnitId = componentUnitId clbi,
489491
componentLocalName = CExeName (benchmarkName bm),
490492
componentInternalDeps = componentInternalDeps clbi,
493+
componentExeDeps = componentExeDeps clbi,
491494
componentPackageDeps = componentPackageDeps clbi,
492495
componentIncludes = componentIncludes clbi
493496
}

‎Cabal/Distribution/Simple/Configure.hs‎

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1777,14 +1777,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
17771777
foldM go [] graph
17781778
where
17791779
go z (component, dep_cnames) = do
1780-
-- NB: We want to preserve cdeps because it contains extra
1781-
-- information like build-tools ordering
1782-
let dep_uids = [ componentUnitId dep_clbi
1783-
| cname <- dep_cnames
1784-
-- Being in z relies on topsort!
1785-
, dep_clbi <- z
1786-
, componentLocalName dep_clbi == cname ]
1787-
clbi <- componentLocalBuildInfo z component dep_uids
1780+
clbi <- componentLocalBuildInfo z component dep_cnames
17881781
return (clbi:z)
17891782

17901783
-- The allPkgDeps contains all the package deps for the whole package
@@ -1793,8 +1786,19 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
17931786
-- needs. Note, this only works because we cannot yet depend on two
17941787
-- versions of the same package.
17951788
componentLocalBuildInfo :: [ComponentLocalBuildInfo]
1796-
-> Component -> [UnitId] -> IO ComponentLocalBuildInfo
1797-
componentLocalBuildInfo internalComps component dep_uids =
1789+
-> Component -> [ComponentName] -> IO ComponentLocalBuildInfo
1790+
componentLocalBuildInfo internalComps component dep_cnames =
1791+
-- NB: We want to preserve cdeps because it contains extra
1792+
-- information like build-tools ordering
1793+
let dep_uids = [ componentUnitId dep_clbi
1794+
| cname <- dep_cnames
1795+
, dep_clbi <- internalComps
1796+
, componentLocalName dep_clbi == cname ]
1797+
dep_exes = [ componentUnitId dep_clbi
1798+
| cname@(CExeName _) <- dep_cnames
1799+
, dep_clbi <- internalComps
1800+
, componentLocalName dep_clbi == cname ]
1801+
in
17981802
-- (putStrLn $ "configuring " ++ display (componentName component)) >>
17991803
case component of
18001804
CLib lib -> do
@@ -1811,6 +1815,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
18111815
return LibComponentLocalBuildInfo {
18121816
componentPackageDeps = cpds,
18131817
componentInternalDeps = dep_uids,
1818+
componentExeDeps = dep_exes,
18141819
componentUnitId = uid,
18151820
componentLocalName = componentName component,
18161821
componentIsPublic = libName lib == Nothing,
@@ -1823,6 +1828,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
18231828
return ExeComponentLocalBuildInfo {
18241829
componentUnitId = uid,
18251830
componentInternalDeps = dep_uids,
1831+
componentExeDeps = dep_exes,
18261832
componentLocalName = componentName component,
18271833
componentPackageDeps = cpds,
18281834
componentIncludes = includes
@@ -1831,6 +1837,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
18311837
return TestComponentLocalBuildInfo {
18321838
componentUnitId = uid,
18331839
componentInternalDeps = dep_uids,
1840+
componentExeDeps = dep_exes,
18341841
componentLocalName = componentName component,
18351842
componentPackageDeps = cpds,
18361843
componentIncludes = includes
@@ -1839,6 +1846,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_
18391846
return BenchComponentLocalBuildInfo {
18401847
componentUnitId = uid,
18411848
componentInternalDeps = dep_uids,
1849+
componentExeDeps = dep_exes,
18421850
componentLocalName = componentName component,
18431851
componentPackageDeps = cpds,
18441852
componentIncludes = includes

‎Cabal/Distribution/Simple/GHC/Internal.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,8 @@ import Distribution.Simple.Setup
4646
import qualified Distribution.ModuleName as ModuleName
4747
import Distribution.Simple.Program
4848
import Distribution.Simple.LocalBuildInfo
49+
import Distribution.Types.LocalBuildInfo
50+
import Distribution.Types.TargetInfo
4951
import Distribution.Simple.Utils
5052
import Distribution.Simple.BuildPaths
5153
import Distribution.System
@@ -304,6 +306,7 @@ componentGhcOptions verbosity lbi bi clbi odir =
304306
ghcOptOptimisation = toGhcOptimisation (withOptimization lbi),
305307
ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi),
306308
ghcOptExtra = toNubListR $ hcOptions GHC bi,
309+
ghcOptExtraPath = toNubListR $ exe_paths,
307310
ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
308311
-- Unsupported extensions have already been checked by configure
309312
ghcOptExtensions = toNubListR $ usedExtensions bi,
@@ -320,6 +323,11 @@ componentGhcOptions verbosity lbi bi clbi odir =
320323
toGhcDebugInfo NormalDebugInfo = toFlag True
321324
toGhcDebugInfo MaximalDebugInfo = toFlag True
322325

326+
exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt)
327+
| uid <- componentExeDeps clbi
328+
-- TODO: Ugh, localPkgDescr
329+
, Just exe_tgt <- [unitIdTarget' (localPkgDescr lbi) lbi uid] ]
330+
323331
-- | Strip out flags that are not supported in ghci
324332
filterGhciFlags :: [String] -> [String]
325333
filterGhciFlags = filter supported

‎Cabal/Distribution/Simple/Program/GHC.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -210,6 +210,10 @@ data GhcOptions = GhcOptions {
210210
-- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
211211
ghcOptVerbosity :: Flag Verbosity,
212212

213+
-- | Put the extra folders in the PATH environment variable we invoke
214+
-- GHC with
215+
ghcOptExtraPath :: NubListR FilePath,
216+
213217
-- | Let GHC know that it is Cabal that's calling it.
214218
-- Modifies some of the GHC error messages.
215219
ghcOptCabal :: Flag Bool
@@ -251,7 +255,9 @@ runGHC verbosity ghcProg comp platform opts = do
251255
ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions
252256
-> ProgramInvocation
253257
ghcInvocation prog comp platform opts =
254-
programInvocation prog (renderGhcOptions comp platform opts)
258+
(programInvocation prog (renderGhcOptions comp platform opts)) {
259+
progInvokePathEnv = fromNubListR (ghcOptExtraPath opts)
260+
}
255261

256262
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
257263
renderGhcOptions comp _platform@(Platform _arch os) opts

‎Cabal/Distribution/Simple/Program/Run.hs‎

Lines changed: 26 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import Distribution.Verbosity
3232
import Distribution.Compat.Environment
3333

3434
import qualified Data.Map as Map
35+
import System.FilePath
3536
import System.Exit
3637
( ExitCode(..), exitWith )
3738

@@ -46,6 +47,8 @@ data ProgramInvocation = ProgramInvocation {
4647
progInvokePath :: FilePath,
4748
progInvokeArgs :: [String],
4849
progInvokeEnv :: [(String, Maybe String)],
50+
-- Extra paths to add to PATH
51+
progInvokePathEnv :: [FilePath],
4952
progInvokeCwd :: Maybe FilePath,
5053
progInvokeInput :: Maybe String,
5154
progInvokeInputEncoding :: IOEncoding,
@@ -61,6 +64,7 @@ emptyProgramInvocation =
6164
progInvokePath = "",
6265
progInvokeArgs = [],
6366
progInvokeEnv = [],
67+
progInvokePathEnv = [],
6468
progInvokeCwd = Nothing,
6569
progInvokeInput = Nothing,
6670
progInvokeInputEncoding = IOEncodingText,
@@ -91,6 +95,7 @@ runProgramInvocation verbosity
9195
progInvokePath = path,
9296
progInvokeArgs = args,
9397
progInvokeEnv = [],
98+
progInvokePathEnv = [],
9499
progInvokeCwd = Nothing,
95100
progInvokeInput = Nothing
96101
} =
@@ -101,10 +106,12 @@ runProgramInvocation verbosity
101106
progInvokePath = path,
102107
progInvokeArgs = args,
103108
progInvokeEnv = envOverrides,
109+
progInvokePathEnv = extraPath,
104110
progInvokeCwd = mcwd,
105111
progInvokeInput = Nothing
106112
} = do
107-
menv <- getEffectiveEnvironment envOverrides
113+
pathOverride <- getExtraPathEnv envOverrides extraPath
114+
menv <- getEffectiveEnvironment (envOverrides ++ pathOverride)
108115
exitCode <- rawSystemIOWithEnv verbosity
109116
path args
110117
mcwd menv
@@ -117,11 +124,13 @@ runProgramInvocation verbosity
117124
progInvokePath = path,
118125
progInvokeArgs = args,
119126
progInvokeEnv = envOverrides,
127+
progInvokePathEnv = extraPath,
120128
progInvokeCwd = mcwd,
121129
progInvokeInput = Just inputStr,
122130
progInvokeInputEncoding = encoding
123131
} = do
124-
menv <- getEffectiveEnvironment envOverrides
132+
pathOverride <- getExtraPathEnv envOverrides extraPath
133+
menv <- getEffectiveEnvironment (envOverrides ++ pathOverride)
125134
(_, errors, exitCode) <- rawSystemStdInOut verbosity
126135
path args
127136
mcwd menv
@@ -141,14 +150,16 @@ getProgramInvocationOutput verbosity
141150
progInvokePath = path,
142151
progInvokeArgs = args,
143152
progInvokeEnv = envOverrides,
153+
progInvokePathEnv = extraPath,
144154
progInvokeCwd = mcwd,
145155
progInvokeInput = minputStr,
146156
progInvokeOutputEncoding = encoding
147157
} = do
148158
let utf8 = case encoding of IOEncodingUTF8 -> True; _ -> False
149159
decode | utf8 = fromUTF8 . normaliseLineEndings
150160
| otherwise = id
151-
menv <- getEffectiveEnvironment envOverrides
161+
pathOverride <- getExtraPathEnv envOverrides extraPath
162+
menv <- getEffectiveEnvironment (envOverrides ++ pathOverride)
152163
(output, errors, exitCode) <- rawSystemStdInOut verbosity
153164
path args
154165
mcwd menv
@@ -166,6 +177,18 @@ getProgramInvocationOutput verbosity
166177
IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for utf8
167178

168179

180+
getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)]
181+
getExtraPathEnv _ [] = return []
182+
getExtraPathEnv env extras = do
183+
mb_path <- case lookup "PATH" env of
184+
Just x -> return x
185+
Nothing -> lookupEnv "PATH"
186+
let extra = intercalate [searchPathSeparator] extras
187+
path' = case mb_path of
188+
Nothing -> extra
189+
Just path -> extra ++ searchPathSeparator : path
190+
return [("PATH", Just path')]
191+
169192
-- | Return the current environment extended with the given overrides.
170193
--
171194
getEffectiveEnvironment :: [(String, Maybe String)]

‎Cabal/Distribution/Types/ComponentLocalBuildInfo.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ data ComponentLocalBuildInfo
4040
-- @-package-id@ arguments. This is a modernized version of
4141
-- 'componentPackageDeps', which is kept around for BC purposes.
4242
componentIncludes :: [(UnitId, ModuleRenaming)],
43+
componentExeDeps :: [UnitId],
4344
-- | The internal dependencies which induce a graph on the
4445
-- 'ComponentLocalBuildInfo' of this package. This does NOT
4546
-- coincide with 'componentPackageDeps' because it ALSO records
@@ -62,13 +63,15 @@ data ComponentLocalBuildInfo
6263
componentUnitId :: UnitId,
6364
componentPackageDeps :: [(UnitId, PackageId)],
6465
componentIncludes :: [(UnitId, ModuleRenaming)],
66+
componentExeDeps :: [UnitId],
6567
componentInternalDeps :: [UnitId]
6668
}
6769
| TestComponentLocalBuildInfo {
6870
componentLocalName :: ComponentName,
6971
componentUnitId :: UnitId,
7072
componentPackageDeps :: [(UnitId, PackageId)],
7173
componentIncludes :: [(UnitId, ModuleRenaming)],
74+
componentExeDeps :: [UnitId],
7275
componentInternalDeps :: [UnitId]
7376

7477
}
@@ -77,6 +80,7 @@ data ComponentLocalBuildInfo
7780
componentUnitId :: UnitId,
7881
componentPackageDeps :: [(UnitId, PackageId)],
7982
componentIncludes :: [(UnitId, ModuleRenaming)],
83+
componentExeDeps :: [UnitId],
8084
componentInternalDeps :: [UnitId]
8185
}
8286
deriving (Generic, Read, Show)

‎Cabal/Distribution/Types/LocalBuildInfo.hs‎

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ module Distribution.Types.LocalBuildInfo (
2929
-- details.
3030

3131
componentNameTargets',
32+
unitIdTarget',
3233
allTargetsInBuildOrder',
3334
withAllTargetsInBuildOrder',
3435
neededTargetsInBuildOrder',
@@ -39,6 +40,7 @@ module Distribution.Types.LocalBuildInfo (
3940
-- prevent someone from accidentally defining them
4041

4142
componentNameTargets,
43+
unitIdTarget,
4244
allTargetsInBuildOrder,
4345
withAllTargetsInBuildOrder,
4446
neededTargetsInBuildOrder,
@@ -210,6 +212,12 @@ componentNameTargets' pkg_descr lbi cname =
210212
Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis
211213
Nothing -> []
212214

215+
unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
216+
unitIdTarget' pkg_descr lbi uid =
217+
case Graph.lookup uid (componentGraph lbi) of
218+
Just clbi -> Just (mkTargetInfo pkg_descr lbi clbi)
219+
Nothing -> Nothing
220+
213221
-- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'.
214222
-- In the presence of Backpack there may be more than one!
215223
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
@@ -262,11 +270,14 @@ testCoverage lbi = exeCoverage lbi && libCoverage lbi
262270
-------------------------------------------------------------------------------
263271
-- Stub functions to prevent someone from accidentally defining them
264272

265-
{-# 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." #-}
273+
{-# 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." #-}
266274

267275
componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
268276
componentNameTargets lbi = componentNameTargets' (localPkgDescr lbi) lbi
269277

278+
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
279+
unitIdTarget lbi = unitIdTarget' (localPkgDescr lbi) lbi
280+
270281
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
271282
allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi
272283

‎Cabal/changelog‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -70,6 +70,9 @@
7070
the component to be configured. The semantics of this mode
7171
of operation are described in
7272
<https://github.com/ghc-proposals/ghc-proposals/pull/4>
73+
* Internal 'build-tools' dependencies are now added to PATH
74+
upon invocation of GHC, so that they can be conveniently
75+
used via `-pgmF`. (#1541)
7376

7477
1.24.0.0 Ryan Thomas <[email protected]> March 2016
7578
* Support GHC 8.

‎Cabal/doc/developing-packages.markdown‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1416,7 +1416,8 @@ for these fields.
14161416
build this package, e.g. `c2hs >= 0.15, cpphs`. If no version
14171417
constraint is specified, any version is assumed to be acceptable.
14181418
`build-tools` can refer to locally defined executables, in which
1419-
case Cabal will make sure that executable is built first.
1419+
case Cabal will make sure that executable is built first and
1420+
add it to the PATH upon invocations to the compiler.
14201421

14211422
`buildable:` _boolean_ (default: `True`)
14221423
: Is the component buildable? Like some of the other fields below,

0 commit comments

Comments
 (0)