Skip to content

Commit c03caf8

Browse files
jasagredojasagredo
committed
Fix extra-prog-path propagation in the codebase.
Extra prog paths were being handled in many different ways all thorugh the codebase. This PR introduces a unified way to look at them. Aiming for traceability, the addition of extra paths is now traced via `logExtraProgramSearchPath`. All appearances of `modifyProgramSearchPath` are replaced with `appendProgramSearchPath` which traces the added paths. `progInvokePathEnv` was only being set by GHC for some paths to executables in components and only under certain circumstances. Now every `ghcInvocation` sets the extra paths directly into `pkgInvokeEnv`. In particular this fixes PATH issues when running MinGW cabal in PowerShell, as usually for other OSes the system path contains most of the expected directories.
1 parent 5b44c05 commit c03caf8

File tree

22 files changed

+267
-179
lines changed

22 files changed

+267
-179
lines changed

‎Cabal/src/Distribution/Simple/Configure.hs

+16-17
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId)
8686
import qualified Distribution.Simple.PackageIndex as PackageIndex
8787
import Distribution.Simple.PreProcess
8888
import Distribution.Simple.Program
89-
import Distribution.Simple.Program.Db (lookupProgramByName)
89+
import Distribution.Simple.Program.Db (appendProgramSearchPath, lookupProgramByName)
9090
import Distribution.Simple.Setup.Common as Setup
9191
import Distribution.Simple.Setup.Config as Setup
9292
import Distribution.Simple.Utils
@@ -462,6 +462,7 @@ configure (pkg_descr0, pbi) cfg = do
462462
(fromFlag (configUserInstall cfg))
463463
(configPackageDBs cfg)
464464

465+
programDbPre <- mkProgramDb cfg (configPrograms cfg)
465466
-- comp: the compiler we're building with
466467
-- compPlatform: the platform we're building for
467468
-- programDb: location and args of all programs we're
@@ -474,7 +475,7 @@ configure (pkg_descr0, pbi) cfg = do
474475
(flagToMaybe (configHcFlavor cfg))
475476
(flagToMaybe (configHcPath cfg))
476477
(flagToMaybe (configHcPkg cfg))
477-
(mkProgramDb cfg (configPrograms cfg))
478+
programDbPre
478479
(lessVerbose verbosity)
479480

480481
-- The InstalledPackageIndex of all installed packages
@@ -1008,19 +1009,18 @@ configure (pkg_descr0, pbi) cfg = do
10081009
mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId
10091010
mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps]
10101011

1011-
mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
1012-
mkProgramDb cfg initialProgramDb = programDb
1012+
-- | Adds the extra program paths from the flags provided to @configure@ as
1013+
-- well as specified locations for certain known programs and their default
1014+
-- arguments.
1015+
mkProgramDb :: ConfigFlags -> ProgramDb -> IO ProgramDb
1016+
mkProgramDb cfg initialProgramDb = do
1017+
programDb <- appendProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath initialProgramDb
1018+
pure
1019+
. userSpecifyArgss (configProgramArgs cfg)
1020+
. userSpecifyPaths (configProgramPaths cfg)
1021+
$ programDb
10131022
where
1014-
programDb =
1015-
userSpecifyArgss (configProgramArgs cfg)
1016-
. userSpecifyPaths (configProgramPaths cfg)
1017-
. setProgramSearchPath searchpath
1018-
$ initialProgramDb
1019-
searchpath =
1020-
getProgramSearchPath initialProgramDb
1021-
++ map
1022-
ProgramSearchPathDir
1023-
(fromNubList $ configProgramPathExtra cfg)
1023+
searchpath = fromNubList $ configProgramPathExtra cfg
10241024

