Find build-tool installed programs before programs in path

alt-romes · alt-romes · commit 443c8906581e · 2024-03-01T19:24:38.000Z
We must consider the path to the installed build-tool before the path to existing versions of the build tool in paths such as `extra-prog-path` or in the system path. This was previously fixed by haskell#8972 but undone by haskell#9527. This also renames `appendProgramSearchPath` to `prependProgramSearchPath` to describe correctly what that function does. Fixes haskell#9756
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
@@ -85,7 +85,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.PreProcess
 import Distribution.Simple.Program
-import Distribution.Simple.Program.Db (appendProgramSearchPath, lookupProgramByName)
+import Distribution.Simple.Program.Db (lookupProgramByName, modifyProgramSearchPath, prependProgramSearchPath)
 import Distribution.Simple.Setup.Common as Setup
 import Distribution.Simple.Setup.Config as Setup
 import Distribution.Simple.Utils
@@ -1236,13 +1236,15 @@ mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponen
 -- arguments.
 mkProgramDb :: ConfigFlags -> ProgramDb -> IO ProgramDb
 mkProgramDb cfg initialProgramDb = do
-  programDb <- appendProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath initialProgramDb
+  programDb <-
+    modifyProgramSearchPath (getProgramSearchPath initialProgramDb ++) -- We need to have the paths to programs installed by build-tool-depends before all other paths
+      <$> prependProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath initialProgramDb
   pure
     . userSpecifyArgss (configProgramArgs cfg)
     . userSpecifyPaths (configProgramPaths cfg)
     $ programDb
   where
-    searchpath = fromNubList $ configProgramPathExtra cfg
+    searchpath = fromNubList (configProgramPathExtra cfg)
 
 -- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path
 -- so that we can override the system path. However, in a v2-build, at this point, the "system" path
diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs
@@ -169,7 +169,7 @@ runConfigureScript verbosity flags lbi = do
       maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]
       args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag
       shProg = simpleProgram "sh"
-  progDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb
+  progDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb
   shConfiguredProg <-
     lookupProgram shProg
       `fmap` configureProgram verbosity shProg progDb
diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs
@@ -34,7 +34,7 @@ module Distribution.Simple.Program.Db
     -- ** Query and manipulate the program db
   , addKnownProgram
   , addKnownPrograms
-  , appendProgramSearchPath
+  , prependProgramSearchPath
   , lookupKnownProgram
   , knownPrograms
   , getProgramSearchPath
@@ -223,14 +223,14 @@ modifyProgramSearchPath f db =
   setProgramSearchPath (f $ getProgramSearchPath db) db
 
 -- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'
--- by appending the provided extra paths. Also logs the added paths
+-- by prepending the provided extra paths. Also logs the added paths
 -- in info verbosity.
-appendProgramSearchPath
+prependProgramSearchPath
   :: Verbosity
   -> [FilePath]
   -> ProgramDb
   -> IO ProgramDb
-appendProgramSearchPath verbosity extraPaths db =
+prependProgramSearchPath verbosity extraPaths db =
   if not $ null extraPaths
     then do
       logExtraProgramSearchPath verbosity extraPaths
diff --git a/Cabal/src/Distribution/Simple/Program/Types.hs b/Cabal/src/Distribution/Simple/Program/Types.hs
@@ -97,7 +97,7 @@ type ProgArg = String
 -- We also use this path to set the environment when running child processes.
 --
 -- The @ProgramDb@ is created with a @ProgramSearchPath@ to which we
--- @appendProgramSearchPath@ to add the ones that come from cli flags and from
+-- @prependProgramSearchPath@ to add the ones that come from cli flags and from
 -- configurations. Then each of the programs that are configured in the db
 -- inherits the same path as part of @configureProgram@.
 type ProgramSearchPath = [ProgramSearchPathEntry]
diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs
@@ -76,8 +76,8 @@ import Distribution.Simple.Program
   , simpleProgram
   )
 import Distribution.Simple.Program.Db
