Backport: Fix for #18955 to GHC 9.0

Since MR !554 (#15454) GHCi automatically enabled the flag `-fobject-code` on
any module using the UnboxedTuples or UnboxedSum extensions.

MR !1553 (#16876) allowed to inhibit the automatic compiling to object-code
of these modules by setting the `fbyte-code` flag. However, it assigned 2
different semantics to this flag and introduced the regression described in
issue #18955.

This MR fixes this regression by unsetting the internal flag
`Opt_ByteCodeIfUnboxed` before it's copied to DynFlags local to the module.

8 files changed, 33 insertions, 6 deletions

diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index f5f642ce46..c30fe2c16d 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -273,7 +273,7 @@ data GeneralFlag
    | Opt_SingleLibFolder
    | Opt_KeepCAFs
    | Opt_KeepGoing
-   | Opt_ByteCode
+   | Opt_ByteCodeIfUnboxed
    | Opt_LinkRts
 
    -- output style opts
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 7ee9035ad0..d431744d07 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -2230,7 +2230,7 @@ enableCodeGenForUnboxedTuplesOrSums =
   where
     condition ms =
       unboxed_tuples_or_sums (ms_hspp_opts ms) &&
-      not (gopt Opt_ByteCode (ms_hspp_opts ms)) &&
+      not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) &&
       (isBootSummary ms == NotBoot)
     unboxed_tuples_or_sums d =
       xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 76b9198ef8..44f9d02607 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3091,10 +3091,10 @@ dynamic_flags_deps = [
 
   , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->
                   d { ghcLink=NoLink }) >> setTarget HscNothing))
-  , make_ord_flag defFlag "fbyte-code"
-      (noArgM $ \dflags -> do
-        setTarget HscInterpreted
-        pure $ gopt_set dflags Opt_ByteCode)
+  , make_ord_flag defFlag "fbyte-code"       (NoArg ((upd $ \d ->
+      -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955.
+      -- See the comments for resetOptByteCodeIfUnboxed for more details.
+      gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted))
   , make_ord_flag defFlag "fobject-code"     $ NoArg $ do
       dflags <- liftEwM getCmdLineState
       setTarget $ defaultObjectTarget dflags
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index aeb209735f..7e1b572650 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1941,6 +1941,7 @@ reloadModuleDefer = wrapDeferTypeErrors . reloadModule
 -- sessions.
 doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
 doLoadAndCollectInfo retain_context howmuch = do
+  resetOptByteCodeIfUnboxed                                 -- #18955
   doCollectInfo <- isOptionSet CollectInfo
 
   doLoad retain_context howmuch >>= \case
@@ -1953,6 +1954,24 @@ doLoadAndCollectInfo retain_context howmuch = do
       return Succeeded
     flag -> return flag
 
+-- An `OPTIONS_GHC -fbyte-code` pragma at the beginning of a module sets the
+-- flag `Opt_ByteCodeIfUnboxed` locally for this module. This stops automatic
+-- compilation of this module to object code, if the module uses (or depends
+-- on a module using) the UnboxedSums/Tuples extensions.
+-- However a GHCi `:set -fbyte-code` command sets the flag Opt_ByteCodeIfUnboxed
+-- globally to all modules. This triggered #18955. This function unsets the
+-- flag from the global DynFlags before they are copied to the module-specific
+-- DynFlags.
+-- This is a temporary workaround until GHCi will support unboxed tuples and
+-- unboxed sums.
+resetOptByteCodeIfUnboxed :: GhciMonad m => m ()
+resetOptByteCodeIfUnboxed = do
+  dflags <- getDynFlags
+  when (gopt Opt_ByteCodeIfUnboxed dflags) $ do
+    _ <- GHC.setProgramDynFlags $ gopt_unset dflags Opt_ByteCodeIfUnboxed
+    pure ()
+  pure ()
+
 doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
 doLoad retain_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because
diff --git a/testsuite/tests/ghci/scripts/T18955.hs b/testsuite/tests/ghci/scripts/T18955.hs
new file mode 100644
index 0000000000..c891f91cd1
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T18955.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Hello World"
diff --git a/testsuite/tests/ghci/scripts/T18955.script b/testsuite/tests/ghci/scripts/T18955.script
new file mode 100644
index 0000000000..7832814eb7
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T18955.script
@@ -0,0 +1,3 @@
+:set -v1
+:set -fbyte-code
+:l T18955
diff --git a/testsuite/tests/ghci/scripts/T18955.stdout b/testsuite/tests/ghci/scripts/T18955.stdout
new file mode 100644
index 0000000000..e799d6cf80
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T18955.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main             ( T18955.hs, interpreted )
+Ok, one module loaded.
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 4e6214e085..5e34df6041 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -318,3 +318,4 @@ test('T17403', normal, ghci_script, ['T17403.script'])
 test('T17431', normal, ghci_script, ['T17431.script'])
 test('T17549', normal, ghci_script, ['T17549.script'])
 test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script'])
+test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script'])