fix(Cabal): Use the C toolchain GHC was configured with

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"

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

cabal-testsuite/PackageTests/GhcConfiguredToolchain/cabal.project

@@ -0,0 +1 @@
+packages: .

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

cabal-testsuite/PackageTests/GhcConfiguredToolchain/cbits/clib.c

@@ -0,0 +1 @@
+int ghc_toolchain_c_value(void) { return 42; }

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

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

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.