diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 10 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 2 | ||||
| -rw-r--r-- | ghc/GHCi/UI.hs | 20 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T18955.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T18955.script | 3 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T18955.stdout | 2 | ||||
| -rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
7 files changed, 34 insertions, 6 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5fb1449f22..2ea0b3d5e9 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -658,7 +658,7 @@ data GeneralFlag | Opt_SingleLibFolder | Opt_KeepCAFs | Opt_KeepGoing - | Opt_ByteCode + | Opt_ByteCodeIfUnboxed -- output style opts | Opt_ErrorSpans -- Include full span info in error messages, @@ -3781,10 +3781,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/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 6599da07f4..dc8344d14d 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -2185,7 +2185,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)) && not (isBootSummary ms) unboxed_tuples_or_sums d = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index bf1eddfa5b..071cfe1116 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1935,6 +1935,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 @@ -1947,6 +1948,25 @@ 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 GHC 9.0.1, which allows disabling +-- this feature at a finer-grained level by way of the +-- -fno-object-code-if-unboxed flag. See !4531. +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 094f101abb..5b4e180d54 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -311,3 +311,4 @@ test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) +test('T18955', [extra_hc_opts("-fobject-code")], ghci_script, ['T18955.script']) |