Mention which -Werror promoted a warning to an error
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Tue, 11 Jul 2017 19:41:20 +0000 (15:41 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 11 Jul 2017 20:32:43 +0000 (16:32 -0400)
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:
compiler/main/DynFlags.hs
compiler/main/ErrUtils.hs
compiler/main/HscTypes.hs
compiler/rename/RnNames.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcRnExports.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcSigs.hs
testsuite/tests/driver/T11429c.stderr
testsuite/tests/driver/werror.stderr
testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
testsuite/tests/patsyn/should_fail/UnliftedPSBind.stderr
testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
testsuite/tests/rename/should_fail/T5892a.stderr
testsuite/tests/safeHaskell/flags/SafeFlags18.stderr
testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
testsuite/tests/typecheck/should_fail/T3966.stderr
testsuite/tests/typecheck/should_fail/tcfail204.stderr
testsuite/tests/warnings/should_fail/WerrorFail.stderr
testsuite/tests/warnings/should_fail/WerrorFail2.hs [new file with mode: 0644]
testsuite/tests/warnings/should_fail/WerrorFail2.stderr [new file with mode: 0644]
testsuite/tests/warnings/should_fail/all.T

index dac3136..2be121e 100644 (file)
@@ -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.
 -- | 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
   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)
 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]
 
 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
       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 ()
 
 -- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
 defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
index c0127b2..5883fe1 100644 (file)
@@ -14,7 +14,7 @@ module ErrUtils (
         Severity(..),
 
         -- * Messages
         Severity(..),
 
         -- * Messages
-        ErrMsg, errMsgDoc,
+        ErrMsg, errMsgDoc, errMsgSeverity, errMsgReason,
         ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary,
         WarnMsg, MsgDoc,
         Messages, ErrorMessages, WarningMessages,
         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,
         emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning,
         mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg,
         mkPlainWarnMsg,
-        warnIsErrorMsg, mkLongWarnMsg,
+        mkLongWarnMsg,
 
         -- * Utilities
         doIfSet, doIfSet_dyn,
 
         -- * Utilities
         doIfSet, doIfSet_dyn,
@@ -349,10 +349,6 @@ emptyMessages = (emptyBag, emptyBag)
 isEmptyMessages :: Messages -> Bool
 isEmptyMessages (warns, errs) = isEmptyBag warns && isEmptyBag errs
 
 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)
 
 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.
                           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}
 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)
 
 traceCmd :: DynFlags -> String -> String -> IO a -> IO a
 -- trace the command (at two levels of verbosity)
index 9f1da3f..f7a8140 100644 (file)
@@ -179,7 +179,7 @@ import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
 import TysWiredIn
 import Packages hiding  ( Version(..) )
 import CmdLineParser
 import TysWiredIn
 import Packages hiding  ( Version(..) )
 import CmdLineParser
-import DynFlags hiding  ( WarnReason(..) )
+import DynFlags
 import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
 import BasicTypes
 import IfaceSyn
 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 ()
 -- | 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
 
 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
   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
 shouldPrintWarning dflags ReasonDeprecatedFlag
   = wopt Opt_WarnDeprecatedFlags dflags
 shouldPrintWarning dflags ReasonUnrecognisedFlag
index 3c14734..6dc9f1d 100644 (file)
@@ -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
     -- 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!"
            (warnRedundantSourceImport imp_mod_name)
     when (mod_safe && not (safeImportsOn dflags)) $
         addErr (text "safe import can't be used as Safe Haskell isn't on!"
index a565959..20c3d5c 100644 (file)
@@ -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'
 
        ; 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
        ; return inst }
 
 instOrphWarn :: ClsInst -> SDoc
index 3965675..ec09958 100644 (file)
@@ -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
         | 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
                return acc }
 
         | otherwise
@@ -234,9 +234,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                }
 
              ; checkErr exportValid (moduleNotImported 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
 
              ; 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.
             | 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
                   ; return occs }
 
             | otherwise    -- Same occ name but different names: an error
