[Git][ghc/ghc][wip/fix-cross-ghc-info-unit-id] compiler: ensure cross ghc --info output target unid ids

11 Oct 2026


      Cheng Shao pushed to branch wip/fix-cross-ghc-info-unit-id at Glasgow Haskell Compiler / GHC


Commits:
fa8f57da by Cheng Shao at 2026-10-11T10:01:31+00:00
compiler: ensure cross ghc --info output target unid ids

Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in
--info output do not match the target unit ids reported by ghc-pkg,
breaking cross ghc release builds with hash-unit-ids when being used
with cabal 3.18. This patch fixes it by making --info output target
unit ids. Fixes #27919.

Co-authored-by: Codex <codex@openai.com>

- - - - -


10 changed files:

- .gitlab/hello.hs
- + changelog.d/fix-cross-ghc-info-unit-id
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Generate.hs


Changes:

=====================================
.gitlab/hello.hs
=====================================
@@ -27,7 +27,11 @@ fakeSettings =
       sTargetPlatform =
         genericPlatform,
       sPlatformMisc = PlatformMisc {},
-      sUnitSettings = UnitSettings { unitSettings_baseUnitId = stringToUnitId "base" }
+      sUnitSettings = UnitSettings
+        { unitSettings_baseUnitId = stringToUnitId "base"
+        , unitSettings_ghcUnitId = stringToUnitId "ghc"
+        , unitSettings_ghcInternalUnitId = stringToUnitId "ghc-internal"
+        }
     }
 
 fakeDynFlags :: DynFlags


=====================================
changelog.d/fix-cross-ghc-info-unit-id
=====================================
@@ -0,0 +1,4 @@
+section: compiler
+synopsis: Fix a bug where unit ids in cross ghc --info output doesn't match ghc-pkg output, breaking cross ghc releases with cabal 3.18.
+mrs: !16790
+issues: #27919


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -546,7 +546,8 @@ opt_i dflags= toolSettings_opt_i $ toolSettings dflags
 
 
 setBaseUnitId :: String -> DynP ()
-setBaseUnitId s = upd $ \d -> d { unitSettings = UnitSettings (stringToUnitId s) }
+setBaseUnitId s = upd $ \d -> d
+  { unitSettings = (unitSettings d) { unitSettings_baseUnitId = stringToUnitId s } }
 
 -----------------------------------------------------------------------------
 
@@ -3663,8 +3664,6 @@ compilerInfo dflags
        ("Project Patch Level",         cProjectPatchLevel),
        ("Project Patch Level1",        cProjectPatchLevel1),
        ("Project Patch Level2",        cProjectPatchLevel2),
-       ("Project Unit Id",             cProjectUnitId),
-       ("ghc-internal Unit Id",        cGhcInternalUnitId), -- See Note [Special unit-ids]
        ("Booter version",              cBooterVersion),
        ("Stage",                       cStage),
        ("Build platform",              cBuildPlatformString),


=====================================
compiler/GHC/Settings.hs
=====================================
@@ -94,7 +94,11 @@ data Settings = Settings
   , sRawTarget         :: Target
   }
 
-data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId }
+data UnitSettings = UnitSettings
+  { unitSettings_baseUnitId        :: !UnitId
+  , unitSettings_ghcUnitId         :: !UnitId
+  , unitSettings_ghcInternalUnitId :: !UnitId
+  }
 
 -- | Settings for other executables GHC calls.
 --


=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -142,6 +142,8 @@ initSettings top_dir = do
   ghcWithInterpreter <- getBooleanSetting "Use interpreter"
 
   baseUnitId <- getSetting_raw "base unit-id"
+  ghcUnitId <- getSetting_raw "Project Unit Id"
+  ghcInternalUnitId <- getSetting_raw "ghc-internal Unit Id"
 
   -- LibDir is optional. If not set, derive it from topDir. This allows
   -- bindists to work without explicitly setting LibDir, but gives us the
@@ -174,6 +176,8 @@ initSettings top_dir = do
     , sUnitSettings = UnitSettings
       {
         unitSettings_baseUnitId = stringToUnitId baseUnitId
+      , unitSettings_ghcUnitId = stringToUnitId ghcUnitId
+      , unitSettings_ghcInternalUnitId = stringToUnitId ghcInternalUnitId
       }
 
     , sToolSettings = ToolSettings


=====================================
distrib/configure.ac.in
=====================================
@@ -406,6 +406,12 @@ fi
 
 AC_SUBST(BaseUnitId)
 
+dnl The units supplied with the target libraries, as reported by ghc --info.
+GhcUnitId=@GhcUnitId@
+GhcInternalUnitId=@GhcInternalUnitId@
+AC_SUBST(GhcUnitId)
+AC_SUBST(GhcInternalUnitId)
+
 # We get caught by
 #     http://savannah.gnu.org/bugs/index.php?1516
 #     $(eval ...) inside conditionals causes errors


=====================================
hadrian/bindist/Makefile
=====================================
@@ -90,6 +90,8 @@ lib/settings : config.mk
 	@echo ',("RTS ways", "$(GhcRTSWays)")' >> $@
 	@echo ',("Relative Global Package DB", "package.conf.d")' >> $@
 	@echo ',("base unit-id", "$(BaseUnitId)")' >> $@
+	@echo ',("Project Unit Id", "$(GhcUnitId)")' >> $@
+	@echo ',("ghc-internal Unit Id", "$(GhcInternalUnitId)")' >> $@
 	@echo "]" >> $@
 
 lib/targets/default.target : config.mk default.target


