Add -fdefer-diagnostics to defer and group diagnostic messages in make-mode
authorZejun Wu <watashi@fb.com>
Fri, 28 Dec 2018 08:10:22 +0000 (00:10 -0800)
committerBen Gamari <ben@smart-cactus.org>
Thu, 31 Jan 2019 17:46:51 +0000 (12:46 -0500)
When loading many modules in parallel there can a lot of warnings and
errors get mixed up with regular output. When the compilation fails,
the relevant error message can be thousands of lines backward and is
hard to find. When the compilation successes, warning message is likely
to be ignored as it is not seen. We can address this by deferring the
warning and error message after the compilation. We also put errors
after warnings so it is more visible.

This idea was originally proposed by Bartosz Nitka in
https://phabricator.haskell.org/D4219.

compiler/main/DynFlags.hs
compiler/main/GhcMake.hs
docs/users_guide/using.rst
testsuite/tests/ghci/prog018/A.hs [new file with mode: 0644]
testsuite/tests/ghci/prog018/B.hs [new file with mode: 0644]
testsuite/tests/ghci/prog018/C.hs [new file with mode: 0644]
testsuite/tests/ghci/prog018/Makefile [new file with mode: 0644]
testsuite/tests/ghci/prog018/prog018.T [new file with mode: 0644]
testsuite/tests/ghci/prog018/prog018.script [new file with mode: 0644]
testsuite/tests/ghci/prog018/prog018.stdout [new file with mode: 0644]

index 78be688..28d8bf8 100644 (file)
@@ -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,
index ae27d4e..85925b3 100644 (file)
@@ -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
index 83eeb51..d11dedf 100644 (file)
@@ -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 (file)
index 0000000..aebfa35
--- /dev/null
@@ -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 (file)
index 0000000..ebfdd6d
--- /dev/null
@@ -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 (file)
index 0000000..c722f95
--- /dev/null
@@ -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 (file)
index 0000000..9101fbd
--- /dev/null
@@ -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 (file)
index 0000000..0d9e781
--- /dev/null
@@ -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 (file)
index 0000000..108a84d
--- /dev/null
@@ -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 (file)
index 0000000..daa722e
--- /dev/null
@@ -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.