index 812ed0a..a6a995d 100644 (file)
@@ -82,7 +82,7 @@ module TcRnMonad(
   failWithTc, failWithTcM,
   checkTc, checkTcM,
   failIfTc, failIfTcM,
   failWithTc, failWithTcM,
   checkTc, checkTcM,
   failIfTc, failIfTcM,
-  warnIf, warnTc, warnTcM,
+  warnIfFlag, warnIf, warnTc, warnTcM,
   addWarnTc, addWarnTcM, addWarn, addWarnAt, add_warn,
   tcInitTidyEnv, tcInitOpenTidyEnv, mkErrInfo,
 
   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
 
 
 --         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
 --   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) $
        ; 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 ()
 
 -- | Display a warning if a condition is met.
 warnTc :: WarnReason -> Bool -> MsgDoc -> TcM ()
index 803761b..c898fd9 100644 (file)
@@ -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) $
 -- 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]
                  (text "SPECIALISE pragma for non-overloaded function"
                   <+> quotes (ppr fun_name))
                   -- Note [SPECIALISE pragmas]
index 19e269b..6fee70d 100644 (file)
@@ -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
index ccbeb39..2d9fd53 100644 (file)
@@ -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 ()
 
     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
 
     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’
 
     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.
 
     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’
 
     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]
 
     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: (_:_)
 
     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 [] = ...
     Pattern match is redundant
     In an equation for ‘f’: f [] = ...
-
-<no location info>: error: 
-Failing due to -Werror.
index e3fbbcf..9dc7af2 100644 (file)
@@ -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’
     Defined but not used: ‘foo’
-
-<no location info>: error: 
-Failing due to -Werror.
index dc8a9d6..3aae5c5 100644 (file)
@@ -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 )
 
     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
 
     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()
 
     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
 
     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
     The qualified import of ‘U(x), U’
     from module ‘OverloadedRecFldsFail06_A’ is redundant
-
-<no location info>: error: 
-Failing due to -Werror.
index dac6d29..0aa41a2 100644 (file)
@@ -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 )
 
 [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"
     In the use of ‘foo’ (imported from OverloadedRecFldsFail11_A):
     "Warning on a record field"
-
-<no location info>: error: 
-Failing due to -Werror.
index 7cd9151..e17c9f8 100644 (file)
@@ -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 )
 
 [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"
 
     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"
 
     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"
     In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
     "Deprecated foo"
-
-<no location info>: error: 
-Failing due to -Werror.
index 6b6b977..7bb1230 100644 (file)
@@ -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#
     Pattern bindings containing unlifted types should use
     an outermost bang pattern:
       P x = P 4#
-
-<no location info>: error: 
-Failing due to -Werror.
index 8f20f91..e0f4606 100644 (file)
@@ -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
     Pattern bindings containing unlifted types should use
     an outermost bang pattern:
       P arg = x
-
-<no location info>: error: 
-Failing due to -Werror.
index b3f1145..0779538 100644 (file)
@@ -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 {..}
     • 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.
index 7ef8338..2766f41 100644 (file)
@@ -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
index f4e46c2..ea03484 100644 (file)
@@ -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.
     ‘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.
index bc27ac2..45047aa 100644 (file)
@@ -1,6 +1,3 @@
 
 
-SafeFlags26.hs:1:16: warning: [-Wsafe]
+SafeFlags26.hs:1:16: error: [-Wsafe, -Werror=safe]
     ‘SafeFlags26’ has been inferred as safe!
     ‘SafeFlags26’ has been inferred as safe!
-
-<no location info>: error: 
-Failing due to -Werror.
index 8010407..45701f2 100644 (file)
@@ -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 )
 
 [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:
     ‘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])
                 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.
index 74cf60d..f05bf7f 100644 (file)
@@ -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
     ‘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.
index f795746..cab45c2 100644 (file)
@@ -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’
     • 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.
index a3e8eec..8083ffc 100644 (file)
@@ -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
     • 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
           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.
index 90c6c2d..00272ef 100644 (file)
@@ -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 _)
     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 (file)
index 0000000..c65f713
--- /dev/null
@@ -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 (file)
index 0000000..f6105d1
--- /dev/null
@@ -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}
index 73117a9..7d0dc42 100644 (file)
@@ -9,6 +9,7 @@ def normalise_whitespace_carefully(s):
                      for line in s.split('\n'))
 
 test('WerrorFail', normal, compile_fail, [''])
                      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,
 test('CaretDiagnostics1',
      [normalise_whitespace_fun(normalise_whitespace_carefully)],
      compile_fail,