-  ( appendProgramSearchPath
-  , configuredPrograms
+  ( configuredPrograms
+  , prependProgramSearchPath
   , requireProgram
   )
 import Distribution.Simple.Program.Run
@@ -168,7 +168,7 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
   let extraPaths = pathAdditions baseCtx buildCtx
 
   programDb <-
-    appendProgramSearchPath
+    prependProgramSearchPath
       verbosity
       extraPaths
       . pkgConfigCompilerProgs
diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -154,8 +154,8 @@ import Distribution.Simple.GHC
 import qualified Distribution.Simple.InstallDirs as InstallDirs
 import qualified Distribution.Simple.PackageIndex as PI
 import Distribution.Simple.Program.Db
-  ( appendProgramSearchPath
-  , defaultProgramDb
+  ( defaultProgramDb
+  , prependProgramSearchPath
   , userSpecifyArgss
   , userSpecifyPaths
   )
@@ -426,7 +426,7 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project
     hcPath = flagToMaybe projectConfigHcPath
     hcPkg = flagToMaybe projectConfigHcPkg
 
-  configProgDb <- appendProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb
+  configProgDb <- prependProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb
   let
     -- ProgramDb with directly user specified paths
     preProgDb =
diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs
@@ -46,10 +46,10 @@ import Distribution.Simple.Program
 import Distribution.Simple.Program.Db
   ( ProgramDb
   , addKnownPrograms
-  , appendProgramSearchPath
   , configureAllKnownPrograms
   , emptyProgramDb
   , lookupProgram
+  , prependProgramSearchPath
   , requireProgram
   )
 import Distribution.Simple.Program.Run
@@ -408,7 +408,7 @@ configureTransport verbosity extraPath (Just name) =
 
   case find (\(name', _, _, _) -> name' == name) supportedTransports of
     Just (_, mprog, _tls, mkTrans) -> do
-      baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb
+      baseProgDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb
       progdb <- case mprog of
         Nothing -> return emptyProgramDb
         Just prog -> snd <$> requireProgram verbosity prog baseProgDb
@@ -424,7 +424,7 @@ configureTransport verbosity extraPath Nothing = do
 
   -- for all the transports except plain-http we need to try and find
   -- their external executable
-  baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb
+  baseProgDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb
   progdb <-
     configureAllKnownPrograms verbosity $
       addKnownPrograms
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -471,7 +471,7 @@ configureCompiler
       )
       $ do
         liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
-        progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb
+        progdb <- liftIO $ prependProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb
         let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb
         result@(_, _, progdb'') <-
           liftIO $
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -89,7 +89,7 @@ import Distribution.Simple.Program
   , runDbProgram
   )
 import Distribution.Simple.Program.Db
-  ( appendProgramSearchPath
+  ( prependProgramSearchPath
   )
 import Distribution.Simple.Program.Find
   ( programSearchPathAsPATHVar
@@ -539,7 +539,7 @@ invoke verbosity path args options = do
     Nothing -> return ()
     Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle
 
-  progDb <- appendProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options)
+  progDb <- prependProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options)
 
   searchpath <-
     programSearchPathAsPATHVar $ getProgramSearchPath progDb
diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
@@ -62,7 +62,7 @@ import Distribution.Simple.Program
   , simpleProgram
   )
 import Distribution.Simple.Program.Db
