diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2019-01-20 20:58:01 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2019-03-29 17:03:56 -0400 |
| commit | 1dfc88649e44df193cbe0659bdb0599ca546cf7a (patch) | |
| tree | 6e200e4ffc03bfba4591a959ebf1f9f10935dd4f | |
| parent | 2f196a5cbed8f92ee0c723a3cb14b2523f1a484b (diff) | |
| download | haskell-1dfc88649e44df193cbe0659bdb0599ca546cf7a.tar.gz | |
Don't overwrite the set log_action when using --interactive
-ddump-json didn't work with --interactive as --interactive overwrote
the log_action in terms of defaultLogAction.
Reviewers: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14078
Differential Revision: https://phabricator.haskell.org/D4533
(cherry picked from commit 10faf44d97095b2f8516b6d449d266f6889dcd70)
| -rw-r--r-- | ghc/GHCi/UI.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index f9ee7ce0b2..75d16d4c14 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -440,7 +440,10 @@ interactiveUI config srcs maybe_exprs = do lastErrLocationsRef <- liftIO $ newIORef [] progDynFlags <- GHC.getProgramDynFlags _ <- GHC.setProgramDynFlags $ - progDynFlags { log_action = ghciLogAction lastErrLocationsRef } + -- Ensure we don't override the user's log action lest we break + -- -ddump-json (#14078) + progDynFlags { log_action = ghciLogAction (log_action progDynFlags) + lastErrLocationsRef } when (isNothing maybe_exprs) $ do -- Only for GHCi (not runghc and ghc -e): @@ -504,9 +507,10 @@ resetLastErrorLocations = do st <- getGHCiState liftIO $ writeIORef (lastErrorLocations st) [] -ghciLogAction :: IORef [(FastString, Int)] -> LogAction -ghciLogAction lastErrLocations dflags flag severity srcSpan style msg = do - defaultLogAction dflags flag severity srcSpan style msg +ghciLogAction :: LogAction -> IORef [(FastString, Int)] -> LogAction +ghciLogAction old_log_action lastErrLocations + dflags flag severity srcSpan style msg = do + old_log_action dflags flag severity srcSpan style msg case severity of SevError -> case srcSpan of RealSrcSpan rsp -> modifyIORef lastErrLocations |