diff options
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 54 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 148 | ||||
| -rw-r--r-- | compiler/GHC/Types/Error.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/warnings/should_fail/WarningGroups.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/warnings/should_fail/WarningGroups.stderr | 9 | ||||
| -rw-r--r-- | testsuite/tests/warnings/should_fail/all.T | 1 |
6 files changed, 126 insertions, 92 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index 634718ae7e..6e6f71cb0e 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -7,6 +7,9 @@ module GHC.Driver.Flags , optimisationFlags -- * Warnings + , WarningGroup(..) + , warningGroupName + , warningGroupFlags , WarningFlag(..) , warnFlagNames , warningGroups @@ -747,19 +750,40 @@ warnFlagNames wflag = case wflag of -- -- 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 diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 57d89a15b1..8a37a9d197 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/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) diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index 695072e632..bc5e473dd8 100644 --- a/compiler/GHC/Types/Error.hs +++ b/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: diff --git a/testsuite/tests/warnings/should_fail/WarningGroups.hs b/testsuite/tests/warnings/should_fail/WarningGroups.hs new file mode 100644 index 0000000000..9581895ff7 --- /dev/null +++ b/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 () diff --git a/testsuite/tests/warnings/should_fail/WarningGroups.stderr b/testsuite/tests/warnings/should_fail/WarningGroups.stderr new file mode 100644 index 0000000000..8e9cedb07e --- /dev/null +++ b/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’ diff --git a/testsuite/tests/warnings/should_fail/all.T b/testsuite/tests/warnings/should_fail/all.T index 6eaf7af6fd..f016212ed9 100644 --- a/testsuite/tests/warnings/should_fail/all.T +++ b/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, |