Mention which -Werror promoted a warning to an error

Previously -Werror or -Werror=flag printed warnings as usual and then
printed
these two lines:

    <no location info>: error:
    Failing due to -Werror.

This is not ideal: first, it's not clear which flag made one of the
warnings an
error. Second, warning messages are not modified in any way, so there's
no way
to know which warnings caused this error.

With this patch we (1) promote warning messages to error messages if a
relevant
-Werror is enabled (2) mention which -Werror is used during this
promotion.

Previously:

    [1 of 1] Compiling Main             ( test.hs, test.o )

    test.hs:9:10: warning: [-Wincomplete-patterns]
        Pattern match(es) are non-exhaustive
        In a case alternative: Patterns not matched: (C2 _)
      |
    9 | sInt s = case s of
      |          ^^^^^^^^^...

    test.hs:12:14: warning: [-Wmissing-fields]
        • Fields of ‘Rec’ not initialised: f2
        • In the first argument of ‘print’, namely ‘Rec {f1 =
1}’
          In the expression: print Rec {f1 = 1}
          In an equation for ‘main’: main = print Rec {f1 = 1}
       |
    12 | main = print Rec{ f1 = 1 }
       |              ^^^^^^^^^^^^^

    <no location info>: error:
    Failing due to -Werror.

Now:

    [1 of 1] Compiling Main             ( test.hs, test.o )

    test.hs:9:10: error: [-Wincomplete-patterns,
-Werror=incomplete-patterns]
        Pattern match(es) are non-exhaustive
        In a case alternative: Patterns not matched: (C2 _)
      |
    9 | sInt s = case s of
      |          ^^^^^^^^^...

    test.hs:12:14: error: [-Wmissing-fields, -Werror=missing-fields]
        • Fields of ‘Rec’ not initialised: f2
        • In the first argument of ‘print’, namely ‘Rec {f1 =
1}’
          In the expression: print Rec {f1 = 1}
          In an equation for ‘main’: main = print Rec {f1 = 1}
       |
    12 | main = print Rec{ f1 = 1 }
       |              ^^^^^^^^^^^^^

Test Plan: - Update old tests, add new tests if there aren't any
relevant tests

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3709

28 files changed, 169 insertions, 148 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index dac3136579..2be121e133 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -585,7 +585,12 @@ data GeneralFlag
 -- | Used when outputting warnings: if a reason is given, it is
 -- displayed. If a warning isn't controlled by a flag, this is made
 -- explicit at the point of use.
-data WarnReason = NoReason | Reason !WarningFlag
+data WarnReason
+  = NoReason
+  -- | Warning was enabled with the flag
+  | Reason !WarningFlag
+  -- | Warning was made an error because of -Werror or -Werror=WarningFlag
+  | ErrReason !(Maybe WarningFlag)
   deriving Show
 
 instance Outputable WarnReason where
@@ -594,6 +599,8 @@ instance Outputable WarnReason where
 instance ToJson WarnReason where
   json NoReason = JSNull
   json (Reason wf) = JSString (show wf)