10251025
-- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path
10261026
-- so that we can override the system path. However, in a v2-build, at this point, the "system" path
@@ -2083,15 +2083,14 @@ ccLdOptionsBuildInfo cflags ldflags ldflags_static =
20832083
configCompilerAuxEx
20842084
:: ConfigFlags
20852085
-> IO (Compiler, Platform, ProgramDb)
2086-
configCompilerAuxEx cfg =
2086+
configCompilerAuxEx cfg = do
2087+
programDb <- mkProgramDb cfg defaultProgramDb
20872088
configCompilerEx
20882089
(flagToMaybe $ configHcFlavor cfg)
20892090
(flagToMaybe $ configHcPath cfg)
20902091
(flagToMaybe $ configHcPkg cfg)
20912092
programDb
20922093
(fromFlag (configVerbosity cfg))
2093-
where
2094-
programDb = mkProgramDb cfg defaultProgramDb
20952094

20962095
configCompilerEx
20972096
:: Maybe CompilerFlavor

‎Cabal/src/Distribution/Simple/ConfigureScript.hs

+1-4
Original file line numberDiff line numberDiff line change
@@ -169,10 +169,7 @@ runConfigureScript verbosity flags lbi = do
169169
maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]
170170
args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag
171171
shProg = simpleProgram "sh"
172-
progDb =
173-
modifyProgramSearchPath
174-
(\p -> map ProgramSearchPathDir extraPath ++ p)
175-
emptyProgramDb
172+
progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb
176173
shConfiguredProg <-
177174
lookupProgram shProg
178175
`fmap` configureProgram verbosity shProg progDb

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

+44-42
Original file line numberDiff line numberDiff line change
@@ -697,10 +697,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
697697
| otherwise = error "libAbiHash: Can't find an enabled library way"
698698

699699
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
700+
700701
hash <-
701702
getProgramInvocationOutput
702703
verbosity
703-
(ghcInvocation ghcProg comp platform ghcArgs)
704+
=<< ghcInvocation verbosity ghcProg comp platform ghcArgs
705+
704706
return (takeWhile (not . isSpace) hash)
705707

