diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 39 | ||||
| -rw-r--r-- | docs/users_guide/using.rst | 12 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/A.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/B.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/C.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/Makefile | 3 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/prog018.T | 3 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/prog018.script | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/prog018/prog018.stdout | 23 |
10 files changed, 105 insertions, 2 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 78be688ec3..28d8bf8eed 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -582,6 +582,7 @@ data GeneralFlag -- output style opts | Opt_ErrorSpans -- Include full span info in error messages, -- instead of just the start position. + | Opt_DeferDiagnostics | Opt_DiagnosticsShowCaret -- Show snippets of offending code | Opt_PprCaseAsLet | Opt_PprShowTicks @@ -4101,6 +4102,7 @@ fFlagsDeps = [ flagSpec "stg-cse" Opt_StgCSE, flagSpec "stg-lift-lams" Opt_StgLiftLams, flagSpec "cpr-anal" Opt_CprAnal, + flagSpec "defer-diagnostics" Opt_DeferDiagnostics, flagSpec "defer-type-errors" Opt_DeferTypeErrors, flagSpec "defer-typed-holes" Opt_DeferTypedHoles, flagSpec "defer-out-of-scope-variables" Opt_DeferOutOfScopeVariables, diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index ae27d4e7fe..85925b3ef9 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -395,8 +395,8 @@ load' how_much mHscMessage mod_graph = do | otherwise = upsweep setSession hsc_env{ hsc_HPT = emptyHomePackageTable } - (upsweep_ok, modsUpswept) - <- upsweep_fn mHscMessage pruned_hpt stable_mods cleanup mg + (upsweep_ok, modsUpswept) <- withDeferredDiagnostics $ + upsweep_fn mHscMessage pruned_hpt stable_mods cleanup mg -- Make modsDone be the summaries for each home module now -- available; this should equal the domain of hpt3. @@ -2457,6 +2457,41 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) -- Error messages ----------------------------------------------------------------------------- +-- Defer and group warning, error and fatal messages so they will not get lost +-- in the regular output. +withDeferredDiagnostics :: GhcMonad m => m a -> m a +withDeferredDiagnostics f = do + dflags <- getDynFlags + if not $ gopt Opt_DeferDiagnostics dflags + then f + else do + warnings <- liftIO $ newIORef [] + errors <- liftIO $ newIORef [] + fatals <- liftIO $ newIORef [] + + let deferDiagnostics _dflags !reason !severity !srcSpan !style !msg = do + let action = putLogMsg dflags reason severity srcSpan style msg + case severity of + SevWarning -> atomicModifyIORef' warnings $ \i -> (action: i, ()) + SevError -> atomicModifyIORef' errors $ \i -> (action: i, ()) + SevFatal -> atomicModifyIORef' fatals $ \i -> (action: i, ()) + _ -> action + + printDeferredDiagnostics = liftIO $ + forM_ [warnings, errors, fatals] $ \ref -> do + -- This IORef can leak when the dflags leaks, so let us always + -- reset the content. + actions <- atomicModifyIORef' ref $ \i -> ([], i) + sequence_ $ reverse actions + + setLogAction action = modifySession $ \hsc_env -> + hsc_env{ hsc_dflags = (hsc_dflags hsc_env){ log_action = action } } + + gbracket + (setLogAction deferDiagnostics) + (\_ -> setLogAction (log_action dflags) >> printDeferredDiagnostics) + (\_ -> f) + noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg -- ToDo: we don't have a proper line number for this error noModError dflags loc wanted_mod err diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 83eeb51eed..d11dedfb9a 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -931,6 +931,18 @@ messages and in GHCi: in a’ or by using the flag -fno-warn-unused-do-bind +.. ghc-flag:: -fdefer-diagnostics + :shortdesc: Defer and group diagnostic messages by severity + :type: dynamic + :category: verbosity + + Causes GHC to group diagnostic messages by severity and output them after + other messages when building a multi-module Haskell program. This flag can + make diagnostic messages more visible when used in conjunction with + :ghc-flag:`--make` and :ghc-flag:`-j[⟨n⟩]`. Otherwise, it can be hard to + find the relevant errors or likely to ignore the warnings when they are + mixed with many other messages. + .. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩ :shortdesc: Use colors in error messages :type: dynamic diff --git a/testsuite/tests/ghci/prog018/A.hs b/testsuite/tests/ghci/prog018/A.hs new file mode 100644 index 0000000000..aebfa35614 --- /dev/null +++ b/testsuite/tests/ghci/prog018/A.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -Wunused-matches #-} +module A where + +incompletePattern :: Int -> Int +incompletePattern 0 = 0 + +unusedMatches :: Int -> Int +unusedMatches x = 0 diff --git a/testsuite/tests/ghci/prog018/B.hs b/testsuite/tests/ghci/prog018/B.hs new file mode 100644 index 0000000000..ebfdd6d733 --- /dev/null +++ b/testsuite/tests/ghci/prog018/B.hs @@ -0,0 +1,7 @@ +{-# OPTIONS_GHC -Wunused-imports #-} +module B + ( module A + ) where + +import A +import Data.List diff --git a/testsuite/tests/ghci/prog018/C.hs b/testsuite/tests/ghci/prog018/C.hs new file mode 100644 index 0000000000..c722f9554c --- /dev/null +++ b/testsuite/tests/ghci/prog018/C.hs @@ -0,0 +1,6 @@ +module C where + +import B + +foo :: () +foo = variableNotInScope diff --git a/testsuite/tests/ghci/prog018/Makefile b/testsuite/tests/ghci/prog018/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/ghci/prog018/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghci/prog018/prog018.T b/testsuite/tests/ghci/prog018/prog018.T new file mode 100644 index 0000000000..0d9e7813a6 --- /dev/null +++ b/testsuite/tests/ghci/prog018/prog018.T @@ -0,0 +1,3 @@ +# testcase for warning and error messages from :load +test('prog018', [combined_output, extra_files(['A.hs', 'B.hs', 'C.hs'])], + ghci_script, ['prog018.script']) diff --git a/testsuite/tests/ghci/prog018/prog018.script b/testsuite/tests/ghci/prog018/prog018.script new file mode 100644 index 0000000000..108a84de04 --- /dev/null +++ b/testsuite/tests/ghci/prog018/prog018.script @@ -0,0 +1,4 @@ +:set -fdefer-diagnostics +:set -v1 +:load C.hs +:reload diff --git a/testsuite/tests/ghci/prog018/prog018.stdout b/testsuite/tests/ghci/prog018/prog018.stdout new file mode 100644 index 0000000000..daa722e436 --- /dev/null +++ b/testsuite/tests/ghci/prog018/prog018.stdout @@ -0,0 +1,23 @@ +[1 of 3] Compiling A ( A.hs, interpreted ) +[2 of 3] Compiling B ( B.hs, interpreted ) +[3 of 3] Compiling C ( C.hs, interpreted ) + +A.hs:5:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘incompletePattern’: + Patterns not matched: p where p is not one of {0} + +A.hs:8:15: warning: [-Wunused-matches (in -Wextra)] + Defined but not used: ‘x’ + +B.hs:7:1: warning: [-Wunused-imports (in -Wextra)] + The import of ‘Data.List’ is redundant + except perhaps to import instances from ‘Data.List’ + To import instances alone, use: import Data.List() + +C.hs:6:7: error: Variable not in scope: variableNotInScope :: () +Failed, two modules loaded. +[3 of 3] Compiling C ( C.hs, interpreted ) + +C.hs:6:7: error: Variable not in scope: variableNotInScope :: () +Failed, two modules loaded. |