+  json (ErrReason Nothing) = JSString "Opt_WarnIsError"
+  json (ErrReason (Just wf)) = JSString (show wf)
 
 data WarningFlag =
 -- See Note [Updating flag description in the User's Guide]
@@ -1827,34 +1834,48 @@ defaultLogAction dflags reason severity srcSpan style msg
       SevInteractive -> putStrSDoc msg style
       SevInfo        -> printErrs msg style
       SevFatal       -> printErrs msg style
-      _              -> do -- otherwise (i.e. SevError or SevWarning)
-                           hPutChar stderr '\n'
-                           caretDiagnostic <-
-                               if gopt Opt_DiagnosticsShowCaret dflags
-                               then getCaretDiagnostic severity srcSpan
-                               else pure empty
-                           printErrs (message $+$ caretDiagnostic)
-                               (setStyleColoured True style)
-                           -- careful (#2302): printErrs prints in UTF-8,
-                           -- whereas converting to string first and using
-                           -- hPutStr would just emit the low 8 bits of
-                           -- each unicode char.
-    where printOut   = defaultLogActionHPrintDoc  dflags stdout
-          printErrs  = defaultLogActionHPrintDoc  dflags stderr
-          putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
-          -- Pretty print the warning flag, if any (#10752)
-          message = mkLocMessageAnn flagMsg severity srcSpan msg
-          flagMsg = case reason of
-                        NoReason -> Nothing
-                        Reason flag -> (\spec -> "-W" ++ flagSpecName spec ++ flagGrp flag) <$>
-                                          flagSpecOf flag
-
-          flagGrp flag
-              | gopt Opt_ShowWarnGroups dflags =
-                    case smallestGroups flag of
-                        [] -> ""
-                        groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"
-              | otherwise = ""
+      SevWarning     -> printWarns
+      SevError       -> printWarns
+    where
+      printOut   = defaultLogActionHPrintDoc  dflags stdout
+      printErrs  = defaultLogActionHPrintDoc  dflags stderr
+      putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
+      -- Pretty print the warning flag, if any (#10752)
+      message = mkLocMessageAnn flagMsg severity srcSpan msg
+
+      printWarns = do
+        hPutChar stderr '\n'
+        caretDiagnostic <-
+            if gopt Opt_DiagnosticsShowCaret dflags
+            then getCaretDiagnostic severity srcSpan
+            else pure empty
+        printErrs (message $+$ caretDiagnostic)
+            (setStyleColoured True style)
+        -- careful (#2302): printErrs prints in UTF-8,
+        -- whereas converting to string first and using
+        -- hPutStr would just emit the low 8 bits of
+        -- each unicode char.
+
+      flagMsg =
+        case reason of
+          NoReason -> Nothing
+          Reason wflag -> do
+            spec <- flagSpecOf wflag
+            return ("-W" ++ flagSpecName spec ++ warnFlagGrp wflag)
+          ErrReason Nothing ->
+            return "-Werror"
+          ErrReason (Just wflag) -> do
+            spec <- flagSpecOf wflag
+            return $
+              "-W" ++ flagSpecName spec ++ warnFlagGrp wflag ++
+              ", -Werror=" ++ flagSpecName spec
+
+      warnFlagGrp flag
+          | gopt Opt_ShowWarnGroups dflags =
+                case smallestGroups flag of
+                    [] -> ""
+                    groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"
+          | otherwise = ""
 
 -- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
 defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index c0127b2a27..5883fe14da 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -14,7 +14,7 @@ module ErrUtils (
         Severity(..),
 
         -- * Messages
-        ErrMsg, errMsgDoc,
+        ErrMsg, errMsgDoc, errMsgSeverity, errMsgReason,
         ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary,
         WarnMsg, MsgDoc,
         Messages, ErrorMessages, WarningMessages,
@@ -32,7 +32,7 @@ module ErrUtils (
         emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning,
         mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg,
         mkPlainWarnMsg,
-        warnIsErrorMsg, mkLongWarnMsg,
+        mkLongWarnMsg,
 
         -- * Utilities
         doIfSet, doIfSet_dyn,
@@ -349,10 +349,6 @@ emptyMessages = (emptyBag, emptyBag)
 isEmptyMessages :: Messages -> Bool
 isEmptyMessages (warns, errs) = isEmptyBag warns && isEmptyBag errs
 
-warnIsErrorMsg :: DynFlags -> ErrMsg
-warnIsErrorMsg dflags
-    = mkPlainErrMsg dflags noSrcSpan (text "\nFailing due to -Werror.")
-
 errorsFound :: DynFlags -> Messages -> Bool
 errorsFound _dflags (_warns, errs) = not (isEmptyBag errs)
 
@@ -670,10 +666,15 @@ prettyPrintGhcErrors dflags
                           liftIO $ throwIO e
 
 -- | Checks if given 'WarnMsg' is a fatal warning.
-isWarnMsgFatal :: DynFlags -> WarnMsg -> Bool
+isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)
 isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}
-  = wopt_fatal wflag dflags
-isWarnMsgFatal dflags _ = gopt Opt_WarnIsError dflags
+  = if wopt_fatal wflag dflags
+      then Just (Just wflag)
+      else Nothing
+isWarnMsgFatal dflags _
+  = if gopt Opt_WarnIsError dflags
+      then Just Nothing
+      else Nothing
 
 traceCmd :: DynFlags -> String -> String -> IO a -> IO a
 -- trace the command (at two levels of verbosity)
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 9f1da3fcdd..f7a8140583 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -179,7 +179,7 @@ import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
 import TysWiredIn
 import Packages hiding  ( Version(..) )
 import CmdLineParser
-import DynFlags hiding  ( WarnReason(..) )
+import DynFlags
 import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
 import BasicTypes
 import IfaceSyn
@@ -322,11 +322,21 @@ instance Exception GhcApiError
 -- | Given a bag of warnings, turn them into an exception if
 -- -Werror is enabled, or print them out otherwise.
 printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
-printOrThrowWarnings dflags warns
-  | anyBag (isWarnMsgFatal dflags) warns
-  = throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
-  | otherwise
-  = printBagOfErrors dflags warns
+printOrThrowWarnings dflags warns = do
+  let (make_error, warns') =
+        mapAccumBagL
+          (\make_err warn ->
+            case isWarnMsgFatal dflags warn of
+              Nothing ->
+                (make_err, warn)
+              Just err_reason ->
+                (True, warn{ errMsgSeverity = SevError
+                           , errMsgReason = ErrReason err_reason
+                           }))
+          False warns
+  if make_error
+    then throwIO (mkSrcErr warns')
+    else printBagOfErrors dflags warns
 
 handleFlagWarnings :: DynFlags -> [Warn] -> IO ()
 handleFlagWarnings dflags warns = do
@@ -340,7 +350,7 @@ handleFlagWarnings dflags warns = do
   printOrThrowWarnings dflags bag
 
 -- Given a warn reason, check to see if it's associated -W opt is enabled
-shouldPrintWarning :: DynFlags -> WarnReason -> Bool
+shouldPrintWarning :: DynFlags -> CmdLineParser.WarnReason -> Bool
 shouldPrintWarning dflags ReasonDeprecatedFlag
   = wopt Opt_WarnDeprecatedFlags dflags
 shouldPrintWarning dflags ReasonUnrecognisedFlag
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 3c1473402c..6dc9f1d0d2 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -266,8 +266,7 @@ rnImportDecl this_mod
     -- the non-boot module depends on the compilation order, which
     -- is not deterministic.  The hs-boot test can show this up.
     dflags <- getDynFlags
-    warnIf NoReason
-           (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
+    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
            (warnRedundantSourceImport imp_mod_name)
     when (mod_safe && not (safeImportsOn dflags)) $
         addErr (text "safe import can't be used as Safe Haskell isn't on!"
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index a565959c9a..20c3d5cbb9 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -676,9 +676,9 @@ newClsInst overlap_mode dfun_name tvs theta clas tys
 
        ; oflag <- getOverlapFlag overlap_mode
        ; let inst = mkLocalInstance dfun oflag tvs' clas tys'
-       ; warnIf (Reason Opt_WarnOrphans)
-                (isOrphan (is_orphan inst))
-                (instOrphWarn inst)
+       ; warnIfFlag Opt_WarnOrphans
+                    (isOrphan (is_orphan inst))
+                    (instOrphWarn inst)
        ; return inst }
 
 instOrphWarn :: ClsInst -> SDoc
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index 3965675b77..ec099582a1 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -220,8 +220,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
         | let earlier_mods = [ mod
                              | (L _ (IEModuleContents (L _ mod))) <- ie_names ]
         , mod `elem` earlier_mods    -- Duplicate export of M
-        = do { warnIf (Reason Opt_WarnDuplicateExports) True
-                      (dupModuleExport mod) ;
+        = do { warnIfFlag Opt_WarnDuplicateExports True
+                          (dupModuleExport mod) ;
                return acc }
 
         | otherwise
@@ -234,9 +234,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                }
 
              ; checkErr exportValid (moduleNotImported mod)
-             ; warnIf (Reason Opt_WarnDodgyExports)
-                      (exportValid && null gre_prs)
-                      (nullModuleExport mod)
+             ; warnIfFlag Opt_WarnDodgyExports
+                          (exportValid && null gre_prs)
+                          (nullModuleExport mod)
 
              ; traceRn "efa" (ppr mod $$ ppr all_gres)
              ; addUsedGREs all_gres
@@ -594,9 +594,9 @@ check_occs ie occs names  -- 'names' are the entities specifed by 'ie'
             | name == name'   -- Duplicate export
             -- But we don't want to warn if the same thing is exported
             -- by two different module exports. See ticket #4478.
-            -> do { warnIf (Reason Opt_WarnDuplicateExports)
-                           (not (dupExport_ok name ie ie'))
-                           (dupExportWarn name_occ ie ie')
+            -> do { warnIfFlag Opt_WarnDuplicateExports
+                               (not (dupExport_ok name ie ie'))
+                               (dupExportWarn name_occ ie ie')
                   ; return occs }
 
             | otherwise    -- Same occ name but different names: an error
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 812ed0a266..a6a995de1a 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -82,7 +82,7 @@ module TcRnMonad(
   failWithTc, failWithTcM,
   checkTc, checkTcM,
   failIfTc, failIfTcM,
-  warnIf, warnTc, warnTcM,
+  warnIfFlag, warnIf, warnTc, warnTcM,
   addWarnTc, addWarnTcM, addWarn, addWarnAt, add_warn,
   tcInitTidyEnv, tcInitOpenTidyEnv, mkErrInfo,
 
@@ -1231,15 +1231,18 @@ failIfTcM True  err = failWithTcM err
 
 --         Warnings have no 'M' variant, nor failure
 
--- | Display a warning if a condition is met.
+-- | Display a warning if a condition is met,
 --   and the warning is enabled
-warnIf :: WarnReason -> Bool -> MsgDoc -> TcRn ()
-warnIf reason is_bad msg
-  = do { warn_on <- case reason of
-                       NoReason         -> return True
-                       Reason warn_flag -> woptM warn_flag
+warnIfFlag :: WarningFlag -> Bool -> MsgDoc -> TcRn ()
+warnIfFlag warn_flag is_bad msg
+  = do { warn_on <- woptM warn_flag
        ; when (warn_on && is_bad) $
-         addWarn reason msg }
+         addWarn (Reason warn_flag) msg }
+
+-- | Display a warning if a condition is met.
+warnIf :: Bool -> MsgDoc -> TcRn ()
+warnIf is_bad msg
+  = when is_bad (addWarn NoReason msg)
 
 -- | Display a warning if a condition is met.
 warnTc :: WarnReason -> Bool -> MsgDoc -> TcM ()
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index 803761b903..c898fd96bd 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -695,7 +695,7 @@ tcSpecPrag poly_id prag@(SpecSig fun_name hs_tys inl)
 -- However we want to use fun_name in the error message, since that is
 -- what the user wrote (Trac #8537)
   = addErrCtxt (spec_ctxt prag) $
-    do  { warnIf NoReason (not (isOverloadedTy poly_ty || isInlinePragma inl))
+    do  { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl))
                  (text "SPECIALISE pragma for non-overloaded function"
                   <+> quotes (ppr fun_name))
                   -- Note [SPECIALISE pragmas]
diff --git a/testsuite/tests/driver/T11429c.stderr b/testsuite/tests/driver/T11429c.stderr
index 19e269b2d0..6fee70dc04 100644
--- a/testsuite/tests/driver/T11429c.stderr
+++ b/testsuite/tests/driver/T11429c.stderr
@@ -1,5 +1,3 @@
 
-<no location info>: error: 
-Failing due to -Werror.
-
-on the commandline: warning: unrecognised warning flag: -Wfoobar
+on the commandline: error: [-Werror]
+    unrecognised warning flag: -Wfoobar
diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr
index ccbeb393cd..2d9fd5324c 100644
--- a/testsuite/tests/driver/werror.stderr
+++ b/testsuite/tests/driver/werror.stderr
@@ -1,31 +1,28 @@
 
-werror.hs:6:1: warning: [-Wmissing-signatures (in -Wall)]
+werror.hs:6:1: error: [-Wmissing-signatures (in -Wall), -Werror=missing-signatures]
     Top-level binding with no type signature: main :: IO ()
 
-werror.hs:7:13: warning: [-Wname-shadowing (in -Wall)]
+werror.hs:7:13: error: [-Wname-shadowing (in -Wall), -Werror=name-shadowing]
     This binding for ‘main’ shadows the existing binding
       defined at werror.hs:6:1
 
-werror.hs:7:13: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)]
+werror.hs:7:13: error: [-Wunused-local-binds (in -Wextra, -Wunused-binds), -Werror=unused-local-binds]
     Defined but not used: ‘main’
 
-werror.hs:8:1: warning: [-Wtabs (in -Wdefault)]
+werror.hs:8:1: error: [-Wtabs (in -Wdefault), -Werror=tabs]
     Tab character found here.
     Please use spaces instead.
 
-werror.hs:10:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+werror.hs:10:1: error: [-Wunused-top-binds (in -Wextra, -Wunused-binds), -Werror=unused-top-binds]
     Defined but not used: ‘f’
 
-werror.hs:10:1: warning: [-Wmissing-signatures (in -Wall)]
+werror.hs:10:1: error: [-Wmissing-signatures (in -Wall), -Werror=missing-signatures]
     Top-level binding with no type signature: f :: [a1] -> [a2]
 
-werror.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)]
+werror.hs:10:1: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
     Pattern match(es) are non-exhaustive
     In an equation for ‘f’: Patterns not matched: (_:_)
 
-werror.hs:11:1: warning: [-Woverlapping-patterns (in -Wdefault)]
+werror.hs:11:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overlapping-patterns]
     Pattern match is redundant
     In an equation for ‘f’: f [] = ...
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
index e3fbbcfd9e..9dc7af2782 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
@@ -1,6 +1,3 @@
 
-overloadedrecfldsfail05.hs:7:16: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+overloadedrecfldsfail05.hs:7:16: error: [-Wunused-top-binds (in -Wextra, -Wunused-binds), -Werror=unused-top-binds]
     Defined but not used: ‘foo’
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
index dc8a9d6bbc..3aae5c5061 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
@@ -10,22 +10,19 @@ OverloadedRecFldsFail06_A.hs:9:59: warning: [-Wunused-top-binds (in -Wextra, -Wu
     Defined but not used: ‘used_locally’
 [2 of 2] Compiling Main             ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o )
 
-overloadedrecfldsfail06.hs:7:1: warning: [-Wunused-imports (in -Wextra)]
+overloadedrecfldsfail06.hs:7:1: error: [-Wunused-imports (in -Wextra), -Werror=unused-imports]
     The import of ‘Unused(unused), V(x), U(y), MkV, Unused’
     from module ‘OverloadedRecFldsFail06_A’ is redundant
 
-overloadedrecfldsfail06.hs:8:1: warning: [-Wunused-imports (in -Wextra)]
+overloadedrecfldsfail06.hs:8:1: error: [-Wunused-imports (in -Wextra), -Werror=unused-imports]
     The qualified import of ‘OverloadedRecFldsFail06_A’ is redundant
       except perhaps to import instances from ‘OverloadedRecFldsFail06_A’
     To import instances alone, use: import OverloadedRecFldsFail06_A()
 
-overloadedrecfldsfail06.hs:9:1: warning: [-Wunused-imports (in -Wextra)]
+overloadedrecfldsfail06.hs:9:1: error: [-Wunused-imports (in -Wextra), -Werror=unused-imports]
     The qualified import of ‘V(y)’
     from module ‘OverloadedRecFldsFail06_A’ is redundant
 
-overloadedrecfldsfail06.hs:10:1: warning: [-Wunused-imports (in -Wextra)]
+overloadedrecfldsfail06.hs:10:1: error: [-Wunused-imports (in -Wextra), -Werror=unused-imports]
     The qualified import of ‘U(x), U’
     from module ‘OverloadedRecFldsFail06_A’ is redundant
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
index dac6d29ef2..0aa41a2962 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
@@ -1,9 +1,6 @@
 [1 of 2] Compiling OverloadedRecFldsFail11_A ( OverloadedRecFldsFail11_A.hs, OverloadedRecFldsFail11_A.o )
 [2 of 2] Compiling Main             ( overloadedrecfldsfail11.hs, overloadedrecfldsfail11.o )
 
-overloadedrecfldsfail11.hs:5:15: warning: [-Wdeprecations (in -Wdefault)]
+overloadedrecfldsfail11.hs:5:15: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
     In the use of ‘foo’ (imported from OverloadedRecFldsFail11_A):
     "Warning on a record field"
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
index 7cd9151c56..e17c9f8573 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
@@ -1,17 +1,14 @@
 [1 of 2] Compiling OverloadedRecFldsFail12_A ( OverloadedRecFldsFail12_A.hs, OverloadedRecFldsFail12_A.o )
 [2 of 2] Compiling Main             ( overloadedrecfldsfail12.hs, overloadedrecfldsfail12.o )
 
-overloadedrecfldsfail12.hs:10:11: warning: [-Wdeprecations (in -Wdefault)]
+overloadedrecfldsfail12.hs:10:11: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
     In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
     "Deprecated foo"
 
-overloadedrecfldsfail12.hs:10:20: warning: [-Wdeprecations (in -Wdefault)]
+overloadedrecfldsfail12.hs:10:20: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
     In the use of ‘bar’ (imported from OverloadedRecFldsFail12_A):
     "Deprecated bar"
 
-overloadedrecfldsfail12.hs:13:5: warning: [-Wdeprecations (in -Wdefault)]
+overloadedrecfldsfail12.hs:13:5: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
     In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
     "Deprecated foo"
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/patsyn/should_fail/UnliftedPSBind.stderr b/testsuite/tests/patsyn/should_fail/UnliftedPSBind.stderr
index 6b6b97710e..7bb123095f 100644
--- a/testsuite/tests/patsyn/should_fail/UnliftedPSBind.stderr
+++ b/testsuite/tests/patsyn/should_fail/UnliftedPSBind.stderr
@@ -1,8 +1,5 @@
 
-UnliftedPSBind.hs:12:9: warning: [-Wunbanged-strict-patterns (in -Wextra)]
+UnliftedPSBind.hs:12:9: error: [-Wunbanged-strict-patterns (in -Wextra), -Werror=unbanged-strict-patterns]
     Pattern bindings containing unlifted types should use
     an outermost bang pattern:
       P x = P 4#
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr b/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
index 8f20f91be9..e0f4606909 100644
--- a/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
+++ b/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
@@ -1,8 +1,5 @@
 
-unboxed-bind.hs:11:11: warning: [-Wunbanged-strict-patterns (in -Wextra)]
+unboxed-bind.hs:11:11: error: [-Wunbanged-strict-patterns (in -Wextra), -Werror=unbanged-strict-patterns]
     Pattern bindings containing unlifted types should use
     an outermost bang pattern:
       P arg = x
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr
index b3f1145481..0779538b1e 100644
--- a/testsuite/tests/rename/should_fail/T5892a.stderr
+++ b/testsuite/tests/rename/should_fail/T5892a.stderr
@@ -1,10 +1,7 @@
 
-T5892a.hs:12:8: warning: [-Wmissing-fields (in -Wdefault)]
+T5892a.hs:12:8: error: [-Wmissing-fields (in -Wdefault), -Werror=missing-fields]
     • Fields of ‘Node’ not initialised: subForest
     • In the expression: Node {..}
       In the expression: let rootLabel = [] in Node {..}
       In an equation for ‘foo’:
           foo (Node {..}) = let rootLabel = ... in Node {..}
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
index 7ef83389a8..2766f41512 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
@@ -1,6 +1,3 @@
 
-SafeFlags18.hs:1:16:
-    Warning: -fpackage-trust ignored; must be specified with a Safe Haskell flag
-
-<no location info>: 
-Failing due to -Werror.
+SafeFlags18.hs:1:16: error: [-Werror]
+    -fpackage-trust ignored; must be specified with a Safe Haskell flag
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
index f4e46c2aa8..ea03484823 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
@@ -1,10 +1,7 @@
 
-SafeFlags23.hs:1:16: warning: [-Wunsafe]
+SafeFlags23.hs:1:16: error: [-Wunsafe, -Werror=unsafe]
     ‘SafeFlags22’ has been inferred as unsafe!
     Reason:
         SafeFlags23.hs:7:1: error:
             System.IO.Unsafe: Can't be safely imported!
             The module itself isn't safe.
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
index bc27ac2a4f..45047aa019 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
@@ -1,6 +1,3 @@
 
-SafeFlags26.hs:1:16: warning: [-Wsafe]
+SafeFlags26.hs:1:16: error: [-Wsafe, -Werror=safe]
     ‘SafeFlags26’ has been inferred as safe!
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr b/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
index 8010407cc7..45701f2529 100644
--- a/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
+++ b/testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
@@ -2,7 +2,7 @@
 [2 of 3] Compiling SH_Overlap7_A    ( SH_Overlap7_A.hs, SH_Overlap7_A.o )
 [3 of 3] Compiling SH_Overlap7      ( SH_Overlap7.hs, SH_Overlap7.o )
 
-SH_Overlap7.hs:1:16: warning: [-Wunsafe]
+SH_Overlap7.hs:1:16: error: [-Wunsafe, -Werror=unsafe]
     ‘SH_Overlap7’ has been inferred as unsafe!
     Reason:
         SH_Overlap7.hs:14:8: warning:
@@ -17,6 +17,3 @@ SH_Overlap7.hs:1:16: warning: [-Wunsafe]
                 instance C [a] -- Defined at SH_Overlap7.hs:10:10
             • In the expression: f ([1, 2, 3, 4] :: [Int])
               In an equation for ‘test’: test = f ([1, 2, 3, 4] :: [Int])
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
index 74cf60dc54..f05bf7fa8c 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
@@ -1,9 +1,6 @@
 
-UnsafeInfered12.hs:2:16: warning: [-Wunsafe]
+UnsafeInfered12.hs:2:16: error: [-Wunsafe, -Werror=unsafe]
     ‘UnsafeInfered12’ has been inferred as unsafe!
     Reason:
         UnsafeInfered12.hs:1:14:
             -XTemplateHaskell is not allowed in Safe Haskell
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/typecheck/should_fail/T3966.stderr b/testsuite/tests/typecheck/should_fail/T3966.stderr
index f79574696b..cab45c21e6 100644
--- a/testsuite/tests/typecheck/should_fail/T3966.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3966.stderr
@@ -1,8 +1,5 @@
 
-T3966.hs:5:16: warning:
+T3966.hs:5:16: error: [-Werror]
     • Ignoring unusable UNPACK pragma on the first argument of ‘Foo’
     • In the definition of data constructor ‘Foo’
       In the data type declaration for ‘Foo’
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/typecheck/should_fail/tcfail204.stderr b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
index a3e8eec3d6..8083ffce60 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail204.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
@@ -1,5 +1,5 @@
 
-tcfail204.hs:10:7: warning: [-Wtype-defaults (in -Wall)]
+tcfail204.hs:10:7: error: [-Wtype-defaults (in -Wall), -Werror=type-defaults]
     • Defaulting the following constraints to type ‘Double’
         (RealFrac a0)
           arising from a use of ‘ceiling’ at tcfail204.hs:10:7-17
@@ -7,6 +7,3 @@ tcfail204.hs:10:7: warning: [-Wtype-defaults (in -Wall)]
           arising from the literal ‘6.3’ at tcfail204.hs:10:15-17
     • In the expression: ceiling 6.3
       In an equation for ‘foo’: foo = ceiling 6.3
-
-<no location info>: error: 
-Failing due to -Werror.
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail.stderr b/testsuite/tests/warnings/should_fail/WerrorFail.stderr
index 90c6c2db3a..00272ef2fe 100644
--- a/testsuite/tests/warnings/should_fail/WerrorFail.stderr
+++ b/testsuite/tests/warnings/should_fail/WerrorFail.stderr
@@ -1,6 +1,4 @@
-WerrorFail.hs:6:1: warning: [-Wincomplete-patterns (in -Wextra)]
+
+WerrorFail.hs:6:1: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
     Pattern match(es) are non-exhaustive
     In an equation for ‘foo’: Patterns not matched: (Just _)
-
-<no location info>: 
-Failing due to -Werror.
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail2.hs b/testsuite/tests/warnings/should_fail/WerrorFail2.hs
new file mode 100644
index 0000000000..c65f713738
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/WerrorFail2.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -Wall
+                -Werror=incomplete-patterns
+                -Werror=missing-fields #-}
+
+module Werror03 where
+
+data Rec = Rec
+  { f1 :: Int
+  , f2 :: Int
+  } deriving (Show)
+
+data S = C1 Int | C2 Int
+
+-- incomplete pattern
+sInt s = case s of
+           C1 i -> i
+
+-- missing field
+printRec = print Rec{ f1 = 1 }
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail2.stderr b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
new file mode 100644
index 0000000000..f6105d1bfb
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
@@ -0,0 +1,16 @@
+
+WerrorFail2.hs:15:1: warning: [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: sInt :: S -> Int
+
+WerrorFail2.hs:15:10: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
+    Pattern match(es) are non-exhaustive
+    In a case alternative: Patterns not matched: (C2 _)
+
+WerrorFail2.hs:19:1: warning: [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: printRec :: IO ()
+
+WerrorFail2.hs:19:18: error: [-Wmissing-fields (in -Wdefault), -Werror=missing-fields]
+    • Fields of ‘Rec’ not initialised: f2
+    • In the first argument of ‘print’, namely ‘Rec {f1 = 1}’
+      In the expression: print Rec {f1 = 1}
+      In an equation for ‘printRec’: printRec = print Rec {f1 = 1}
diff --git a/testsuite/tests/warnings/should_fail/all.T b/testsuite/tests/warnings/should_fail/all.T
index 73117a957c..7d0dc4295f 100644
--- a/testsuite/tests/warnings/should_fail/all.T
+++ b/testsuite/tests/warnings/should_fail/all.T
@@ -9,6 +9,7 @@ def normalise_whitespace_carefully(s):
                      for line in s.split('\n'))
 
 test('WerrorFail', normal, compile_fail, [''])
+test('WerrorFail2', normal, compile_fail, [''])
 test('CaretDiagnostics1',
      [normalise_whitespace_fun(normalise_whitespace_carefully)],
      compile_fail,