GHC/Build/Link: relativize absolute rpaths + self-$ORIGIN (stacked on #378)

Cabal-described/src/Distribution/Described.hs

@@ -101,7 +101,7 @@ import Distribution.Types.TestType                 (TestType)
 import Distribution.Types.UnitId                   (UnitId)
 import Distribution.Types.UnqualComponentName      (UnqualComponentName)
 import Distribution.Utils.Path                     (SymbolicPath, RelativePath, FileOrDir(..), Pkg, Build)
-import Distribution.Verbosity                      (Verbosity, VerbosityFlags)
+import Distribution.Verbosity                      (VerbosityFlags)
 import Distribution.Version                        (Version, VersionRange)
 import Language.Haskell.Extension                  (Extension, Language, knownLanguages)
 

Cabal/src/Distribution/Simple/GHC/Build/Link.hs

@@ -55,6 +55,8 @@
   , replaceExtension
   )
 
+import Distribution.Simple.InstallDirs (bindir, libdir)
+
 -- | Links together the object files of the Haskell modules and extra sources
 -- using the context in which the component is being built.
 --
@@ -624,9 +626,63 @@
       let hostPref = case hostOS of
             OSX -> "@loader_path"
             _ -> "$ORIGIN"
-          relPath p = if isRelative p then hostPref </> p else p
+          -- The artifact's eventual install directory; absolute rpaths are
+          -- expressed as `@loader_path`/`$ORIGIN`-relative to this when the
+          -- user has opted into relocatable mode (`relocatable: True` or
+          -- `--enable-relocatable`).
+          --
+          -- Mirrors the executable/library split in
+          -- 'Distribution.Simple.LocalBuildInfo.depLibraryPaths'.
+          installDirs = absoluteComponentInstallDirs
+            (localPkgDescr lbi) lbi (componentUnitId clbi) NoCopyDest
+          isExe = case clbi of
+            ExeComponentLocalBuildInfo{} -> True
+            _ -> False
+          relDir
+            | isExe     = bindir installDirs
+            | otherwise = libdir installDirs
+          -- Convert an rpath entry to its loader-relative form.
+          --
+          -- * Already-relative paths get the `@loader_path` / `$ORIGIN`
+          --   prefix as before.
+          -- * Absolute paths are rewritten to a relative-form expression
+          --   (`@loader_path/../../...`) computed against the binary's
+          --   install dir, so the resulting binary does not bake a
+          --   build-host absolute path into LC_RPATH / DT_RUNPATH.
+          --
+          --   This matters on macOS 15 (Sequoia), whose dyld treats an
+          --   unresolvable absolute rpath as fatal — older dyld silently
+          --   falls through to subsequent rpath entries. Pre-fix, a
+          --   bindist produced under e.g.
+          --   `/Volumes/WorkSpace/_work/ghc/ghc/_build/stage2/store/...`
+          --   would abort-trap on launch when relocated off the build
+          --   host. Post-fix, the same entry becomes
+          --   `@loader_path/../../<sibling-pkg>/lib`, which dyld treats
+          --   as a normal missing-directory rpath when the bindist
+          --   layout no longer matches the store layout.
+          --
+          --   Not gated on `relocatable lbi`: that flag also triggers
+          --   `checkRelocatable` (which refuses cabal-store layouts
+          --   where deps live in sibling prefixes) and changes how
+          --   library-dirs are emitted in .conf files. Both behaviors
+          --   are independent of rpath generation and incompatible with
+          --   the stable-haskell GHC bindist assembly pipeline.
+          relPath p
+            | isRelative p = hostPref </> p
+            | otherwise    = hostPref </> shortRelativePath relDir p
           rpaths =
-            toNubListR (map relPath libraryPaths)
+            -- Always search the artifact's own directory ($ORIGIN /
+            -- @loader_path) first, so a sibling library installed alongside it
+            -- is found by the dynamic loader. depLibraryPaths can yield the
+            -- parent directory for a same-directory dependency (relativized to
+            -- "$ORIGIN/.."), which leaves the dependency unfound. glibc papers
+            -- over this via the runtime LD_LIBRARY_PATH GHC sets before
+            -- dlopen, but musl reads LD_LIBRARY_PATH only at process startup,
+            -- so the missing self-rpath is fatal there: a Backpack signature
+            -- implementation (libHSp) installed next to the instantiated unit
+            -- (libHSindef) fails to load (testsuite T14304 on Alpine/musl).
+            toNubListR [hostPref]
+              <> toNubListR (map relPath libraryPaths)
               <> toNubListR (map getSymbolicPath $ extraLibDirs bi)
       return rpaths
     else return mempty

