[Git][ghc/ghc][master] 4 commits: Refactor warning flag parsing to add missing flags
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jan 18 19:23:06 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00
Refactor warning flag parsing to add missing flags
This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning
groups as well as individual warnings. Previously these were defined
on an ad hoc basis so for example we had `-Werror=compat` but not
`-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not
`-fwarn-compat`. Fixes #22182.
- - - - -
7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00
Minor corrections to comments
- - - - -
5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00
Revise warnings documentation in user's guide
- - - - -
ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00
Move documentation of deferred type error flags out of warnings section
- - - - -
9 changed files:
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error.hs
- docs/users_guide/9.6.1-notes.rst
- docs/users_guide/exts/defer_type_errors.rst
- docs/users_guide/using-warnings.rst
- + testsuite/tests/warnings/should_fail/WarningGroups.hs
- + testsuite/tests/warnings/should_fail/WarningGroups.stderr
- testsuite/tests/warnings/should_fail/all.T
Changes:
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -7,6 +7,9 @@ module GHC.Driver.Flags
, optimisationFlags
-- * Warnings
+ , WarningGroup(..)
+ , warningGroupName
+ , warningGroupFlags
, WarningFlag(..)
, warnFlagNames
, warningGroups
@@ -46,7 +49,7 @@ instance NFData Language where
-- | Debugging flags
data DumpFlag
--- See Note [Updating flag description in the User's Guide]
+-- See Note [Updating flag description in the User's Guide] in GHC.Driver.Session
-- debugging flags
= Opt_D_dump_cmm
@@ -193,7 +196,7 @@ enabledIfVerbose _ = True
-- | Enumerates the simple on-or-off dynamic flags
data GeneralFlag
--- See Note [Updating flag description in the User's Guide]
+-- See Note [Updating flag description in the User's Guide] in GHC.Driver.Session
= Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
| Opt_DumpWithWays -- ^ Use foo.ways.<dumpFlag> instead of foo.<dumpFlag>
@@ -530,7 +533,7 @@ optimisationFlags = EnumSet.fromList
]
data WarningFlag =
--- See Note [Updating flag description in the User's Guide]
+-- See Note [Updating flag description in the User's Guide] in GHC.Driver.Session
Opt_WarnDuplicateExports
| Opt_WarnDuplicateConstraints
| Opt_WarnRedundantConstraints
@@ -742,24 +745,45 @@ warnFlagNames wflag = case wflag of
-- Note [Documenting warning flags]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
--- If you change the list of warning enabled by default
+-- If you change the list of warnings enabled by default
-- please remember to update the User's Guide. The relevant file is:
--
-- docs/users_guide/using-warnings.rst
+
+-- | A group of warning flags that can be enabled or disabled collectively,
+-- e.g. using @-Wcompat@ to enable all warnings in the 'W_compat' group.
+data WarningGroup = W_compat
+ | W_unused_binds
+ | W_default
+ | W_extra
+ | W_all
+ | W_everything
+ deriving (Bounded, Enum, Eq)
+
+warningGroupName :: WarningGroup -> String
+warningGroupName W_compat = "compat"
+warningGroupName W_unused_binds = "unused-binds"
+warningGroupName W_default = "default"
+warningGroupName W_extra = "extra"
+warningGroupName W_all = "all"
+warningGroupName W_everything = "everything"
+
+warningGroupFlags :: WarningGroup -> [WarningFlag]
+warningGroupFlags W_compat = minusWcompatOpts
+warningGroupFlags W_unused_binds = unusedBindsFlags
+warningGroupFlags W_default = standardWarnings
+warningGroupFlags W_extra = minusWOpts
+warningGroupFlags W_all = minusWallOpts
+warningGroupFlags W_everything = minusWeverythingOpts
+
+
-- | Warning groups.
--
-- As all warnings are in the Weverything set, it is ignored when
-- displaying to the user which group a warning is in.
-warningGroups :: [(String, [WarningFlag])]
-warningGroups =
- [ ("compat", minusWcompatOpts)
- , ("unused-binds", unusedBindsFlags)
- , ("default", standardWarnings)
- , ("extra", minusWOpts)
- , ("all", minusWallOpts)
- , ("everything", minusWeverythingOpts)
- ]
+warningGroups :: [WarningGroup]
+warningGroups = [minBound..maxBound]
-- | Warning group hierarchies, where there is an explicit inclusion
-- relation.
@@ -772,23 +796,21 @@ warningGroups =
-- hierarchies with no inherent relation to be defined.
--
-- The special-case Weverything group is not included.
-warningHierarchies :: [[String]]
+warningHierarchies :: [[WarningGroup]]
warningHierarchies = hierarchies ++ map (:[]) rest
where
- hierarchies = [["default", "extra", "all"]]
- rest = filter (`notElem` "everything" : concat hierarchies) $
- map fst warningGroups
+ hierarchies = [[W_default, W_extra, W_all]]
+ rest = filter (`notElem` W_everything : concat hierarchies) warningGroups
-- | Find the smallest group in every hierarchy which a warning
-- belongs to, excluding Weverything.
-smallestWarningGroups :: WarningFlag -> [String]
+smallestWarningGroups :: WarningFlag -> [WarningGroup]
smallestWarningGroups flag = mapMaybe go warningHierarchies where
-- Because each hierarchy is arranged from smallest to largest,
-- the first group we find in a hierarchy which contains the flag
-- is the smallest.
go (group:rest) = fromMaybe (go rest) $ do
- flags <- lookup group warningGroups
- guard (flag `elem` flags)
+ guard (flag `elem` warningGroupFlags group)
pure (Just group)
go [] = Nothing
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2652,50 +2652,6 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "mavx512pf" (noArg (\d ->
d { avx512pf = True }))
- ------ Warning opts -------------------------------------------------
- , make_ord_flag defFlag "W" (NoArg (mapM_ setWarningFlag minusWOpts))
- , 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 = EnumSet.empty})))
- "Use -w or -Wno-everything instead"
- , make_ord_flag defFlag "w" (NoArg (upd (\d ->
- d {warningFlags = EnumSet.empty})))
-
- -- New-style uniform warning sets
- --
- -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything
- , make_ord_flag defFlag "Weverything" (NoArg (mapM_
- setWarningFlag minusWeverythingOpts))
- , make_ord_flag defFlag "Wno-everything"
- (NoArg (upd (\d -> d {warningFlags = EnumSet.empty})))
-
- , make_ord_flag defFlag "Wall" (NoArg (mapM_
- setWarningFlag minusWallOpts))
- , make_ord_flag defFlag "Wno-all" (NoArg (mapM_
- unSetWarningFlag minusWallOpts))
-
- , make_ord_flag defFlag "Wextra" (NoArg (mapM_
- setWarningFlag minusWOpts))
- , make_ord_flag defFlag "Wno-extra" (NoArg (mapM_
- unSetWarningFlag minusWOpts))
-
- , make_ord_flag defFlag "Wdefault" (NoArg (mapM_
- setWarningFlag standardWarnings))
- , make_ord_flag defFlag "Wno-default" (NoArg (mapM_
- unSetWarningFlag standardWarnings))
-
- , make_ord_flag defFlag "Wcompat" (NoArg (mapM_
- setWarningFlag minusWcompatOpts))
- , make_ord_flag defFlag "Wno-compat" (NoArg (mapM_
- unSetWarningFlag minusWcompatOpts))
-
------ Plugin flags ------------------------------------------------
, make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)
, make_ord_flag defGhcFlag "fplugin-trustworthy"
@@ -2911,11 +2867,6 @@ dynamic_flags_deps = [
(NoArg enableGlasgowExts) "Use individual extensions instead"
, make_dep_flag defFlag "fno-glasgow-exts"
(NoArg disableGlasgowExts) "Use individual extensions instead"
- , make_ord_flag defFlag "Wunused-binds" (NoArg enableUnusedBinds)
- , make_ord_flag defFlag "Wno-unused-binds" (NoArg disableUnusedBinds)
- , make_ord_flag defHiddenFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)
- , make_ord_flag defHiddenFlag "fno-warn-unused-binds" (NoArg
- disableUnusedBinds)
------ Safe Haskell flags -------------------------------------------
, make_ord_flag defFlag "fpackage-trust" (NoArg setPackageTrust)
@@ -2938,26 +2889,34 @@ dynamic_flags_deps = [
++ map (mkFlag turnOff "dno-" unSetGeneralFlag ) dFlagsDeps
++ map (mkFlag turnOn "f" setGeneralFlag ) fFlagsDeps
++ map (mkFlag turnOff "fno-" unSetGeneralFlag ) fFlagsDeps
- ++ map (mkFlag turnOn "W" setWarningFlag ) wWarningFlagsDeps
- ++ map (mkFlag turnOff "Wno-" unSetWarningFlag ) wWarningFlagsDeps
- ++ map (mkFlag turnOn "Werror=" setWErrorFlag ) 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)
- wWarningFlagsDeps
- ++ [ (NotDeprecated, unrecognisedWarning "W"),
- (Deprecated, unrecognisedWarning "fwarn-"),
- (Deprecated, unrecognisedWarning "fno-warn-") ]
- ++ [ make_ord_flag defFlag "Werror=compat"
- (NoArg (mapM_ setWErrorFlag minusWcompatOpts))
- , make_ord_flag defFlag "Wno-error=compat"
- (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts))
- , make_ord_flag defFlag "Wwarn=compat"
- (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ]
+ ++
+
+ ------ Warning flags -------------------------------------------------
+ [ make_ord_flag defFlag "W" (NoArg (setWarningGroup W_extra))
+ , make_ord_flag defFlag "Werror"
+ (NoArg (do { setGeneralFlag Opt_WarnIsError
+ ; setFatalWarningGroup W_everything }))
+ , make_ord_flag defFlag "Wwarn"
+ (NoArg (do { unSetGeneralFlag Opt_WarnIsError
+ ; unSetFatalWarningGroup W_everything }))
+ -- Opt_WarnIsError is still needed to pass -Werror
+ -- to CPP; see runCpp in SysTools
+ , make_dep_flag defFlag "Wnot" (NoArg (unSetWarningGroup W_everything))
+ "Use -w or -Wno-everything instead"
+ , make_ord_flag defFlag "w" (NoArg (unSetWarningGroup W_everything))
+ ]
+
+ -- New-style uniform warning sets
+ --
+ -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything
+ ++ warningControls setWarningGroup unSetWarningGroup setWErrorWarningGroup unSetFatalWarningGroup warningGroupsDeps
+ ++ warningControls setWarningFlag unSetWarningFlag setWErrorFlag unSetFatalWarningFlag wWarningFlagsDeps
+
+ ++ [ (NotDeprecated, unrecognisedWarning "W")
+ , (Deprecated, unrecognisedWarning "fwarn-")
+ , (Deprecated, unrecognisedWarning "fno-warn-") ]
+
+ ------ Language flags -------------------------------------------------
++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps
++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps
++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps
@@ -2965,6 +2924,24 @@ dynamic_flags_deps = [
++ map (mkFlag turnOn "X" setLanguage ) languageFlagsDeps
++ map (mkFlag turnOn "X" setSafeHaskell ) safeHaskellFlagsDeps
+-- | Warnings have both new-style flags to control their state (@-W@, @-Wno-@,
+-- @-Werror=@, @-Wwarn=@) and old-style flags (@-fwarn-@, @-fno-warn-@). We
+-- define these uniformly for individual warning flags and groups of warnings.
+warningControls :: (warn_flag -> DynP ()) -- ^ Set the warning
+ -> (warn_flag -> DynP ()) -- ^ Unset the warning
+ -> (warn_flag -> DynP ()) -- ^ Make the warning an error
+ -> (warn_flag -> DynP ()) -- ^ Clear the error status
+ -> [(Deprecation, FlagSpec warn_flag)]
+ -> [(Deprecation, Flag (CmdLineP DynFlags))]
+warningControls set unset set_werror unset_fatal xs =
+ map (mkFlag turnOn "W" set ) xs
+ ++ map (mkFlag turnOff "Wno-" unset ) xs
+ ++ map (mkFlag turnOn "Werror=" set_werror ) xs
+ ++ map (mkFlag turnOn "Wwarn=" unset_fatal ) xs
+ ++ map (mkFlag turnOn "Wno-error=" unset_fatal ) xs
+ ++ map (mkFlag turnOn "fwarn-" set . hideFlag) xs
+ ++ map (mkFlag turnOff "fno-warn-" unset . hideFlag) xs
+
-- | This is where we handle unrecognised warning flags. We only issue a warning
-- if -Wunrecognised-warning-flags is set. See #11429 for context.
unrecognisedWarning :: String -> Flag (CmdLineP DynFlags)
@@ -3328,6 +3305,11 @@ wWarningFlagsDeps = mconcat [
warnSpec Opt_WarnTermVariableCapture
]
+warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
+warningGroupsDeps = map mk warningGroups
+ where
+ mk g = (NotDeprecated, FlagSpec (warningGroupName g) g nop AllModes)
+
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
negatableFlagsDeps = [
@@ -4045,12 +4027,6 @@ optLevelFlags -- see Note [Documenting optimisation flags]
]
-enableUnusedBinds :: DynP ()
-enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags
-
-disableUnusedBinds :: DynP ()
-disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags
-
-- | Things you get with `-dlint`.
enableDLint :: DynP ()
enableDLint = do
@@ -4243,6 +4219,28 @@ unSetGeneralFlag' f dflags = foldr ($) (gopt_unset dflags f) deps
-- imply further flags.
--------------------------
+setWarningGroup :: WarningGroup -> DynP ()
+setWarningGroup g =
+ mapM_ setWarningFlag (warningGroupFlags g)
+
+unSetWarningGroup :: WarningGroup -> DynP ()
+unSetWarningGroup g =
+ mapM_ unSetWarningFlag (warningGroupFlags g)
+
+setWErrorWarningGroup :: WarningGroup -> DynP ()
+setWErrorWarningGroup g =
+ do { setWarningGroup g
+ ; setFatalWarningGroup g }
+
+setFatalWarningGroup :: WarningGroup -> DynP ()
+setFatalWarningGroup g =
+ mapM_ setFatalWarningFlag (warningGroupFlags g)
+
+unSetFatalWarningGroup :: WarningGroup -> DynP ()
+unSetFatalWarningGroup g =
+ mapM_ unSetFatalWarningFlag (warningGroupFlags g)
+
+
setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
setWarningFlag f = upd (\dfs -> wopt_set dfs f)
unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -527,7 +527,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
| show_warn_groups =
case smallestWarningGroups flag of
[] -> empty
- groups -> text $ "(in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"
+ groups -> text $ "(in " ++ intercalate ", " (map (("-W"++) . warningGroupName) groups) ++ ")"
| otherwise = empty
-- Add prefixes, like Foo.hs:34: warning:
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -101,6 +101,11 @@ Compiler
- Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with
the future extension ``RequiredTypeArguments``.
+- The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are
+ now defined systematically for all warning groups (for example,
+ ``-Wno-default``, ``-Werror=unused-binds`` and ``-Wwarn=all`` are now
+ accepted). See :ref:`options-sanity`.
+
GHCi
~~~~
=====================================
docs/users_guide/exts/defer_type_errors.rst
=====================================
@@ -34,7 +34,7 @@ to suppress these warnings.
This flag implies the :ghc-flag:`-fdefer-typed-holes` and
:ghc-flag:`-fdefer-out-of-scope-variables` flags, which enables this behaviour
-for `typed holes <#typed-holes>`__ and variables. Should you so wish, it is
+for :ref:`typed-holes` and variables. Should you so wish, it is
possible to enable :ghc-flag:`-fdefer-type-errors` without enabling
:ghc-flag:`-fdefer-typed-holes` or :ghc-flag:`-fdefer-out-of-scope-variables`,
by explicitly specifying :ghc-flag:`-fno-defer-typed-holes
@@ -42,6 +42,64 @@ by explicitly specifying :ghc-flag:`-fno-defer-typed-holes
<-fdefer-out-of-scope-variables>` on the command-line after the
:ghc-flag:`-fdefer-type-errors` flag.
+.. ghc-flag:: -fdefer-type-errors
+ :shortdesc: Turn type errors into warnings, :ref:`deferring the error until
+ runtime <defer-type-errors>`. Implies
+ :ghc-flag:`-fdefer-typed-holes` and
+ :ghc-flag:`-fdefer-out-of-scope-variables`.
+ See also :ghc-flag:`-Wdeferred-type-errors`.
+ :type: dynamic
+ :reverse: -fno-defer-type-errors
+ :category:
+
+ :since: 7.6
+
+ :implies: :ghc-flag:`-fdefer-typed-holes`, :ghc-flag:`-fdefer-out-of-scope-variables`
+
+ Defer as many type errors as possible until runtime. At compile time
+ you get a warning (instead of an error). At runtime, if you use a
+ value that depends on a type error, you get a runtime error; but you
+ can run any type-correct parts of your code just fine.
+ See also :ghc-flag:`-Wdeferred-type-errors`.
+
+.. ghc-flag:: -fdefer-typed-holes
+ :shortdesc: Convert :ref:`typed hole <typed-holes>` errors into warnings,
+ :ref:`deferring the error until runtime <defer-type-errors>`.
+ Implied by :ghc-flag:`-fdefer-type-errors`.
+ See also :ghc-flag:`-Wtyped-holes`.
+ :type: dynamic
+ :reverse: -fno-defer-typed-holes
+ :category:
+
+ :since: 7.10
+
+ Defer typed holes errors (errors about names with a leading underscore
+ (e.g., “_”, “_foo”, “_bar”)) until runtime. This will turn the errors
+ produced by :ref:`typed holes <typed-holes>` into warnings. Using a value
+ that depends on a typed hole produces a runtime error, the same as
+ :ghc-flag:`-fdefer-type-errors` (which implies this option). See :ref:`typed-holes`.
+
+ Implied by :ghc-flag:`-fdefer-type-errors`. See also :ghc-flag:`-Wtyped-holes`.
+
+.. ghc-flag:: -fdefer-out-of-scope-variables
+ :shortdesc: Convert variable out of scope variables errors into warnings.
+ Implied by :ghc-flag:`-fdefer-type-errors`.
+ See also :ghc-flag:`-Wdeferred-out-of-scope-variables`.
+ :type: dynamic
+ :reverse: -fno-defer-out-of-scope-variables
+ :category:
+
+ :since: 8.0
+
+ Defer variable out-of-scope errors (errors about names without a leading underscore)
+ until runtime. This will turn variable-out-of-scope errors into warnings.
+ Using a value that depends on an out-of-scope variable produces a runtime error,
+ the same as :ghc-flag:`-fdefer-type-errors` (which implies this option).
+ See :ref:`typed-holes`.
+
+ Implied by :ghc-flag:`-fdefer-type-errors`. See also :ghc-flag:`-Wdeferred-out-of-scope-variables`.
+
+
At runtime, whenever a term containing a type error would need to be
evaluated, the error is converted into a runtime exception of type
``TypeError``. Note that type errors are deferred as much as possible
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -11,20 +11,31 @@ GHC has a number of options that select which types of non-fatal error
messages, otherwise known as warnings, can be generated during compilation.
Some options control individual warnings and others control collections
of warnings.
-To turn off an individual warning ``-W<wflag>``, use ``-Wno-<wflag>``.
-To reverse ``-Werror``, which makes all warnings into errors, use ``-Wwarn``.
+Use ``-W⟨wflag⟩`` to turn on an individual warning or a collection, or use
+``-Wno-⟨wflag⟩`` to turn it off.
+Use ``-Werror`` to make all warnings into fatal errors, or ``-Werror=⟨wflag⟩`` to
+make a specific warning into an error. Reverse this with ``-Wwarn`` to make all
+warnings non-fatal, or ``-Wwarn=⟨wflag⟩`` to make a specific warning non-fatal.
.. note::
- In GHC < 8 the syntax for ``-W<wflag>`` was ``-fwarn-<wflag>``
+ In GHC < 8 the syntax for ``-W⟨wflag⟩`` was ``-fwarn-⟨wflag⟩``
(e.g. ``-fwarn-incomplete-patterns``).
This spelling is deprecated, but still accepted for backwards compatibility.
- Likewise, ``-Wno-<wflag>`` used to be ``fno-warn-<wflag>``
+ Likewise, ``-Wno-⟨wflag⟩`` used to be ``fno-warn-⟨wflag⟩``
(e.g. ``-fno-warn-incomplete-patterns``).
+Warning groups
+==============
+
+The following flags are simple ways to select standard "packages" of
+warnings. They can be reversed using ``-Wno-⟨group⟩``, which has the same effect
+as ``-Wno-...`` for every individual warning in the group.
+
.. ghc-flag:: -Wdefault
:shortdesc: enable default flags
:type: dynamic
+ :reverse: -Wno-default
:category:
:since: 8.0
@@ -68,12 +79,10 @@ To reverse ``-Werror``, which makes all warnings into errors, use ``-Wwarn``.
* :ghc-flag:`-Wgadt-mono-local-binds`
* :ghc-flag:`-Wtype-equality-requires-operators`
-The following flags are simple ways to select standard "packages" of warnings:
-
.. ghc-flag:: -W
:shortdesc: enable normal warnings
:type: dynamic
- :reverse: -w
+ :reverse: -Wno-extra
:category:
Provides the standard warnings plus
@@ -93,14 +102,14 @@ The following flags are simple ways to select standard "packages" of warnings:
.. ghc-flag:: -Wextra
:shortdesc: alias for :ghc-flag:`-W`
:type: dynamic
- :reverse: -w
+ :reverse: -Wno-extra
Alias for :ghc-flag:`-W`
.. ghc-flag:: -Wall
:shortdesc: enable almost all warnings (details in :ref:`options-sanity`)
:type: dynamic
- :reverse: -w
+ :reverse: -Wno-all
:category:
Turns on all warning options that indicate potentially suspicious
@@ -134,6 +143,7 @@ The following flags are simple ways to select standard "packages" of warnings:
.. ghc-flag:: -Weverything
:shortdesc: enable all warnings supported by GHC
:type: dynamic
+ :reverse: -w
:category:
:since: 8.0
@@ -164,14 +174,6 @@ The following flags are simple ways to select standard "packages" of warnings:
* :ghc-flag:`-Wcompat-unqualified-imports`
* :ghc-flag:`-Wtype-equality-out-of-scope`
-.. ghc-flag:: -Wno-compat
- :shortdesc: Disables all warnings enabled by :ghc-flag:`-Wcompat`.
- :type: dynamic
- :reverse: -Wcompat
- :category:
-
- Disables all warnings enabled by :ghc-flag:`-Wcompat`.
-
.. ghc-flag:: -w
:shortdesc: disable all warnings
:type: dynamic
@@ -186,6 +188,24 @@ The following flags are simple ways to select standard "packages" of warnings:
Deprecated alias for :ghc-flag:`-w`
+When a warning is emitted, the specific warning flag which controls
+it is shown, but the group can optionally be shown as well:
+
+.. ghc-flag:: -fshow-warning-groups
+ :shortdesc: show which group an emitted warning belongs to.
+ :type: dynamic
+ :reverse: -fno-show-warning-groups
+ :category:
+
+ :default: off
+
+ When showing which flag controls a warning, also show the
+ respective warning group flag(s) that warning is contained in.
+
+
+Treating warnings as fatal errors
+=================================
+
These options control which warnings are considered fatal and cause compilation
to abort.
@@ -199,7 +219,7 @@ to abort.
Makes any warning into a fatal error. Useful so that you don't miss
warnings when doing batch compilation. To reverse ``-Werror`` and stop
- treating any warnings as errors use ``-Wwarn``, or use ``-Wwarn=<wflag>``
+ treating any warnings as errors use ``-Wwarn``, or use ``-Wwarn=⟨wflag⟩``
to stop treating specific warnings as errors.
.. ghc-flag:: -Werror=⟨wflag⟩
@@ -209,13 +229,14 @@ to abort.
:category:
:noindex:
- :implies: ``-W<wflag>``
+ :implies: ``-W⟨wflag⟩``
Makes a specific warning into a fatal error. The warning will be enabled if
- it hasn't been enabled yet. Can be reversed with ``-Wwarn=<wflag>``.
+ it hasn't been enabled yet. Can be reversed with ``-Wwarn=⟨wflag⟩``.
- ``-Werror=compat`` has the same effect as ``-Werror=...`` for each warning
- flag in the :ghc-flag:`-Wcompat` option group.
+ ``-Werror=⟨group⟩`` has the same effect as ``-Werror=...`` for each warning
+ flag in the group (for example, ``-Werror=compat`` will turn every warning
+ in the :ghc-flag:`-Wcompat` group into a fatal error).
.. ghc-flag:: -Wwarn
:shortdesc: make warnings non-fatal
@@ -235,25 +256,25 @@ to abort.
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
+ Note that it doesn't fully negate the effects of ``-Werror=⟨wflag⟩`` - the
warning will still be enabled.
- ``-Wwarn=compat`` has the same effect as ``-Wwarn=...`` for each warning
- flag in the :ghc-flag:`-Wcompat` option group.
-
-When a warning is emitted, the specific warning flag which controls
-it is shown.
+ ``-Wwarn=⟨group⟩`` has the same effect as ``-Wwarn=...`` for each warning
+ flag in the group (for example, ``-Wwarn=compat`` will mark every warning in
+ the :ghc-flag:`-Wcompat` group as non-fatal).
-.. ghc-flag:: -fshow-warning-groups
- :shortdesc: show which group an emitted warning belongs to.
+.. ghc-flag:: -Wno-error=⟨wflag⟩
+ :shortdesc: make a specific warning non-fatal
:type: dynamic
- :reverse: -fno-show-warning-groups
+ :reverse: -Werror=⟨wflag⟩
:category:
+ :noindex:
- :default: off
+ Alternative spelling for ``-Wwarn=⟨wflag⟩``.
- When showing which flag controls a warning, also show the
- respective warning group flag(s) that warning is contained in.
+
+Individual warning options
+==========================
The full set of warning options is described below. To turn off any
warning, simply give the corresponding ``-Wno-...`` option on the
@@ -322,7 +343,7 @@ of ``-W(no-)*``.
Determines whether the compiler reports typed holes warnings. Has no
effect unless typed holes errors are deferred until runtime. See
- :ref:`typed-holes` and :ref:`defer-type-errors`
+ :ref:`typed-holes` and :ref:`defer-type-errors`.
.. ghc-flag:: -Wdeferred-type-errors
:shortdesc: Report warnings when :ref:`deferred type errors
@@ -332,70 +353,12 @@ of ``-W(no-)*``.
:reverse: -Wno-deferred-type-errors
:category:
- :since: 8.4
+ :since: 8.0
:default: on
Causes a warning to be reported when a type error is deferred until
- runtime. See :ref:`defer-type-errors`
-
-.. ghc-flag:: -fdefer-type-errors
- :shortdesc: Turn type errors into warnings, :ref:`deferring the error until
- runtime <defer-type-errors>`. Implies
- :ghc-flag:`-fdefer-typed-holes` and
- :ghc-flag:`-fdefer-out-of-scope-variables`.
- See also :ghc-flag:`-Wdeferred-type-errors`
- :type: dynamic
- :reverse: -fno-defer-type-errors
- :category:
-
- :since: 7.6
-
- :implies: :ghc-flag:`-fdefer-typed-holes`, :ghc-flag:`-fdefer-out-of-scope-variables`
-
- Defer as many type errors as possible until runtime. At compile time
- you get a warning (instead of an error). At runtime, if you use a
- value that depends on a type error, you get a runtime error; but you
- can run any type-correct parts of your code just fine. See
- :ref:`defer-type-errors`
-
-.. ghc-flag:: -fdefer-typed-holes
- :shortdesc: Convert :ref:`typed hole <typed-holes>` errors into warnings,
- :ref:`deferring the error until runtime <defer-type-errors>`.
- Implied by :ghc-flag:`-fdefer-type-errors`.
- See also :ghc-flag:`-Wtyped-holes`.
- :type: dynamic
- :reverse: -fno-defer-typed-holes
- :category:
-
- :since: 7.10
-
- Defer typed holes errors (errors about names with a leading underscore
- (e.g., “_”, “_foo”, “_bar”)) until runtime. This will turn the errors
- produced by :ref:`typed holes <typed-holes>` into warnings. Using a value
- that depends on a typed hole produces a runtime error, the same as
- :ghc-flag:`-fdefer-type-errors` (which implies this option). See :ref:`typed-holes`
- and :ref:`defer-type-errors`.
-
- Implied by :ghc-flag:`-fdefer-type-errors`. See also :ghc-flag:`-Wtyped-holes`.
-
-.. ghc-flag:: -fdefer-out-of-scope-variables
- :shortdesc: Convert variable out of scope variables errors into warnings.
- Implied by :ghc-flag:`-fdefer-type-errors`.
- See also :ghc-flag:`-Wdeferred-out-of-scope-variables`.
- :type: dynamic
- :reverse: -fno-defer-out-of-scope-variables
- :category:
-
- :since: 8.0
-
- Defer variable out-of-scope errors (errors about names without a leading underscore)
- until runtime. This will turn variable-out-of-scope errors into warnings.
- Using a value that depends on an out-of-scope variable produces a runtime error,
- the same as :ghc-flag:`-fdefer-type-errors` (which implies this option).
- See :ref:`typed-holes` and :ref:`defer-type-errors`.
-
- Implied by :ghc-flag:`-fdefer-type-errors`. See also :ghc-flag:`-Wdeferred-out-of-scope-variables`.
+ runtime. See :ref:`defer-type-errors`.
.. ghc-flag:: -Wdeferred-out-of-scope-variables
:shortdesc: Report warnings when variable out-of-scope errors are
@@ -408,6 +371,7 @@ of ``-W(no-)*``.
:since: 8.0
Warn when a deferred out-of-scope variable is encountered.
+ See :ref:`defer-type-errors`.
.. ghc-flag:: -Wpartial-type-signatures
:shortdesc: warn about holes in partial type signatures when
=====================================
testsuite/tests/warnings/should_fail/WarningGroups.hs
=====================================
@@ -0,0 +1,4 @@
+{-# OPTIONS_GHC -Wwarn=everything -fwarn-all -fno-warn-compat -Werror=unused-binds #-}
+module WarningGroups () where
+
+unused = let useless = () in ()
=====================================
testsuite/tests/warnings/should_fail/WarningGroups.stderr
=====================================
@@ -0,0 +1,9 @@
+
+WarningGroups.hs:4:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+ Top-level binding with no type signature: unused :: ()
+
+WarningGroups.hs:4:1: error: [-Wunused-top-binds (in -Wextra, -Wunused-binds), Werror=unused-top-binds]
+ Defined but not used: ‘unused’
+
+WarningGroups.hs:4:14: error: [-Wunused-local-binds (in -Wextra, -Wunused-binds), Werror=unused-local-binds]
+ Defined but not used: ‘useless’
=====================================
testsuite/tests/warnings/should_fail/all.T
=====================================
@@ -10,6 +10,7 @@ def normalise_whitespace_carefully(s):
test('WerrorFail', normal, compile_fail, [''])
test('WerrorFail2', normal, compile_fail, [''])
+test('WarningGroups', normal, compile_fail, [''])
test('CaretDiagnostics1',
[normalise_whitespace_fun(normalise_whitespace_carefully)],
compile_fail,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4c14c4ba17b3abf3e7b88e1201ac7ba89fd56c9...ab0d5cdaa5505e5b774b04b9f68dcbbc7ce1071e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4c14c4ba17b3abf3e7b88e1201ac7ba89fd56c9...ab0d5cdaa5505e5b774b04b9f68dcbbc7ce1071e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230118/10133a66/attachment-0001.html>
More information about the ghc-commits
mailing list