hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468.

In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db`
was already given correctly to tell `stage0/bin/ghc-pkg` that it should use
the package DB in `stage1/`.

However, `ghc` needs to be given this information as well, not only `ghc-pkg`!
Until now that was not the case; the package DB in `stage0` was given to
`ghc` instead.
This was wrong, because there is no binary compatibility guarantee that says
that the `stage0` DB's `package.cache` (which is written by the
stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg`
from the source code tree.

As a result, when trying to add fields to `InstalledPackageInfo` that get
serialised into / deserialised from the `package.cache`, errors like

    _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!)

would appear. This was because the `stage0/bin/ghc would try to
deserialise the newly added fields from
`_build/stage0/lib/package.conf.d/package.cache`, but they were not in there
because the system `ghc-pkg` doesn't know about them and thus didn't write them
there.
It would try to do that because any GHC by default tries to read the global
package db in `../lib/package.conf.d/package.cache`.
For `stage0/bin/ghc` that *can never work* as explained above, so we
must disable this default via `-no-global-package-db` and give it the
correct package DB explicitly.

This is the same problem as #16534, and the same fix as in MR !780
(but in another context; that one was for developers trying out the
`stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix
is for a `cabal configure` invocation).

I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`,
and have fixed that in this commit as well.
It only worked until now because nobody tried to add a new ghc-pkg `.conf`
field since the introduction of Hadrian.

2 files changed, 14 insertions, 1 deletions

diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 850bb87de4..2ee1e88e16 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -218,7 +218,11 @@ ghcWrapper stage  = do
     ghcPath <- expr $ (</>) <$> topDirectory
                             <*> programPath (vanillaContext (pred stage) ghc)
     return $ unwords $ map show $ [ ghcPath ]
-                               ++ [ "-package-db " ++ dbPath | stage == Stage1 ]
+                               ++ (if stage == Stage1
+                                     then ["-no-global-package-db"
+                                          , "-package-db " ++ dbPath
+                                          ]
+                                     else [])
                                ++ [ "$@" ]
 
 -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that
diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs
index 19c3c7e850..f101b44d46 100644
--- a/hadrian/src/Settings/Builders/Cabal.hs
+++ b/hadrian/src/Settings/Builders/Cabal.hs
@@ -49,6 +49,7 @@ cabalBuilderArgs = builder (Cabal Setup) ? do
             , arg $ "${pkgroot}/../../docs/html/libraries/" ++ pkgName pkg
 
             , withStaged $ Ghc CompileHs
+            , withBuilderArgs (Ghc CompileHs stage)
             , withStaged (GhcPkg Update)
             , withBuilderArgs (GhcPkg Update stage)
             , bootPackageDatabaseArgs
@@ -159,6 +160,14 @@ withBuilderKey b = case b of
 -- | Add arguments to builders if needed.
 withBuilderArgs :: Builder -> Args
 withBuilderArgs b = case b of
+    Ghc _ stage -> do
+      top   <- expr topDirectory
+      pkgDb <- expr $ packageDbPath stage
+      -- GHC starts with a nonempty package DB stack, so we need to tell it
+      -- to empty the stack first for it to truly consider only the package
+      -- DB we explicitly provide. See #17468.
+      notStage0 ? arg ("--ghc-option=-no-global-package-db") <>
+                  arg ("--ghc-option=-package-db=" ++ top -/- pkgDb)
     GhcPkg _ stage -> do
       top   <- expr topDirectory
       pkgDb <- expr $ packageDbPath stage