diff options
Diffstat (limited to 'compiler/main/DynFlags.hs')
| -rw-r--r-- | compiler/main/DynFlags.hs | 41 |
1 files changed, 39 insertions, 2 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) |