diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 6959b8f48b6..ac58ebb3073 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -88,7 +88,8 @@ import Language.Haskell.Extension import System.Directory (listDirectory) import System.Environment (getEnv) import System.FilePath - ( takeDirectory + ( isAbsolute + , takeDirectory , takeExtension , takeFileName ) @@ -98,6 +99,14 @@ targetPlatform :: [(String, String)] -> Maybe Platform targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo -- | Adjust the way we find and configure gcc and ld +-- +-- The tools are the ones GHC was configured with: we ask GHC (via the +-- settings file exposed by @ghc --info@) what C toolchain it uses and use +-- exactly that. The toolchain recorded in GHC's settings file was +-- chosen when GHC (or its bindist) was configured, and GHC cannot be +-- assumed to work with any other choice; e.g. a GHC built for another +-- target is configured with a toolchain that searching the PATH cannot find +-- (a GHC for the JS backend needs the emscripten toolchain). configureToolchain :: GhcImplInfo -> ConfiguredProgram @@ -107,28 +116,28 @@ configureToolchain configureToolchain _implInfo ghcProg ghcInfo = addKnownProgram gccProgram - { programFindLocation = findProg gccProgramName extraGccPath + { programFindLocation = findProg gccProgram mbGccCommand extraGccPath , programPostConf = configureGcc } . addKnownProgram gppProgram - { programFindLocation = findProg gppProgramName extraGppPath + { programFindLocation = findProg gppProgram mbGppCommand extraGppPath , programPostConf = configureGpp } . addKnownProgram ldProgram - { programFindLocation = findProg ldProgramName extraLdPath + { programFindLocation = findProg ldProgram mbLdCommand extraLdPath , programPostConf = \v cp -> -- Call any existing configuration first and then add any new configuration configureLd v =<< programPostConf ldProgram v cp } . addKnownProgram arProgram - { programFindLocation = findProg arProgramName extraArPath + { programFindLocation = findProg arProgram mbArCommand extraArPath } . addKnownProgram stripProgram - { programFindLocation = findProg stripProgramName extraStripPath + { programFindLocation = findProg stripProgram mbStripCommand extraStripPath } where compilerDir, base_dir, mingwBinDir :: FilePath @@ -138,27 +147,22 @@ configureToolchain _implInfo ghcProg ghcInfo = isWindows = case buildOS of Windows -> True; _ -> False binPrefix = "" - maybeName :: Program -> Maybe FilePath -> String - maybeName prog = maybe (programName prog) (dropExeExtension . takeFileName) - - gccProgramName = maybeName gccProgram mbGccLocation - gppProgramName = maybeName gppProgram mbGppLocation - ldProgramName = maybeName ldProgram mbLdLocation - arProgramName = maybeName arProgram mbArLocation - stripProgramName = maybeName stripProgram mbStripLocation - mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath] - mkExtraPath mbPath mingwPath + mkExtraPath mbCommand mingwPath | isWindows = mbDir ++ [mingwPath] | otherwise = mbDir where - mbDir = maybeToList . fmap takeDirectory $ mbPath - - extraGccPath = mkExtraPath mbGccLocation windowsExtraGccDir - extraGppPath = mkExtraPath mbGppLocation windowsExtraGppDir - extraLdPath = mkExtraPath mbLdLocation windowsExtraLdDir - extraArPath = mkExtraPath mbArLocation windowsExtraArDir - extraStripPath = mkExtraPath mbStripLocation windowsExtraStripDir + mbDir = + [ takeDirectory command + | Just command <- [mbCommand] + , isAbsolute command + ] + + extraGccPath = mkExtraPath mbGccCommand windowsExtraGccDir + extraGppPath = mkExtraPath mbGppCommand windowsExtraGppDir + extraLdPath = mkExtraPath mbLdCommand windowsExtraLdDir + extraArPath = mkExtraPath mbArCommand windowsExtraArDir + extraStripPath = mkExtraPath mbStripCommand windowsExtraStripDir -- on Windows finding and configuring ghc's gcc & binutils is a bit special ( windowsExtraGccDir @@ -170,24 +174,46 @@ configureToolchain _implInfo ghcProg ghcInfo = let b = mingwBinDir binPrefix in (b, b, b, b, b) + -- Locate a toolchain tool, preferring the exact tool GHC was configured findProg - :: String + :: Program + -> Maybe FilePath + -- \^ The tool command reported by @ghc --info@, if any. -> [FilePath] + -- \^ Extra directories to search (e.g. GHC's bundled mingw bin dir). -> Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) - findProg progName extraPath v searchpath = - findProgramOnSearchPath v searchpath' progName + findProg prog mbCommand extraPath v searchpath = + case mbCommand of + -- new way: the exact tool recorded in GHC's settings file + Just command | isAbsolute command -> return (Just (command, [])) + -- old way: find a like-named program on the search path + _ -> searchFor $ maybeName mbCommand where - searchpath' = map ProgramSearchPathDir extraPath ++ searchpath - - -- Read tool locations from the 'ghc --info' output. Useful when - -- cross-compiling. - mbGccLocation = Map.lookup "C compiler command" ghcInfo - mbGppLocation = Map.lookup "C++ compiler command" ghcInfo - mbLdLocation = Map.lookup "ld command" ghcInfo - mbArLocation = Map.lookup "ar command" ghcInfo - mbStripLocation = Map.lookup "strip command" ghcInfo + maybeName :: Maybe FilePath -> String + maybeName = maybe (programName prog) (dropExeExtension . takeFileName) + + searchFor :: String -> IO (Maybe (FilePath, [FilePath])) + searchFor = findProgramOnSearchPath v searchpath' + where + searchpath' = map ProgramSearchPathDir extraPath ++ searchpath + + -- The tool commands from the 'ghc --info' output. + mbGccCommand = getToolCommand "C compiler command" + mbGppCommand = getToolCommand "C++ compiler command" + mbLdCommand = getToolCommand "Merge objects command" <|> getToolCommand "ld command" + mbArCommand = getToolCommand "ar command" + mbStripCommand = getToolCommand "strip command" + + -- An empty command means the tool was deliberately left unconfigured + -- when GHC was built (e.g. the merge objects command of GHCs with the + -- bundled Windows toolchain); treat it as if it were not reported. + getToolCommand :: String -> Maybe FilePath + getToolCommand key = case Map.lookup key ghcInfo of + Just command + | not (null command) -> Just command + _ -> Nothing ccFlags = getFlags "C compiler flags" cxxFlags = getFlags "C++ compiler flags" diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/app/Main.hs b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/app/Main.hs new file mode 100644 index 00000000000..35cc483c7db --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib (c_value) + +main :: IO () +main = c_value >>= print diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.project b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.test.hs b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.test.hs new file mode 100644 index 00000000000..880ac06a734 --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.test.hs @@ -0,0 +1,60 @@ +import Test.Cabal.Prelude + +import Data.Char (isSpace) +import Data.List (isInfixOf) +import Data.Maybe (fromMaybe) +import System.Directory (createDirectoryIfMissing, executable, getPermissions, setPermissions) +import System.Environment (lookupEnv) + +-- Cabal must use the C toolchain GHC was configured with (the settings file +-- exposed by `ghc --info`) rather than a like-named tool found on the PATH. +main :: IO () +main = cabalTest $ recordMode DoNotRecord $ do + env <- getTestEnv + let pkgDir = testCurrentDir env + + -- Ask GHC what C toolchain it was configured with. + infoOutput <- resultOutput <$> ghc' ["--info"] + let mbCC = parseGhcInfo infoOutput >>= lookup "C compiler command" + + case mbCC of + -- GHC records an absolute path: Cabal must invoke exactly that C + -- compiler, even when a like-named program shadows it on the PATH. + Just cc | isAbsolute cc -> do + decoyEnv <- + if isWindows + then return [] + else do + let decoyBin = pkgDir "decoy-bin" + liftIO $ do + createDirectoryIfMissing True decoyBin + let decoy = decoyBin takeFileName cc + writeFile decoy $ + unlines + [ "#!/bin/sh" + , "exec " ++ show cc ++ " \"$@\"" + ] + perms <- getPermissions decoy + setPermissions decoy perms{executable = True} + originalPath <- fromMaybe "" <$> liftIO (lookupEnv "PATH") + return [("PATH", Just (decoyBin ++ searchPathSeparator : originalPath))] + withEnv decoyEnv $ do + res <- cabal' "v2-build" ["all"] + -- Depending on the platform's command-line escaping rules the + -- recorded path may be quoted. + assertBool + "Cabal did not use the C compiler GHC was configured with" + ( ("-pgmc " ++ cc) + `isInfixOf` filter (`notElem` ("\"'" :: String)) (resultOutput res) + ) + withPlan $ runPlanExe "ghc-toolchain" "ghc-toolchain-exe" [] + -- GHC only records a bare program name (or nothing): looking it up on + -- the PATH is then exactly what GHC does itself. + _ -> do + void $ cabal' "v2-build" ["all"] + withPlan $ runPlanExe "ghc-toolchain" "ghc-toolchain-exe" [] + +parseGhcInfo :: String -> Maybe [(String, String)] +parseGhcInfo str = case reads str of + [(xs, rest)] | all isSpace rest -> Just xs + _ -> Nothing diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cbits/clib.c b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cbits/clib.c new file mode 100644 index 00000000000..6f8451b9e2f --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/cbits/clib.c @@ -0,0 +1 @@ +int ghc_toolchain_c_value(void) { return 42; } diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/ghc-toolchain.cabal b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/ghc-toolchain.cabal new file mode 100644 index 00000000000..0cd46bb4f6d --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/ghc-toolchain.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.2 +name: ghc-toolchain +version: 0.1 +build-type: Simple + +library + exposed-modules: Lib + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 + c-sources: cbits/clib.c + +executable ghc-toolchain-exe + main-is: Main.hs + hs-source-dirs: app + build-depends: base, ghc-toolchain + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/GhcConfiguredToolchain/src/Lib.hs b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/src/Lib.hs new file mode 100644 index 00000000000..d278a2c8327 --- /dev/null +++ b/cabal-testsuite/PackageTests/GhcConfiguredToolchain/src/Lib.hs @@ -0,0 +1,4 @@ +module Lib where + +foreign import ccall unsafe "ghc_toolchain_c_value" + c_value :: IO Int diff --git a/changelog.d/12333.md b/changelog.d/12333.md new file mode 100644 index 00000000000..e9da3385e79 --- /dev/null +++ b/changelog.d/12333.md @@ -0,0 +1,42 @@ +--- +synopsis: Use the C toolchain GHC was configured with +packages: [Cabal] +prs: 12333 +issues: 12332 +--- + +Cabal now asks GHC what toolchain it was configured with (via `ghc --info`, +i.e. the settings file chosen when GHC or its bindist was configured) and +uses exactly those tools when it needs to invoke the toolchain itself, e.g. +for the C compiler used by hsc2hs and `cc-options`, the `ar` invocation +creating static archives, or the linker invocation combining object files +into a library for GHCi (for GHC >= 9.10 this is the merge objects command, +as GHC no longer reports a plain `ld` command). + +Previously the tools were looked up by name on the search path, with GHC's +settings only contributing the name and its directory; that lookup could +find a tool that differs from the one GHC itself uses. This mattered in +particular for GHCs configured with a specific linker (e.g. `lld`) that is +not the system default, and for cross-compiled GHCs, whose toolchain cannot +be found by searching the PATH for a well-known name (e.g. a GHC for the JS +backend needs the emscripten toolchain): + +```diff + $ ghc --info | grep -E '"C compiler command"|"Merge objects command"' + ,("C compiler command","/usr/bin/clang") + ,("Merge objects command","/usr/bin/ld.lld") + $ cabal build -v2 --enable-library-for-ghci + Running: /usr/bin/ar -r dist/build/libHSpkg-0.1-inplace.a '@dist/tmp/ar.rsp' +- Running: /usr/bin/ld --help +- Running: /usr/bin/ld -x -r /tmp/cabal-1f3a5-5.o -o /tmp/cabal-1f3a5-6.o +- Running: /usr/bin/ld -r -o dist/build/libHSpkg-0.1-inplace.o '@dist/tmp/ld.rsp' ++ Running: /usr/bin/ld.lld --help ++ Running: /usr/bin/ld.lld -x -r /tmp/cabal-1f3a5-5.o -o /tmp/cabal-1f3a5-6.o ++ Running: /usr/bin/ld.lld -r -o dist/build/libHSpkg-0.1-inplace.o '@dist/tmp/ld.rsp' +``` + + +The program search path is still consulted when GHC reports only a bare +program name (matching GHC's own lookup), and user-specified program +locations (`--with-gcc`, `--with-ld`, `program-locations`) continue to take +precedence.