diff options
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, |