=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -134,6 +134,8 @@ CrossCompilePrefix    = @CrossCompilePrefix@
 GhcUnregisterised     = @Unregisterised@
 EnableDistroToolchain = @EnableDistroToolchain@
 BaseUnitId            = @BaseUnitId@
+GhcUnitId             = @GhcUnitId@
+GhcInternalUnitId     = @GhcInternalUnitId@
 
 # The THREADED_RTS requires `BaseReg` to be in a register and the
 # `GhcUnregisterised` mode doesn't allow that.


=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -232,7 +232,7 @@ buildBinDistDir root conf@BindistConfig{..} = do
     let bindistSettings = bindistFilesDir -/- "lib" -/- "settings"
         bindistContext = vanillaContext library_stage compiler
     bindistSettingsContent <- interpretInContext bindistContext $
-        generateSettings bindistSettings False "package.conf.d"
+        generateSettings library_stage bindistSettings False "package.conf.d"
     writeFileAtomic bindistSettings bindistSettingsContent
 
     copyDirectory rtsIncludeDir         bindistFilesDir


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -7,6 +7,7 @@ module Rules.Generate (
 import Development.Shake.FilePath
 import qualified Data.Set as Set
 import Base
+import BindistConfig
 import qualified Context
 import Expression
 import Hadrian.Oracles.TextFile (lookupStageBuildConfig)
@@ -275,7 +276,7 @@ generateRules = do
                       then root -/- stageString stage' -/- "lib"
                       else prefix
                 relPkgDb = makeRelativeNoSysLink libTopDir pkgDb
-            go (generateSettings out True relPkgDb) out
+            go (generateSettings libStage out True relPkgDb) out
         (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out
 
   where
@@ -451,7 +452,9 @@ bindistRules = do
     , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised
     , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . targetStage)
     , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors
-    , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base
+    , interpolateVar "BaseUnitId" $ bindistUnitId base
+    , interpolateVar "GhcUnitId" $ bindistUnitId compiler
+    , interpolateVar "GhcInternalUnitId" $ bindistUnitId ghcInternal
     , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2
     , interpolateVar "TargetPlatformFull" (setting TargetPlatformFull)
     , interpolateVar "BuildPlatformFull" (setting BuildPlatformFull)
@@ -460,6 +463,9 @@ bindistRules = do
   where
     interp = interpretInContext (semiEmptyTarget Stage2)
     getTarget = interp . queryTarget Stage2
+    bindistUnitId pkg = do
+      stage <- library_stage <$> implicitBindistConfig
+      pkgUnitId stage pkg
 
 -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that
 -- the resulting 'String' is a valid C preprocessor identifier.
@@ -485,18 +491,18 @@ ghcWrapper stage  = do
 -- "package.conf.d"). Callers supply the correct relative path. For bindists
 -- the layout is known statically; for in-tree builds callers compute it. For
 -- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime.
-generateSettings :: FilePath -> Bool -> FilePath -> Expr String
-generateSettings settingsFile includeLibDir rel_pkg_db = do
+--
+-- @libraryStage@: the stage containing the target package database.
+generateSettings :: Stage -> FilePath -> Bool -> FilePath -> Expr String
+generateSettings libraryStage settingsFile includeLibDir rel_pkg_db = do
     ctx <- getContext
     stage <- getStage
 
-    -- The unit-id of the base package which is always linked against (#25382)
-    base_unit_id <- expr $ do
-      case stage of
-        Stage0 {} -> error "Unable to generate settings for stage0"
-        Stage1 -> pkgUnitId Stage1 base
-        Stage2 -> pkgUnitId Stage1 base
-        Stage3 -> pkgUnitId Stage2 base
+    -- These are the units supplied in the target package database, which can
+    -- differ from the host units linked into a cross compiler.
+    base_unit_id <- expr $ pkgUnitId libraryStage base
+    ghc_unit_id <- expr $ pkgUnitId libraryStage compiler
+    ghc_internal_unit_id <- expr $ pkgUnitId libraryStage ghcInternal
 
     -- For cross compilers, LibDir points to the succeeding stage's lib dir
     -- (which contains the target architecture's libraries). For non-cross,
@@ -519,6 +525,8 @@ generateSettings settingsFile includeLibDir rel_pkg_db = do
           , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays)
           , ("Relative Global Package DB", pure rel_pkg_db)
           , ("base unit-id", pure base_unit_id)
+          , ("Project Unit Id", pure ghc_unit_id)
+          , ("ghc-internal Unit Id", pure ghc_internal_unit_id)
           ]
           ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir])
     let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
@@ -555,7 +563,6 @@ generateConfigHs = do
     -- unit-id in both situations.
     cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage
 
-    cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage
     return $ unlines
         [ "module GHC.Settings.Config"
         , "  ( module GHC.Version"
@@ -565,7 +572,6 @@ generateConfigHs = do
         , "  , cBooterVersion"
         , "  , cStage"
         , "  , cProjectUnitId"
-        , "  , cGhcInternalUnitId"
         , "  ) where"
         , ""
         , "import GHC.Prelude.Basic"
@@ -589,9 +595,6 @@ generateConfigHs = do
         , ""
         , "cProjectUnitId :: String"
         , "cProjectUnitId = " ++ show cProjectUnitId
-        , ""
-        , "cGhcInternalUnitId :: String"
-        , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
         ]
   where
     stageString (Stage0 InTreeLibs) = "1"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa8f57da0ec92df26aca3a86860237ec...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa8f57da0ec92df26aca3a86860237ec...
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

    

Cheng Shao (＠TerrorJack)

tags

participants (1)