summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs41
-rw-r--r--compiler/main/ErrUtils.hs7
-rw-r--r--compiler/main/HscTypes.hs5
-rw-r--r--docs/users_guide/using-warnings.rst17
-rw-r--r--testsuite/tests/warnings/should_compile/Werror01.hs5
-rw-r--r--testsuite/tests/warnings/should_compile/Werror01.stderr2
-rw-r--r--testsuite/tests/warnings/should_compile/Werror02.hs5
-rw-r--r--testsuite/tests/warnings/should_compile/Werror02.stderr2
-rw-r--r--testsuite/tests/warnings/should_compile/all.T3
-rw-r--r--testsuite/tests/warnings/should_compile/sel_werror.hs3
-rw-r--r--testsuite/tests/warnings/should_fail/WerrorFail.hs6
-rw-r--r--testsuite/tests/warnings/should_fail/WerrorFail.stderr6
-rw-r--r--testsuite/tests/warnings/should_fail/all.T1
-rw-r--r--utils/mkUserGuidePart/Options/Warnings.hs10
14 files changed, 108 insertions, 5 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 126b4575f6..98d27d2aa9 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -30,6 +30,7 @@ module DynFlags (
dopt, dopt_set, dopt_unset,
gopt, gopt_set, gopt_unset, setGeneralFlag', unSetGeneralFlag',
wopt, wopt_set, wopt_unset,
+ wopt_fatal,
xopt, xopt_set, xopt_unset,
lang_set,
useUnicodeSyntax,
@@ -807,6 +808,7 @@ data DynFlags = DynFlags {
dumpFlags :: IntSet,
generalFlags :: IntSet,
warningFlags :: IntSet,
+ fatalWarningFlags :: IntSet,
-- Don't change this without updating extensionFlags:
language :: Maybe Language,
-- | Safe Haskell mode
@@ -1563,6 +1565,7 @@ defaultDynFlags mySettings =
dumpFlags = IntSet.empty,
generalFlags = IntSet.fromList (map fromEnum (defaultFlags mySettings)),
warningFlags = IntSet.fromList (map fromEnum standardWarnings),
+ fatalWarningFlags = IntSet.empty,
ghciScripts = [],
language = Nothing,
safeHaskell = Sf_None,
@@ -1846,6 +1849,22 @@ wopt_set dfs f = dfs{ warningFlags = IntSet.insert (fromEnum f) (warningFlags df
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset dfs f = dfs{ warningFlags = IntSet.delete (fromEnum f) (warningFlags dfs) }
+-- | Test whether a 'WarningFlag' is set as fatal
+wopt_fatal :: WarningFlag -> DynFlags -> Bool
+wopt_fatal f dflags = fromEnum f `IntSet.member` fatalWarningFlags dflags
+
+-- | Mark a 'WarningFlag' as fatal (do not set the flag)
+wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
+wopt_set_fatal dfs f
+ = dfs { fatalWarningFlags =
+ IntSet.insert (fromEnum f) (fatalWarningFlags dfs) }
+
+-- | Mark a 'WarningFlag' as not fatal
+wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
+wopt_unset_fatal dfs f
+ = dfs { fatalWarningFlags =
+ IntSet.delete (fromEnum f) (fatalWarningFlags dfs) }
+
-- | Test whether a 'LangExt.Extension' is set
xopt :: LangExt.Extension -> DynFlags -> Bool
xopt f dflags = fromEnum f `IntSet.member` extensionFlags dflags
@@ -2851,8 +2870,14 @@ dynamic_flags_deps = [
------ Warning opts -------------------------------------------------
, make_ord_flag defFlag "W" (NoArg (mapM_ setWarningFlag minusWOpts))
- , make_ord_flag defFlag "Werror" (NoArg (setGeneralFlag Opt_WarnIsError))
- , make_ord_flag defFlag "Wwarn" (NoArg (unSetGeneralFlag Opt_WarnIsError))
+ , make_ord_flag defFlag "Werror"
+ (NoArg (do { setGeneralFlag Opt_WarnIsError
+ ; mapM_ setFatalWarningFlag minusWeverythingOpts }))
+ , make_ord_flag defFlag "Wwarn"
+ (NoArg (do { unSetGeneralFlag Opt_WarnIsError
+ ; mapM_ unSetFatalWarningFlag minusWeverythingOpts }))
+ -- Opt_WarnIsError is still needed to pass -Werror
+ -- to CPP; see runCpp in SysTools
, make_dep_flag defFlag "Wnot" (NoArg (upd (\d ->
d {warningFlags = IntSet.empty})))
"Use -w or -Wno-everything instead"
@@ -3055,6 +3080,14 @@ dynamic_flags_deps = [
++ map (mkFlag turnOff "fno-" unSetGeneralFlag ) fFlagsDeps
++ map (mkFlag turnOn "W" setWarningFlag ) wWarningFlagsDeps
++ map (mkFlag turnOff "Wno-" unSetWarningFlag ) wWarningFlagsDeps
+ ++ map (mkFlag turnOn "Werror=" (\flag -> do {
+ ; setWarningFlag flag
+ ; setFatalWarningFlag flag }))
+ wWarningFlagsDeps
+ ++ map (mkFlag turnOn "Wwarn=" unSetFatalWarningFlag )
+ wWarningFlagsDeps
+ ++ map (mkFlag turnOn "Wno-error=" unSetFatalWarningFlag )
+ wWarningFlagsDeps
++ map (mkFlag turnOn "fwarn-" setWarningFlag . hideFlag)
wWarningFlagsDeps
++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag)
@@ -4245,6 +4278,10 @@ setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
setWarningFlag f = upd (\dfs -> wopt_set dfs f)
unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
+setFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP ()
+setFatalWarningFlag f = upd (\dfs -> wopt_set_fatal dfs f)
+unSetFatalWarningFlag f = upd (\dfs -> wopt_unset_fatal dfs f)
+
--------------------------
setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP ()
setExtensionFlag f = upd (setExtensionFlag' f)
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index 41150a6383..db593509c9 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -20,6 +20,7 @@ module ErrUtils (
unionMessages,
errMsgSpan, errMsgContext,
errorsFound, isEmptyMessages,
+ isWarnMsgFatal,
-- ** Formatting
pprMessageBag, pprErrMsgBagWithLoc,
@@ -553,3 +554,9 @@ prettyPrintGhcErrors dflags
pprDebugAndThen dflags pgmError (text str) doc
_ ->
liftIO $ throwIO e
+
+-- | Checks if given 'WarnMsg' is a fatal warning.
+isWarnMsgFatal :: DynFlags -> WarnMsg -> Bool
+isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}
+ = wopt_fatal wflag dflags
+isWarnMsgFatal dflags _ = gopt Opt_WarnIsError dflags
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index cd1878ffe9..b3a332edeb 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -318,9 +318,8 @@ instance Exception GhcApiError
-- -Werror is enabled, or print them out otherwise.
printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
printOrThrowWarnings dflags warns
- | gopt Opt_WarnIsError dflags
- = when (not (isEmptyBag warns)) $ do
- throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
+ | anyBag (isWarnMsgFatal dflags) warns
+ = throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
| otherwise
= printBagOfErrors dflags warns
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index c9216b9307..fdda600773 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -92,16 +92,33 @@ The following flags are simple ways to select standard "packages" of warnings:
Turns off all warnings, including the standard ones and those that
:ghc-flag:`-Wall` doesn't enable.
+These options control which warnings are considered fatal and cause compilation
+to abort.
+
.. ghc-flag:: -Werror
Makes any warning into a fatal error. Useful so that you don't miss
warnings when doing batch compilation.
+.. ghc-flag:: -Werror=<wflag>
+
+ :implies: ``-W<wflag>``
+
+ Makes a specific warning into a fatal error. The warning will be enabled if
+ it hasn't been enabled yet.
+
.. ghc-flag:: -Wwarn
Warnings are treated only as warnings, not as errors. This is the
default, but can be useful to negate a :ghc-flag:`-Werror` flag.
+.. ghc-flag:: -Wwarn=<wflag>
+
+ Causes a specific warning to be treated as normal warning, not fatal error.
+
+ Note that it doesn't fully negate the effects of ``-Werror=<wflag>`` - the
+ warning will still be enabled.
+
When a warning is emitted, the specific warning flag which controls
it is shown.
diff --git a/testsuite/tests/warnings/should_compile/Werror01.hs b/testsuite/tests/warnings/should_compile/Werror01.hs
new file mode 100644
index 0000000000..f4cb54c7d1
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/Werror01.hs
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}
+module Werror01 where
+
+-- this should generate missing-signatures, but not incomplete-patterns
+foo () = ()
diff --git a/testsuite/tests/warnings/should_compile/Werror01.stderr b/testsuite/tests/warnings/should_compile/Werror01.stderr
new file mode 100644
index 0000000000..91fcc8449f
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/Werror01.stderr
@@ -0,0 +1,2 @@
+Werror01.hs:5:1: warning: [-Wmissing-signatures (in -Wall)]
+ Top-level binding with no type signature: foo :: () -> ()
diff --git a/testsuite/tests/warnings/should_compile/Werror02.hs b/testsuite/tests/warnings/should_compile/Werror02.hs
new file mode 100644
index 0000000000..71458669a3
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/Werror02.hs
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -Wmissing-signatures -Werror -Wwarn=missing-signatures #-}
+module Werror02 where
+
+-- this should generate missing-signatures warning
+foo () = ()
diff --git a/testsuite/tests/warnings/should_compile/Werror02.stderr b/testsuite/tests/warnings/should_compile/Werror02.stderr
new file mode 100644
index 0000000000..c33037caae
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/Werror02.stderr
@@ -0,0 +1,2 @@
+Werror02.hs:5:1: warning: [-Wmissing-signatures (in -Wall)]
+ Top-level binding with no type signature: foo :: () -> ()
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index ed128faaaa..bb347b065a 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -21,3 +21,6 @@ test('DeprU',
'DeprM.o', 'DeprU.o',
'DeprM.hi', 'DeprU.hi']),
multimod_compile, ['DeprU', '-Wall'])
+
+test('Werror01', normal, compile, [''])
+test('Werror02', normal, compile, [''])
diff --git a/testsuite/tests/warnings/should_compile/sel_werror.hs b/testsuite/tests/warnings/should_compile/sel_werror.hs
new file mode 100644
index 0000000000..65702539ad
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/sel_werror.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS_GHC -Wwarn-missing-signatues -Werror=incomplete-patterns #-}
+
+foo () = ()
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail.hs b/testsuite/tests/warnings/should_fail/WerrorFail.hs
new file mode 100644
index 0000000000..c8ffefeb12
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/WerrorFail.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}
+module WerrorFail where
+
+-- this should generate incomplete-patterns warning
+foo :: Maybe a -> ()
+foo Nothing = ()
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail.stderr b/testsuite/tests/warnings/should_fail/WerrorFail.stderr
new file mode 100644
index 0000000000..90c6c2db3a
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/WerrorFail.stderr
@@ -0,0 +1,6 @@
+WerrorFail.hs:6:1: warning: [-Wincomplete-patterns (in -Wextra)]
+ 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/all.T b/testsuite/tests/warnings/should_fail/all.T
new file mode 100644
index 0000000000..3522bb275f
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/all.T
@@ -0,0 +1 @@
+test('WerrorFail', normal, compile_fail, [''])
diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs
index eadb60016e..0f00b51ff4 100644
--- a/utils/mkUserGuidePart/Options/Warnings.hs
+++ b/utils/mkUserGuidePart/Options/Warnings.hs
@@ -31,11 +31,21 @@ warningsOptions =
, flagType = DynamicFlag
, flagReverse = "-Wwarn"
}
+ , flag { flagName = "-Werror=<wflag>"
+ , flagDescription = "make a specific warning fatal"
+ , flagType = DynamicFlag
+ , flagReverse = "-Wwarn=<wflag>"
+ }
, flag { flagName = "-Wwarn"
, flagDescription = "make warnings non-fatal"
, flagType = DynamicFlag
, flagReverse = "-Werror"
}
+ , flag { flagName = "-Wwarn=<wflag>"
+ , flagDescription = "make a specific warning non-fatal"
+ , flagType = DynamicFlag
+ , flagReverse = "-Werror=<wflag>"
+ }
, flag { flagName = "-Wunrecognised-warning-flags"
, flagDescription =
"throw a warning when an unreconised ``-W...`` flag is "++
View Lorry Controller Status