Merge pull request haskell#9443 from erikd/erikd/relocatable-flag-2

Use linker capability detection to improve linker use
mpickering · Nov 17, 2023 · 03809b3 · 03809b3
2 parents a134b26 + 53fc3d3
commit 03809b3
Show file tree

Hide file tree

Showing 5 changed files with 49 additions and 22 deletions.
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
@@ -82,6 +82,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.PreProcess
 import Distribution.Simple.Program
+import Distribution.Simple.Program.Db (lookupProgramByName)
 import Distribution.Simple.Setup.Common as Setup
 import Distribution.Simple.Setup.Config as Setup
 import Distribution.Simple.Utils
@@ -767,22 +768,16 @@ configure (pkg_descr0, pbi) cfg = do
             )
           return False
 
-  let compilerSupportsGhciLibs :: Bool
-      compilerSupportsGhciLibs =
-        case compilerId comp of
-          CompilerId GHC version
-            | version > mkVersion [9, 3] && windows ->
-                False
-          CompilerId GHC _ ->
-            True
-          CompilerId GHCJS _ ->
-            True
-          _ -> False
-        where
-          windows = case compPlatform of
-            Platform _ Windows -> True
-            Platform _ _ -> False
-
+  -- Basically yes/no/unknown.
+  let linkerSupportsRelocations :: Maybe Bool
+      linkerSupportsRelocations =
+        case lookupProgramByName "ld" programDb'' of
+          Nothing -> Nothing
+          Just ld ->
+            case Map.lookup "Supports relocatable output" $ programProperties ld of
+              Just "YES" -> Just True
+              Just "NO" -> Just False
+              _other -> Nothing
   let ghciLibByDefault =
         case compilerId comp of
           CompilerId GHC _ ->
@@ -801,10 +796,12 @@ configure (pkg_descr0, pbi) cfg = do
 
   withGHCiLib_ <-
     case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of
-      True | not compilerSupportsGhciLibs -> do
+      -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the
+      -- linker does not support -r.
+      True | not (fromMaybe True linkerSupportsRelocations) -> do
         warn verbosity $
-          "--enable-library-for-ghci is no longer supported on Windows with"
-            ++ " GHC 9.4 and later; ignoring..."
+          "--enable-library-for-ghci is not supported with the current"
+            ++ "  linker; ignoring..."
         return False
       v -> return v
 

diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -114,7 +114,9 @@ configureToolchain _implInfo ghcProg ghcInfo =
     . addKnownProgram
       ldProgram
         { programFindLocation = findProg ldProgramName extraLdPath
-        , programPostConf = configureLd
+        , programPostConf = \v cp ->
+            -- Call any existing configuration first and then add any new configuration
+            configureLd v =<< programPostConf ldProgram v cp
         }
     . addKnownProgram
       arProgram

diff --git a/Cabal/src/Distribution/Simple/Program/Builtin.hs b/Cabal/src/Distribution/Simple/Program/Builtin.hs
@@ -370,7 +370,19 @@ ldProgram =
             -- `lld` only accepts `-help`.
             `catchIO` (\_ -> return "")
         let k = "Supports relocatable output"
-            v = if "--relocatable" `isInfixOf` ldHelpOutput then "YES" else "NO"
+            -- Standard GNU `ld` uses `--relocatable` while `ld.gold` uses
+            -- `-relocatable` (single `-`).
+            v
+              | "-relocatable" `isInfixOf` ldHelpOutput = "YES"
+              -- ld64 on macOS has this lovely response for "--help"
+              --
+              --   ld64: For information on command line options please use 'man ld'.
+              --
+              -- it does however support -r, if you read the manpage
+              -- (e.g. https://www.manpagez.com/man/1/ld64/)
+              | "ld64:" `isPrefixOf` ldHelpOutput = "YES"
+              | otherwise = "NO"
+
             m = Map.insert k v (programProperties ldProg)
         return $ ldProg{programProperties = m}
     }

diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs
@@ -46,6 +46,7 @@ module Distribution.Simple.Program.Db
   , userSpecifyArgss
   , userSpecifiedArgs
   , lookupProgram
+  , lookupProgramByName
   , updateProgram
   , configuredPrograms
 
@@ -299,7 +300,11 @@ userSpecifiedArgs prog =
 
 -- | Try to find a configured program
 lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
-lookupProgram prog = Map.lookup (programName prog) . configuredProgs
+lookupProgram = lookupProgramByName . programName
+
+-- | Try to find a configured program
+lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram
+lookupProgramByName name = Map.lookup name . configuredProgs
 
 -- | Update a configured program in the database.
 updateProgram

diff --git a/changelog.d/pr-9443 b/changelog.d/pr-9443
@@ -0,0 +1,11 @@
+synopsis: Use linker capability detection to improve linker use
+packages: Cabal
+prs: #9443
+
+description: {
+
+- Previously the GHC version number and platform were used as a proxy for whether
+  the linker can generate relocatable objects.
+- Now, the ability of the linker to create relocatable objects is detected.
+
+}