706708
componentCcGhcOptions
@@ -853,47 +855,47 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
853855
whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
854856
whenShared $
855857
if
856-
-- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
857-
-- See ghc issue #15837 and Cabal PR #5855.
858-
| specVersion pkg < CabalSpecV3_0 -> do
859-
sequence_
860-
[ installShared
861-
builtDir
862-
dynlibTargetDir
863-
(mkGenericSharedLibName platform compiler_id (l ++ f))
864-
| l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
865-
, f <- "" : extraDynLibFlavours (libBuildInfo lib)
866-
]
867-
| otherwise -> do
868-
sequence_
869-
[ installShared
870-
builtDir
871-
dynlibTargetDir
872-
( mkGenericSharedLibName
873-
platform
874-
compiler_id
875-
(getHSLibraryName uid ++ f)
876-
)
877-
| f <- "" : extraDynLibFlavours (libBuildInfo lib)
878-
]
879-
sequence_
880-
[ do
881-
files <- getDirectoryContents builtDir
882-
let l' =
883-
mkGenericSharedBundledLibName
884-
platform
885-
compiler_id
886-
l
887-
forM_ files $ \file ->
888-
when (l' `isPrefixOf` file) $ do
889-
isFile <- doesFileExist (builtDir </> file)
890-
when isFile $ do
891-
installShared
892-
builtDir
893-
dynlibTargetDir
894-
file
895-
| l <- extraBundledLibs (libBuildInfo lib)
896-
]
858+
-- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
859+
-- See ghc issue #15837 and Cabal PR #5855.
860+
| specVersion pkg < CabalSpecV3_0 -> do
861+
sequence_
862+
[ installShared
863+
builtDir
864+
dynlibTargetDir
865+
(mkGenericSharedLibName platform compiler_id (l ++ f))
866+
| l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
867+
, f <- "" : extraDynLibFlavours (libBuildInfo lib)
868+
]
869+
| otherwise -> do
870+
sequence_
871+
[ installShared
872+
builtDir
873+
dynlibTargetDir
874+
( mkGenericSharedLibName
875+
platform
876+
compiler_id
877+
(getHSLibraryName uid ++ f)
878+
)
879+
| f <- "" : extraDynLibFlavours (libBuildInfo lib)
880+
]
881+
sequence_
882+
[ do
883+
files <- getDirectoryContents builtDir
884+
let l' =
885+
mkGenericSharedBundledLibName
886+
platform
887+
compiler_id
888+
l
889+
forM_ files $ \file ->
890+
when (l' `isPrefixOf` file) $ do
891+
isFile <- doesFileExist (builtDir </> file)
892+
when isFile $ do
893+
installShared
894+
builtDir
895+
dynlibTargetDir
896+
file
897+
| l <- extraBundledLibs (libBuildInfo lib)
898+
]
897899
where
898900
builtDir = componentBuildDir lbi clbi
899901

‎Cabal/src/Distribution/Simple/GHCJS.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1769,7 +1769,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
17691769
hash <-
17701770
getProgramInvocationOutput
17711771
verbosity
1772-
(ghcInvocation ghcjsProg comp platform ghcArgs)
1772+
=<< ghcInvocation verbosity ghcjsProg comp platform ghcArgs
17731773
return (takeWhile (not . isSpace) hash)
17741774

17751775
componentGhcOptions

‎Cabal/src/Distribution/Simple/Program/Db.hs

+13
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ module Distribution.Simple.Program.Db
3434
-- ** Query and manipulate the program db
3535
, addKnownProgram
3636
, addKnownPrograms
37+
, appendProgramSearchPath
3738
, lookupKnownProgram
3839
, knownPrograms
3940
, getProgramSearchPath
@@ -221,6 +222,18 @@ modifyProgramSearchPath
221222
modifyProgramSearchPath f db =
222223
setProgramSearchPath (f $ getProgramSearchPath db) db
223224

225+
-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'
226+
-- by appending the provided extra paths. Also logs the added paths
227+
-- in info verbosity.
228+
appendProgramSearchPath
229+
:: Verbosity
230+
-> [FilePath]
231+
-> ProgramDb
232+
-> IO ProgramDb
233+
appendProgramSearchPath verbosity extraPaths db = do
234+
logExtraProgramSearchPath verbosity extraPaths
235+
pure $ modifyProgramSearchPath (map ProgramSearchPathDir extraPaths ++) db
236+
224237
-- | User-specify this path. Basically override any path information
225238
-- for this program in the configuration. If it's not a known
226239
-- program ignore it.

‎Cabal/src/Distribution/Simple/Program/Find.hs

+38
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,9 @@ module Distribution.Simple.Program.Find
3232
, defaultProgramSearchPath
3333
, findProgramOnSearchPath
3434
, programSearchPathAsPATHVar
35+
, logExtraProgramSearchPath
3536
, getSystemSearchPath
37+
, getExtraPathEnv
3638
) where
3739

3840
import Distribution.Compat.Prelude
@@ -69,6 +71,14 @@ import qualified System.Win32 as Win32
6971
-- dir to search after the usual ones.
7072
--
7173
-- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
74+
--
75+
-- We also use this path to set the environment when running child processes.
76+
--
77+
-- The @ProgramDb@ is created with a @ProgramSearchPath@ to which we
78+
-- @appendProgramSearchPath@ to add the ones that come from cli flags and from
79+
-- configurations. Then each of the programs that are configured in the db
80+
-- inherits the same path as part of @configureProgram@. It is only GHC that get
81+
-- some more paths added
7282
type ProgramSearchPath = [ProgramSearchPathEntry]
7383

7484
data ProgramSearchPathEntry
@@ -84,6 +94,15 @@ instance Structured ProgramSearchPathEntry
8494
defaultProgramSearchPath :: ProgramSearchPath
8595
defaultProgramSearchPath = [ProgramSearchPathDefault]
8696

97+
logExtraProgramSearchPath
98+
:: Verbosity
99+
-> [FilePath]
100+
-> IO ()
101+
logExtraProgramSearchPath verbosity extraPaths =
102+
info verbosity . unlines $
103+
"Including the following directories in PATH:"
104+
: map ("- " ++) extraPaths
105+
87106
findProgramOnSearchPath
88107
:: Verbosity
89108
-> ProgramSearchPath
@@ -154,6 +173,25 @@ findProgramOnSearchPath verbosity searchpath prog = do
154173
Just _ -> return a
155174
Nothing -> firstJustM mas
156175

176+
-- | Adds some paths to the "PATH" entry in the key-value environment provided
177+
-- or if there is none, looks up @$PATH@ in the real environment.
178+
getExtraPathEnv
179+
:: Verbosity
180+
-> [(String, Maybe String)]
181+
-> [FilePath]
182+
-> IO [(String, Maybe String)]
183+
getExtraPathEnv _ _ [] = return []
184+
getExtraPathEnv verbosity env extras = do
185+
mb_path <- case lookup "PATH" env of
186+
Just x -> return x
187+
Nothing -> lookupEnv "PATH"
188+
logExtraProgramSearchPath verbosity extras
189+
let extra = intercalate [searchPathSeparator] extras
190+
path' = case mb_path of
191+
Nothing -> extra
192+
Just path -> extra ++ searchPathSeparator : path
193+
return [("PATH", Just path')]
194+
157195
-- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
158196
-- Note that this is close but not perfect because on Windows the search
159197
-- algorithm looks at more than just the @%PATH%@.

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

+14-9
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Distribution.Pretty
2828
import Distribution.Simple.Compiler
2929
import Distribution.Simple.Flag
3030
import Distribution.Simple.GHC.ImplInfo
31+
import Distribution.Simple.Program.Find (getExtraPathEnv)
3132
import Distribution.Simple.Program.Run
3233
import Distribution.Simple.Program.Types
3334
import Distribution.System
@@ -554,8 +555,6 @@ data GhcOptions = GhcOptions
554555
, ghcOptExtraPath :: NubListR FilePath
555556
-- ^ Put the extra folders in the PATH environment variable we invoke
556557
-- GHC with
557-
-- | Put the extra folders in the PATH environment variable we invoke
558-
-- GHC with
559558
, ghcOptCabal :: Flag Bool
560559
-- ^ Let GHC know that it is Cabal that's calling it.
561560
-- Modifies some of the GHC error messages.
@@ -616,18 +615,24 @@ runGHC
616615
-> GhcOptions
617616
-> IO ()
618617
runGHC verbosity ghcProg comp platform opts = do
619-
runProgramInvocation verbosity (ghcInvocation ghcProg comp platform opts)
618+
runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform opts
620619

621620
ghcInvocation
622-
:: ConfiguredProgram
621+
:: Verbosity
622+
-> ConfiguredProgram
623623
-> Compiler
624624
-> Platform
625625
-> GhcOptions
626-
-> ProgramInvocation
627-
ghcInvocation prog comp platform opts =
628-
(programInvocation prog (renderGhcOptions comp platform opts))
629-
{ progInvokePathEnv = fromNubListR (ghcOptExtraPath opts)
630-
}
626+
-> IO ProgramInvocation
627+
ghcInvocation verbosity ghcProg comp platform opts = do
628+
-- NOTE: GHC is the only program whose path we modify with more values than
629+
-- the standard @extra-prog-path@, namely the folders of the executables in
630+
-- the components, see @componentGhcOptions@.
631+
let envOverrides = programOverrideEnv ghcProg
632+
extraPath <- getExtraPathEnv verbosity envOverrides (fromNubListR (ghcOptExtraPath opts))
633+
let ghcProg' = ghcProg{programOverrideEnv = envOverrides ++ extraPath}
634+
635+
pure $ programInvocation ghcProg' (renderGhcOptions comp platform opts)
631636

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

0 commit comments

Comments
 (0)