cabal-install-solver/src/Distribution/Solver/Modular.hs

@@ -75,7 +75,7 @@ import Distribution.Simple.Setup
          ( BooleanFlag(..) )
 import Distribution.Simple.Utils
     ( ordNubBy )
-import Distribution.Verbosity ( VerbosityLevel (..), normal, verbose )
+import Distribution.Verbosity ( VerbosityLevel (..) )
 
 -- | Ties the two worlds together: classic cabal-install vs. the modular
 -- solver. Performs the necessary translations before and after.

cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs

@@ -261,7 +261,7 @@ alreadyLinked = error "addLinking called on tree that already contains linked no
 -- | Interface to the tree builder. Just takes an index and a list of package names,
 -- and computes the initial state and then the tree from there.
 buildTree :: Index -> IndependentGoals -> [PN] -> Tree () QGoalReason
-buildTree idx (IndependentGoals ind) igs =
+buildTree idx (IndependentGoals _ind) igs =
     build Linker {
         buildState = BS {
             index = idx

cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs

@@ -274,8 +274,7 @@ linkDeps target = \deps -> do
       (Simple (LDep _ (Pkg  _ _)) _, _) -> return ()
 
     requalify :: FlaggedDeps QPN -> UpdateState (FlaggedDeps QPN)
-    requalify deps = do
-      vs <- get
+    requalify deps =
       return $ qualifyDeps target (unqualifyDeps deps)
 
 pickFlag :: QFN -> Bool -> UpdateState ()

cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs

@@ -201,7 +201,6 @@ validate = go
       svd            <- asks saved -- obtain saved dependencies
       aComps         <- asks availableComponents
       rComps         <- asks requiredComponents
-      qo             <- asks qualifyOptions
       -- obtain dependencies and index-dictated exclusions introduced by the choice
       let I stage _vr _loc = i
       let (PInfo deps comps _ mfr) = idx ! pn ! i

cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs

@@ -94,6 +94,10 @@ constraintQualifierMatches (ScopeAnySetupQualifier pn) (QualSetup _) pn' = pn ==
 constraintQualifierMatches (ScopeAnyExeQualifier pn) (QualExe _ _) pn' = pn == pn'
 constraintQualifierMatches (ScopeAnyExeQualifier _) QualToplevel _ = False
 constraintQualifierMatches (ScopeAnyExeQualifier _) (QualSetup _) _compile = False
+-- A base-qualified dependency is never matched by a toplevel/setup/exe scope.
+constraintQualifierMatches (ScopeTarget _) (QualBase _) _ = False
+constraintQualifierMatches (ScopeAnySetupQualifier _) (QualBase _) _ = False
+constraintQualifierMatches (ScopeAnyExeQualifier _) (QualBase _) _ = False
 constraintQualifierMatches (ScopeAnyQualifier pn) _ pn' = pn == pn'
 
 instance Pretty ConstraintScope where

cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs

@@ -64,6 +64,7 @@ instance Structured Qualifier
 
 instance Pretty Qualifier where
   pretty QualToplevel = Disp.text "toplevel"
+  pretty (QualBase pn) = pretty pn <<>> Disp.text ":base"
   pretty (QualSetup pn) = pretty pn <<>> Disp.text ":setup"
   pretty (QualExe pn pn2) = pretty pn <<>> Disp.text ":" <<>>
                             pretty pn2 <<>> Disp.text ":exe"
@@ -78,6 +79,7 @@ instance Pretty Qualifier where
 -- 'Base' qualifier, will always be @base@).
 dispQualifier :: Qualifier -> Disp.Doc
 dispQualifier QualToplevel = mempty
+dispQualifier (QualBase pn) = pretty pn <> Disp.text "."
 dispQualifier (QualSetup pn) = pretty pn <> Disp.text ":setup."
 dispQualifier (QualExe pn pn2) =
   pretty pn

cabal-install/parser-tests/Tests/ParserTests.hs

@@ -37,6 +37,7 @@ import Distribution.Simple.InstallDirs (InstallDirs (..), toPathTemplate)
 import Distribution.Simple.Setup (DumpBuildInfo (..), HaddockTarget (..), TestShowDetails (..))
 import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
 import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath (..))
