diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Types/Error.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Error.hs | 3 |
3 files changed, 15 insertions, 12 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index df49034d13..82ae334cac 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -635,6 +635,7 @@ data WarningFlag = | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 + | Opt_WarnUnclassified -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -741,6 +742,7 @@ warnFlagNames wflag = case wflag of Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] + Opt_WarnUnclassified -> "unclassified" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -879,7 +881,8 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnUnicodeBidirectionalFormatCharacters, Opt_WarnGADTMonoLocalBinds, Opt_WarnLoopySuperclassSolve, - Opt_WarnTypeEqualityRequiresOperators + Opt_WarnTypeEqualityRequiresOperators, + Opt_WarnUnclassified ] -- | Things you get with -W diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index 0eccf085bb..65bf1a69ba 100644 --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} @@ -28,7 +29,7 @@ module GHC.Types.Error , Diagnostic (..) , UnknownDiagnostic (..) , DiagnosticMessage (..) - , DiagnosticReason (..) + , DiagnosticReason (WarningWithoutFlag, ..) , DiagnosticHint (..) , mkPlainDiagnostic , mkPlainError @@ -322,14 +323,12 @@ mkDecoratedError hints docs = DiagnosticMessage (mkDecorated docs) ErrorWithoutF -- can be completely statically-computed (i.e. this is an error or a warning -- no matter what), or influenced by the specific state of the 'DynFlags' at -- the moment of the creation of a new 'Diagnostic'. For example, a parsing --- error is /always/ going to be an error, whereas a 'WarningWithoutFlag +-- error is /always/ going to be an error, whereas a 'WarningWithFlag -- Opt_WarnUnusedImports' might turn into an error due to '-Werror' or -- '-Werror=warn-unused-imports'. Interpreting a 'DiagnosticReason' together -- with its associated 'Severity' gives us the full picture. data DiagnosticReason - = WarningWithoutFlag - -- ^ Born as a warning. - | WarningWithFlag !WarningFlag + = WarningWithFlag !WarningFlag -- ^ Warning was enabled with the flag. | WarningWithCategory !WarningCategory -- ^ Warning was enabled with a custom category. @@ -339,11 +338,17 @@ data DiagnosticReason instance Outputable DiagnosticReason where ppr = \case - WarningWithoutFlag -> text "WarningWithoutFlag" WarningWithFlag wf -> text ("WarningWithFlag " ++ show wf) WarningWithCategory cat -> text "WarningWithCategory" <+> ppr cat ErrorWithoutFlag -> text "ErrorWithoutFlag" +-- | Warnings that do not otherwise have flags to control them are controlled by +-- the @-Wunclassified@ flag. In particular this means that @-w@ can be used to +-- suppress unclassified warnings, as well as @-Werror@ or +-- @-Werror=unclassified@ promoting them to errors. +pattern WarningWithoutFlag :: DiagnosticReason +pattern WarningWithoutFlag = WarningWithFlag Opt_WarnUnclassified + -- | An envelope for GHC's facts about a running program, parameterised over the -- /domain-specific/ (i.e. parsing, typecheck-renaming, etc) diagnostics. -- @@ -511,7 +516,6 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg -- The above can happen when displaying an error message -- in a log file, e.g. with -ddump-tc-trace. It should not -- happen otherwise, though. - flag_msg SevError WarningWithoutFlag = Just (col "-Werror") flag_msg SevError (WarningWithFlag wflag) = let name = NE.head (warnFlagNames wflag) in Just $ col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag) @@ -523,7 +527,6 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg <> comma <+> coloured msg_colour (text "-Werror=" <> ppr cat) flag_msg SevError ErrorWithoutFlag = Nothing - flag_msg SevWarning WarningWithoutFlag = Nothing flag_msg SevWarning (WarningWithFlag wflag) = let name = NE.head (warnFlagNames wflag) in Just (col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag)) diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 8ea61c6f39..66783daf33 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -142,9 +142,6 @@ diagReasonSeverity opts reason = case reason of | not (diag_wopt_custom wcat opts) -> SevIgnore | diag_fatal_wopt_custom wcat opts -> SevError | otherwise -> SevWarning - WarningWithoutFlag - | diag_warn_is_error opts -> SevError - | otherwise -> SevWarning ErrorWithoutFlag -> SevError |