-  ( appendProgramSearchPath
+  ( prependProgramSearchPath
   )
 import Distribution.Types.SourceRepo
   ( KnownRepoType (..)
@@ -206,7 +206,7 @@ configureVCS
   -> VCS Program
   -> IO (VCS ConfiguredProgram)
 configureVCS verbosity progPaths vcs@VCS{vcsProgram = prog} = do
-  progPath <- appendProgramSearchPath verbosity progPaths emptyProgramDb
+  progPath <- prependProgramSearchPath verbosity progPaths emptyProgramDb
   asVcsConfigured <$> requireProgram verbosity prog progPath
   where
     asVcsConfigured (prog', _) = vcs{vcsProgram = prog'}
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/OK.hs b/cabal-testsuite/PackageTests/Regression/T9756/OK.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+module OK where
+
+import Data.List
+import System.Process
+import Language.Haskell.TH
+
+$(do
+    out <- runIO $ readProcess "mybuilder" [] ""
+    if "0.2.0.0" `isInfixOf` out then
+       [d| x = () |]
+    else
+      error ("Expecting Version 0.2.0.0, but got: " ++ out)
+ )
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/cabal-bug-build-tool.cabal b/cabal-testsuite/PackageTests/Regression/T9756/cabal-bug-build-tool.cabal
@@ -0,0 +1,10 @@
+cabal-version:  1.12
+name:           cabal-bug-build-tool
+version:        0
+build-type:     Simple
+
+library
+  exposed-modules:  OK
+  default-language: Haskell2010
+  build-depends:    base, template-haskell, process
+  build-tool-depends: mybuilder:mybuilder >=0.2.0.0
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/cabal.out b/cabal-testsuite/PackageTests/Regression/T9756/cabal.out
@@ -0,0 +1,27 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+# cabal v2-install
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - mybuilder-0.1.0.0 (exe:mybuilder) (requires build)
+Configuring executable 'mybuilder' for mybuilder-0.1.0.0...
+Preprocessing executable 'mybuilder' for mybuilder-0.1.0.0...
+Building executable 'mybuilder' for mybuilder-0.1.0.0...
+Installing executable mybuilder in <PATH>
+Warning: The directory <ROOT>/cabal.dist/home/.cabal/store/ghc-<GHCVER>/incoming/new-<RAND><ROOT>/cabal.dist/home/.cabal/store/ghc-<GHCVER>/<PACKAGE>-<HASH>/bin is not in the system search path.
+Symlinking 'mybuilder' to '<ROOT>/cabal.dist/install/mybuilder'
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - mybuilder-0.2.0.0 (exe:mybuilder) (requires build)
+ - cabal-bug-build-tool-0 (lib) (first run)
+Configuring executable 'mybuilder' for mybuilder-0.2.0.0...
+Preprocessing executable 'mybuilder' for mybuilder-0.2.0.0...
+Building executable 'mybuilder' for mybuilder-0.2.0.0...
+Installing executable mybuilder in <PATH>
+Warning: The directory <ROOT>/cabal.dist/home/.cabal/store/ghc-<GHCVER>/incoming/new-<RAND><ROOT>/cabal.dist/home/.cabal/store/ghc-<GHCVER>/<PACKAGE>-<HASH>/bin is not in the system search path.
+Configuring library for cabal-bug-build-tool-0...
+Preprocessing library for cabal-bug-build-tool-0...
+Building library for cabal-bug-build-tool-0...
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/cabal.project b/cabal-testsuite/PackageTests/Regression/T9756/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/cabal.test.hs b/cabal-testsuite/PackageTests/Regression/T9756/cabal.test.hs
@@ -0,0 +1,13 @@
+import Test.Cabal.Prelude
+
+-- We are testing if the build-tools program is found in path before programs e.g. in extra-prog-path or the system path
+-- For that, we need
+--  * A repo with a build tool that is up to date
+--  * An older version of the build tool in the extra-prog-path
+--  * A project that requires the more up-to-date version of the build-tool
+
+main = cabalTest $ withRepo "repo" $ do
+  dir <- testWorkDir <$> getTestEnv
+  cabal "v2-install" ["mybuilder-0.1.0.0", "--installdir=" ++ dir ++ "/install", "--overwrite-policy=always"]
+  cabal "v2-build" ["cabal-bug-build-tool", "--extra-prog-path=" ++ dir ++ "/install"]
+
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/CHANGELOG.md b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for mybuilder0100
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/app/Main.hs b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/app/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "0.1.0.0"
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/mybuilder.cabal b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.1.0.0/mybuilder.cabal
@@ -0,0 +1,18 @@
+cabal-version:   3.0
+name:            mybuilder
+version:         0.1.0.0
+license:         NONE
+author:          Rodrigo Mesquita
+maintainer:      rodrigo.m.mesquita@gmail.com
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable mybuilder
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:    base
+    hs-source-dirs:   app
+    default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/CHANGELOG.md b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for mybuilder0100
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/app/Main.hs b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/app/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "0.2.0.0"
diff --git a/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/mybuilder.cabal b/cabal-testsuite/PackageTests/Regression/T9756/repo/mybuilder-0.2.0.0/mybuilder.cabal
@@ -0,0 +1,18 @@
+cabal-version:   3.0
+name:            mybuilder
+version:         0.2.0.0
+license:         NONE
+author:          Rodrigo Mesquita
+maintainer:      rodrigo.m.mesquita@gmail.com
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable mybuilder
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:    base
+    hs-source-dirs:   app
+    default-language: Haskell2010

Original file line number	Diff line number	Diff line change
`@@ -471,7 +471,7 @@ configureCompiler`
`471`	`471`	`)`
`472`	`472`	`$ do`
`473`	`473`	`liftIO $ info verbosity "Compiler settings changed, reconfiguring..."`
`474`		`- progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb`
	`474`	`+ progdb <- liftIO $ prependProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb`
`475`	`475`	`let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb`
`476`	`476`	`result@(_, _, progdb'') <-`
`477`	`477`	`liftIO $`