+import Distribution.Solver.Types.Stage (Stage (..))
 import Distribution.Solver.Types.Settings
   ( AllowBootLibInstalls (..)
   , CountConflicts (..)
@@ -84,6 +85,7 @@ parserTests =
     , testCase "read project-config-local-packages" testProjectConfigLocalPackages
     , testCase "read project-config-all-packages" testProjectConfigAllPackages
     , testCase "read project-config-specific-packages" testProjectConfigSpecificPackages
+    , testCase "read project-config-stage-packages" testProjectConfigStagePackages
     , testCase "test projectConfigAllPackages concatenation" testAllPackagesConcat
     , testCase "test projectConfigSpecificPackages concatenation" testSpecificPackagesConcat
     , testCase "test program-locations concatenation" testProgramLocationsConcat
@@ -438,6 +440,30 @@ testProjectConfigSpecificPackages = do
         { packageConfigSharedLib = Flag True
         }
 
+testProjectConfigStagePackages :: Assertion
+testProjectConfigStagePackages = do
+  -- The legacy parser does not support stage-qualified package stanzas (it
+  -- would reject the @build:*@ argument), so we read with the parsec parser
+  -- only rather than 'readConfigDefault', which also runs the legacy parser.
+  config <- readConfigParsec "project-config-stage-packages"
+  assertEqual
+    "Parsed Config does not match expected"
+    expected
+    (projectConfigStagePackages (snd (condTreeData config)))
+  where
+    expected = MapMappend $ Map.fromList [(Build, expectedBuild), (Host, expectedHost)]
+    expectedBuild :: PackageConfig
+    expectedBuild =
+      mempty
+        { packageConfigSharedLib = Flag False
+        , packageConfigDynExe = Flag False
+        }
+    expectedHost :: PackageConfig
+    expectedHost =
+      mempty
+        { packageConfigSharedLib = Flag True
+        }
+
 testAllPackagesConcat :: Assertion
 testAllPackagesConcat = do
   (config, legacy) <- readConfigDefault "all-packages-concat"
@@ -566,6 +592,18 @@ verbosity = mkVerbosity defaultVerbosityHandles normal
 readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
 readConfigDefault testSubDir = readConfig testSubDir "cabal.project"
 
+-- | Read a project config using the parsec parser only. Useful for syntax the
+-- legacy parser does not support (e.g. stage-qualified package stanzas).
+readConfigParsec :: FilePath -> IO ProjectConfigSkeleton
+readConfigParsec testSubDir = do
+  (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir "cabal.project"
+  exists <- liftIO $ doesFileExist projectConfigFp
+  assertBool ("projectConfig does not exist: " <> projectConfigFp) exists
+  httpTransport <- liftIO $ configureTransport verbosity [] Nothing
+  liftIO $
+    runRebuild testRootFp $
+      readProjectFileSkeletonParsec verbosity httpTransport distDirLayout "" ""
+
 readConfig :: FilePath -> FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
 readConfig testSubDir projectFileName = do
   (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir projectFileName

cabal-install/parser-tests/Tests/files/project-config-stage-packages/cabal.project

@@ -0,0 +1,6 @@
+package build:*
+    shared: False
+    executable-dynamic: False
+
+package host:*
+    shared: True

cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs

@@ -44,8 +44,10 @@ projectConfigFieldGrammar source knownPrograms =
     <*> blurFieldGrammar L.projectConfigLocalPackages (packageConfigFieldGrammar knownPrograms)
     -- \^ PackageConfig to be applied to locally built packages, specified not inside a stanza
     <*> pure mempty
-  where
     -- \^ PackageConfig applied to explicitly named packages
+    <*> pure mempty
+    -- \^ PackageConfig applied to all packages of a given stage ('package build:*' etc.)
+  where
     provenance = Set.singleton (Explicit source)
 
 formatPackageVersionConstraints :: [PackageVersionConstraint] -> List CommaVCat (Identity PackageVersionConstraint) PackageVersionConstraint

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -644,6 +644,8 @@ convertLegacyProjectConfig
       , projectConfigAllPackages = configAllPackages
       , projectConfigLocalPackages = configLocalPackages
       , projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
+      , -- The legacy parser does not support stage-qualified package stanzas.
+        projectConfigStagePackages = mempty
       }
     where
       configAllPackages = convertLegacyPerPackageFlags g i h t b

cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs

@@ -60,6 +60,7 @@ import Distribution.Solver.Types.Settings
   , ReorderGoals (..)
   , StrongFlags (..)
   )
+import Distribution.Solver.Types.Stage (Stage)
 import Distribution.Types.PackageVersionConstraint
   ( PackageVersionConstraint
   )
@@ -109,6 +110,10 @@ projectConfigSpecificPackage :: Lens' ProjectConfig (MapMappend PackageName Pack
 projectConfigSpecificPackage f s = fmap (\x -> s{T.projectConfigSpecificPackage = x}) (f (T.projectConfigSpecificPackage s))
 {-# INLINEABLE projectConfigSpecificPackage #-}
 
+projectConfigStagePackages :: Lens' ProjectConfig (MapMappend Stage PackageConfig)
+projectConfigStagePackages f s = fmap (\x -> s{T.projectConfigStagePackages = x}) (f (T.projectConfigStagePackages s))
+{-# INLINEABLE projectConfigStagePackages #-}
+
 projectConfigVerbosity :: Lens' ProjectConfigBuildOnly (Flag VerbosityFlags)
 projectConfigVerbosity f s = fmap (\x -> s{T.projectConfigVerbosity = x}) (f (T.projectConfigVerbosity s))
 {-# INLINEABLE projectConfigVerbosity #-}

cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs

@@ -42,6 +42,7 @@ import Distribution.Simple.Program.Types (programName)
 import Distribution.Simple.Setup
 import Distribution.Simple.Utils (debug, noticeDoc)
 import Distribution.Solver.Types.ProjectConfigPath
+import Distribution.Solver.Types.Stage (Stage)
 import Distribution.System (buildOS)
 import Distribution.Types.CondTree (CondBranch (..), CondTree (..))
 import Distribution.Types.ConfVar (ConfVar (..))
@@ -284,8 +285,11 @@ parseSection programDb (MkSection (Name pos name) args secFields)
         Just (SpecificPackage packageName) -> do
           packageCfg <- parsePackageConfig
           stateConfig . L.projectConfigSpecificPackage %= (<> MapMappend (Map.singleton packageName packageCfg))
+        Just (AllStagePackages stage) -> do
+          packageCfg <- parsePackageConfig
+          stateConfig . L.projectConfigStagePackages %= (<> MapMappend (Map.singleton stage packageCfg))
         Nothing -> do
-          lift $ parseWarning pos PWTUnknownSection "target package name or * required"
+          lift $ parseWarning pos PWTUnknownSection "target package name, '*', or '<stage>:*' required"
           return ()
   | otherwise = do
       warnInvalidSubsection pos name
@@ -345,7 +349,7 @@ parseRepoName pos args = case args of
               return Nothing
             Right name -> return $ Just name
 
-data PackageConfigTarget = AllPackages | SpecificPackage !PackageName
+data PackageConfigTarget = AllPackages | AllStagePackages !Stage | SpecificPackage !PackageName
 
 parsePackageName :: Position -> [SectionArg Position] -> ParseResult src (Maybe PackageConfigTarget)
 parsePackageName pos args = case args of
@@ -356,12 +360,18 @@ parsePackageName pos args = case args of
   where
     parseName secName = case runParsecParser parser "<parsePackageName>" (fieldLineStreamFromBS secName) of
       Left _ -> do
-        parseFailure pos ("Invalid package name" ++ fromUTF8BS secName)
+        parseFailure pos ("Invalid 'package' target (expected a package name, '*', or '<stage>:*'): " ++ fromUTF8BS secName)
         return Nothing
       Right cfgTarget -> return $ pure cfgTarget
     parser :: ParsecParser PackageConfigTarget
     parser =
-      P.choice [P.try (P.char '*' >> return AllPackages), SpecificPackage <$> parsec]
+      P.choice
+        [ P.try (P.char '*' >> return AllPackages)
+        , -- A stage qualifier, e.g. @build:*@ or @host:*@, applies the
+          -- package configuration to all packages built for that stage.
+          P.try (AllStagePackages <$> parsec <* P.char ':' <* P.char '*')
+        , SpecificPackage <$> parsec
+        ]
 
 -- | Parse fields of a program-options stanza.
 parseProgramArgs :: ProgramDb -> Fields Position -> ParseResult src (MapMappend String [String])

cabal-install/src/Distribution/Client/ProjectConfig/Types.hs

@@ -57,6 +57,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
   )
 
 import Distribution.Solver.Types.ConstraintSource
+import Distribution.Solver.Types.Stage (Stage)
 import Distribution.Solver.Types.Settings
 
 import Distribution.Package
@@ -155,6 +156,12 @@ data ProjectConfig = ProjectConfig
   -- ^ Configuration to be applied to *local* packages; i.e.,
   -- any packages which are explicitly named in `cabal.project`.
   , projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
+  , projectConfigStagePackages :: MapMappend Stage PackageConfig
+  -- ^ Configuration to be applied to all packages built for a particular
+  -- stage (e.g. @package build:*@ or @package host:*@). Lets a staged build
+  -- target the build-stage and host-stage packages independently, which
+  -- plain @package *@ cannot since the same package can be built in both
+  -- stages.
   }
   deriving (Eq, Show, Generic)