Cheng Shao pushed to branch wip/fix-cross-ghc-info-unit-id at Glasgow Haskell Compiler / GHC Commits: b4eea0be by Cheng Shao at 2026-10-11T08:38:58+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 unid 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/b4eea0bef71863aab3244879a92822e4... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4eea0bef71863aab3244879a92822e4... 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