Commit 514acfe4 authored by Maciej Bielecki's avatar Maciej Bielecki Committed by Ben Gamari

Implement fine-grained `-Werror=...` facility

This patch add new options `-Werror=...`, `-Wwarn=...` and
`-Wno-error=...` (synonym for `-Wwarn=...`).

Semantics:

  - `-Werror` marks all warnings as fatal, including those that don't
    have a warning flag, and CPP warnings.
  - `-Werror=...` enables a warning and marks it as fatal
  - `-Wwarn=...` marks a warning as non-fatal, but doesn't disable it

Test Plan: validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: mpickering, svenpanne, RyanGlScott, thomie

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

GHC Trac Issues: #11219
parent ea76a213
......@@ -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)
......
......@@ -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
......@@ -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
......
......@@ -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.
......
{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}
module Werror01 where
-- this should generate missing-signatures, but not incomplete-patterns
foo () = ()
Werror01.hs:5:1: warning: [-Wmissing-signatures (in -Wall)]
Top-level binding with no type signature: foo :: () -> ()
{-# OPTIONS_GHC -Wmissing-signatures -Werror -Wwarn=missing-signatures #-}
module Werror02 where
-- this should generate missing-signatures warning
foo () = ()
Werror02.hs:5:1: warning: [-Wmissing-signatures (in -Wall)]
Top-level binding with no type signature: foo :: () -> ()
......@@ -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, [''])
{-# OPTIONS_GHC -Wwarn-missing-signatues -Werror=incomplete-patterns #-}
foo () = ()
{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}
module WerrorFail where
-- this should generate incomplete-patterns warning
foo :: Maybe a -> ()
foo Nothing = ()
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.
test('WerrorFail', normal, compile_fail, [''])
......@@ -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 "++
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment