Don't overwrite the set log_action when using --interactive cherry-pick-10faf44d
authorMatthew Pickering <matthewtpickering@gmail.com>
Mon, 21 Jan 2019 01:58:01 +0000 (01:58 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Mon, 1 Apr 2019 06:43:57 +0000 (02:43 -0400)
-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)

ghc/GHCi/UI.hs

index 10ca511..abb3d78 100644 (file)
@@ -445,7 +445,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):
@@ -536,9 +539,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