Messages, errorsFound, emptyMessages,
mkErrMsg, mkWarnMsg, mkPlainErrMsg, mkLongErrMsg,
printErrorsAndWarnings, printBagOfErrors, printBagOfWarnings,
+ handleFlagWarnings,
ghcExit,
doIfSet, doIfSet_dyn,
debugTraceMsg,
) where
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import Bag ( Bag, bagToList, isEmptyBag, emptyBag )
EQ -> True
GT -> False
-
+handleFlagWarnings :: DynFlags -> [String] -> IO ()
+handleFlagWarnings dflags warns
+ = when (dopt Opt_WarnDeprecatedFlags dflags)
+ (handleFlagWarnings' dflags warns)
+
+handleFlagWarnings' :: DynFlags -> [String] -> IO ()
+handleFlagWarnings' _ [] = return ()
+handleFlagWarnings' dflags warns
+ = do -- It would be nicer if warns :: [Message], but that has circular
+ -- import problems.
+ let warns' = map text warns
+ mapM_ (log_action dflags SevWarning noSrcSpan defaultUserStyle) warns'
+ when (dopt Opt_WarnIsError dflags) $
+ do errorMsg dflags $ text "\nFailing due to -Werror.\n"
+ exitWith (ExitFailure 1)
ghcExit :: DynFlags -> Int -> IO ()
ghcExit dflags val