diff options
163 files changed, 866 insertions, 628 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index f9cb4be3b3..f5d0f84054 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -284,7 +284,7 @@ displayLintResults :: DynFlags -> CoreToDo -> IO () displayLintResults dflags pass warns errs binds | not (isEmptyBag errs) - = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + = do { log_action dflags dflags NoReason Err.SevDump noSrcSpan defaultDumpStyle (vcat [ lint_banner "errors" (ppr pass), Err.pprMessageBag errs , text "*** Offending Program ***" , pprCoreBindings binds @@ -294,7 +294,7 @@ displayLintResults dflags pass warns errs binds | not (isEmptyBag warns) , not opt_NoDebugOutput , showLintWarnings pass - = log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + = log_action dflags dflags NoReason Err.SevDump noSrcSpan defaultDumpStyle (lint_banner "warnings" (ppr pass) $$ Err.pprMessageBag warns) | otherwise = return () @@ -324,7 +324,8 @@ lintInteractiveExpr what hsc_env expr dflags = hsc_dflags hsc_env display_lint_err err - = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + = do { log_action dflags dflags NoReason Err.SevDump + noSrcSpan defaultDumpStyle (vcat [ lint_banner "errors" (text what) , err , text "*** Offending Program ***" diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index ef21f5c4d4..479d8cdfe5 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -111,7 +111,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds modBreaks <- mkModBreaks hsc_env mod tickCount entries when (dopt Opt_D_dump_ticked dflags) $ - log_action dflags dflags SevDump noSrcSpan defaultDumpStyle + log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (pprLHsBinds binds1) return (binds1, HpcInfo tickCount hashNo, Just modBreaks) diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 81aab36ea9..64244729c4 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -170,7 +170,7 @@ showTerm term = do -- XXX: this tries to disable logging of errors -- does this still do what it is intended to do -- with the changed error handling and logging? - let noop_log _ _ _ _ _ = return () + let noop_log _ _ _ _ _ _ = return () expr = "show " ++ showPpr dflags bname _ <- GHC.setSessionDynFlags dflags{log_action=noop_log} fhv <- liftIO $ mkFinalizedHValue hsc_env =<< mkRemoteRef val diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 2b471ee0ee..4b8a322f58 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -235,7 +235,7 @@ withExtendedLinkEnv new_env action showLinkerState :: DynFlags -> IO () showLinkerState dflags = do pls <- readIORef v_PersistentLinkerState >>= readMVar - log_action dflags dflags SevDump noSrcSpan defaultDumpStyle + log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (vcat [text "----- Linker state -----", text "Pkgs:" <+> ppr (pkgs_loaded pls), text "Objs:" <+> ppr (objs_loaded pls), @@ -374,7 +374,7 @@ classifyLdInput dflags f | isObjectFilename platform f = return (Just (Object f)) | isDynLibFilename platform f = return (Just (DLLPath f)) | otherwise = do - log_action dflags dflags SevInfo noSrcSpan defaultUserStyle + log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle (text ("Warning: ignoring unrecognised input `" ++ f ++ "'")) return Nothing where platform = targetPlatform dflags @@ -1397,7 +1397,12 @@ maybePutStr :: DynFlags -> String -> IO () maybePutStr dflags s = when (verbosity dflags > 1) $ do let act = log_action dflags - act dflags SevInteractive noSrcSpan defaultUserStyle (text s) + act dflags + NoReason + SevInteractive + noSrcSpan + defaultUserStyle + (text s) maybePutStrLn :: DynFlags -> String -> IO () maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n") diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index a7246afc03..0b70e8c725 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -80,7 +80,14 @@ readBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do let printer :: SDoc -> IO () printer = case traceBinIFaceReading of - TraceBinIFaceReading -> \sd -> log_action dflags dflags SevOutput noSrcSpan defaultDumpStyle sd + TraceBinIFaceReading -> \sd -> + log_action dflags + dflags + NoReason + SevOutput + noSrcSpan + defaultDumpStyle + sd QuietBinIFaceReading -> \_ -> return () wantedGot :: Outputable a => String -> a -> a -> IO () wantedGot what wanted got = diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index c044136b36..64d100f1ed 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -861,7 +861,7 @@ showIface hsc_env filename = do iface <- initTcRnIf 's' hsc_env () () $ readBinIface IgnoreHiWay TraceBinIFaceReading filename let dflags = hsc_dflags hsc_env - log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (pprModIface iface) + log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (pprModIface iface) pprModIface :: ModIface -> SDoc -- Show a ModIface diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 00a0801c47..422fd4e35b 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -67,7 +67,13 @@ codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream do_lint cmm = do { showPass dflags "CmmLint" ; case cmmLint dflags cmm of - Just err -> do { log_action dflags dflags SevDump noSrcSpan defaultDumpStyle err + Just err -> do { log_action dflags + dflags + NoReason + SevDump + noSrcSpan + defaultDumpStyle + err ; ghcExit dflags 1 } Nothing -> return () diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 3de94fd403..c384248ba1 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1594,7 +1594,7 @@ mkExtraObj dflags extn xs mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath mkExtraObjToLinkIntoBinary dflags = do when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do - log_action dflags dflags SevInfo noSrcSpan defaultUserStyle + log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$ text " Call hs_init_ghc() from your main() function to set these options.") @@ -1969,7 +1969,7 @@ linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO () linkDynLibCheck dflags o_files dep_packages = do when (haveRtsOptsFlags dflags) $ do - log_action dflags dflags SevInfo noSrcSpan defaultUserStyle + log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$ text " Call hs_init_ghc() from your main() function to set these options.") diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3d23a090e6..ebfd861237 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -21,7 +21,7 @@ module DynFlags ( -- * Dynamic flags and associated configuration types DumpFlag(..), GeneralFlag(..), - WarningFlag(..), + WarningFlag(..), WarnReason(..), Language(..), PlatformConstants(..), FatalMessager, LogAction, FlushOut(..), FlushErr(..), @@ -173,7 +173,7 @@ import FastString import Outputable import Foreign.C ( CInt(..) ) import System.IO.Unsafe ( unsafeDupablePerformIO ) -import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage ) +import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn ) import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef @@ -382,6 +382,7 @@ data GeneralFlag | Opt_NoLlvmMangler -- hidden flag | Opt_WarnIsError -- -Werror; makes warnings fatal + | Opt_ShowWarnGroups -- Show the group a warning belongs to | Opt_PrintExplicitForalls | Opt_PrintExplicitKinds @@ -533,6 +534,11 @@ data GeneralFlag | Opt_PackageTrust deriving (Eq, Show, Enum) +-- | Used when outputting warnings: if a reason is given, it is +-- displayed. If a warning isn't controlled by a flag, this is made +-- explicit at the point of use. +data WarnReason = NoReason | Reason !WarningFlag + data WarningFlag = -- See Note [Updating flag description in the User's Guide] Opt_WarnDuplicateExports @@ -1616,13 +1622,20 @@ interpreterDynamic dflags -------------------------------------------------------------------------- type FatalMessager = String -> IO () -type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () + +type LogAction = DynFlags + -> WarnReason + -> Severity + -> SrcSpan + -> PprStyle + -> MsgDoc + -> IO () defaultFatalMessager :: FatalMessager defaultFatalMessager = hPutStrLn stderr defaultLogAction :: LogAction -defaultLogAction dflags severity srcSpan style msg +defaultLogAction dflags reason severity srcSpan style msg = case severity of SevOutput -> printSDoc msg style SevDump -> printSDoc (msg $$ blankLine) style @@ -1630,7 +1643,7 @@ defaultLogAction dflags severity srcSpan style msg SevInfo -> printErrs msg style SevFatal -> printErrs msg style _ -> do hPutChar stderr '\n' - printErrs (mkLocMessage severity srcSpan msg) style + printErrs message style -- careful (#2302): printErrs prints in UTF-8, -- whereas converting to string first and using -- hPutStr would just emit the low 8 bits of @@ -1638,6 +1651,19 @@ defaultLogAction dflags severity srcSpan style msg where printSDoc = defaultLogActionHPrintDoc dflags stdout printErrs = defaultLogActionHPrintDoc dflags stderr putStrSDoc = defaultLogActionHPutStrDoc dflags stdout + -- Pretty print the warning flag, if any (#10752) + message = mkLocMessageAnn flagMsg severity srcSpan msg + flagMsg = case reason of + NoReason -> Nothing + Reason flag -> (\spec -> "-W" ++ flagSpecName spec ++ flagGrp flag) <$> + flagSpecOf flag + + flagGrp flag + | gopt Opt_ShowWarnGroups dflags = + case smallestGroups flag of + [] -> "" + groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")" + | otherwise = "" defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () defaultLogActionHPrintDoc dflags h d sty @@ -3145,6 +3171,12 @@ useInstead flag turn_on nop :: TurnOnFlag -> DynP () nop _ = return () +-- | Find the 'FlagSpec' for a 'WarningFlag'. +flagSpecOf :: WarningFlag -> Maybe (FlagSpec WarningFlag) +flagSpecOf flag = listToMaybe $ filter check wWarningFlags + where + check fs = flagSpecFlag fs == flag + -- | These @-W\<blah\>@ flags can all be reversed with @-Wno-\<blah\>@ wWarningFlags :: [FlagSpec WarningFlag] wWarningFlags = map snd wWarningFlagsDeps @@ -3344,7 +3376,8 @@ fFlagsDeps = [ flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, flagSpec "vectorisation-avoidance" Opt_VectorisationAvoidance, flagSpec "vectorise" Opt_Vectorise, - flagSpec "worker-wrapper" Opt_WorkerWrapper + flagSpec "worker-wrapper" Opt_WorkerWrapper, + flagSpec "show-warning-groups" Opt_ShowWarnGroups ] -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ @@ -3584,7 +3617,8 @@ defaultFlags settings Opt_ProfCountEntries, Opt_RPath, Opt_SharedImplib, - Opt_SimplPreInlining + Opt_SimplPreInlining, + Opt_ShowWarnGroups ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -3757,6 +3791,51 @@ removes an assertion failure. -} -- * utils/mkUserGuidePart/ -- * docs/users_guide/using-warnings.rst +-- | 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) + ] + +-- | Warning group hierarchies, where there is an explicit inclusion +-- relation. +-- +-- Each inner list is a hierarchy of warning groups, ordered from +-- smallest to largest, where each group is a superset of the one +-- before it. +-- +-- Separating this from 'warningGroups' allows for multiple +-- hierarchies with no inherent relation to be defined. +-- +-- The special-case Weverything group is not included. +warningHierarchies :: [[String]] +warningHierarchies = hierarchies ++ map (:[]) rest + where + hierarchies = [["default", "extra", "all"]] + rest = filter (`notElem` "everything" : concat hierarchies) $ + map fst warningGroups + +-- | Find the smallest group in every hierarchy which a warning +-- belongs to, excluding Weverything. +smallestGroups :: WarningFlag -> [String] +smallestGroups 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) + pure (Just group) + go [] = Nothing + -- | Warnings enabled unless specified otherwise standardWarnings :: [WarningFlag] standardWarnings -- see Note [Documenting warning flags] diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index eafe4e802f..7e68302ba1 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -23,7 +23,7 @@ module ErrUtils ( pprLocErrMsg, printBagOfErrors, -- ** Construction - emptyMessages, mkLocMessage, makeIntoWarning, + emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning, mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg, warnIsErrorMsg, mkLongWarnMsg, @@ -110,7 +110,8 @@ data ErrMsg = ErrMsg { errMsgDoc :: ErrDoc, -- | This has the same text as errDocImportant . errMsgDoc. errMsgShortString :: String, - errMsgSeverity :: Severity + errMsgSeverity :: Severity, + errMsgReason :: WarnReason } -- The SrcSpan is used for sorting errors into line-number order @@ -160,15 +161,18 @@ pprMessageBag :: Bag MsgDoc -> SDoc pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs)) mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc +mkLocMessage = mkLocMessageAnn Nothing + +mkLocMessageAnn :: Maybe String -> Severity -> SrcSpan -> MsgDoc -> MsgDoc -- Always print the location, even if it is unhelpful. Error messages -- are supposed to be in a standard format, and one without a location -- would look strange. Better to say explicitly "<no location info>". -mkLocMessage severity locn msg +mkLocMessageAnn ann severity locn msg = sdocWithDynFlags $ \dflags -> let locn' = if gopt Opt_ErrorSpans dflags then ppr locn else ppr (srcSpanStart locn) - in hang (locn' <> colon <+> sev_info) 4 msg + in hang (locn' <> colon <+> sev_info <> opt_ann) 4 msg where -- Add prefixes, like Foo.hs:34: warning: -- <the warning message> @@ -178,8 +182,13 @@ mkLocMessage severity locn msg SevFatal -> text "fatal:" _ -> empty -makeIntoWarning :: ErrMsg -> ErrMsg -makeIntoWarning err = err { errMsgSeverity = SevWarning } + -- Add optional information + opt_ann = text $ maybe "" (\i -> " ["++i++"]") ann + +makeIntoWarning :: WarnReason -> ErrMsg -> ErrMsg +makeIntoWarning reason err = err + { errMsgSeverity = SevWarning + , errMsgReason = reason } -- ----------------------------------------------------------------------------- -- Collecting up messages for later ordering and printing. @@ -190,7 +199,8 @@ mk_err_msg dflags sev locn print_unqual doc , errMsgContext = print_unqual , errMsgDoc = doc , errMsgShortString = showSDoc dflags (vcat (errDocImportant doc)) - , errMsgSeverity = sev } + , errMsgSeverity = sev + , errMsgReason = NoReason } mkErrDoc :: DynFlags -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg mkErrDoc dflags = mk_err_msg dflags SevError @@ -226,10 +236,11 @@ errorsFound _dflags (_warns, errs) = not (isEmptyBag errs) printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO () printBagOfErrors dflags bag_of_errors = sequence_ [ let style = mkErrStyle dflags unqual - in log_action dflags dflags sev s style (formatErrDoc dflags doc) + in log_action dflags dflags reason sev s style (formatErrDoc dflags doc) | ErrMsg { errMsgSpan = s, errMsgDoc = doc, errMsgSeverity = sev, + errMsgReason = reason, errMsgContext = unqual } <- sortMsgBag (Just dflags) bag_of_errors ] @@ -283,7 +294,13 @@ doIfSet_dyn dflags flag action | gopt flag dflags = action dumpIfSet :: DynFlags -> Bool -> String -> SDoc -> IO () dumpIfSet dflags flag hdr doc | not flag = return () - | otherwise = log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (mkDumpDoc hdr doc) + | otherwise = log_action dflags + dflags + NoReason + SevDump + noSrcSpan + defaultDumpStyle + (mkDumpDoc hdr doc) -- | a wrapper around 'dumpSDoc'. -- First check whether the dump flag is set @@ -359,7 +376,7 @@ dumpSDoc dflags print_unqual flag hdr doc let (doc', severity) | null hdr = (doc, SevOutput) | otherwise = (mkDumpDoc hdr doc, SevDump) - log_action dflags dflags severity noSrcSpan dump_style doc' + log_action dflags dflags NoReason severity noSrcSpan dump_style doc' -- | Choose where to put a dump file based on DynFlags @@ -416,18 +433,18 @@ ifVerbose dflags val act errorMsg :: DynFlags -> MsgDoc -> IO () errorMsg dflags msg - = log_action dflags dflags SevError noSrcSpan (defaultErrStyle dflags) msg + = log_action dflags dflags NoReason SevError noSrcSpan (defaultErrStyle dflags) msg warningMsg :: DynFlags -> MsgDoc -> IO () warningMsg dflags msg - = log_action dflags dflags SevWarning noSrcSpan (defaultErrStyle dflags) msg + = log_action dflags dflags NoReason SevWarning noSrcSpan (defaultErrStyle dflags) msg fatalErrorMsg :: DynFlags -> MsgDoc -> IO () fatalErrorMsg dflags msg = fatalErrorMsg' (log_action dflags) dflags msg fatalErrorMsg' :: LogAction -> DynFlags -> MsgDoc -> IO () fatalErrorMsg' la dflags msg = - la dflags SevFatal noSrcSpan (defaultErrStyle dflags) msg + la dflags NoReason SevFatal noSrcSpan (defaultErrStyle dflags) msg fatalErrorMsg'' :: FatalMessager -> String -> IO () fatalErrorMsg'' fm msg = fm msg @@ -458,11 +475,13 @@ printOutputForUser dflags print_unqual msg = logOutput dflags (mkUserStyle print_unqual AllTheWay) msg logInfo :: DynFlags -> PprStyle -> MsgDoc -> IO () -logInfo dflags sty msg = log_action dflags dflags SevInfo noSrcSpan sty msg +logInfo dflags sty msg + = log_action dflags dflags NoReason SevInfo noSrcSpan sty msg logOutput :: DynFlags -> PprStyle -> MsgDoc -> IO () -- ^ Like 'logInfo' but with 'SevOutput' rather then 'SevInfo' -logOutput dflags sty msg = log_action dflags dflags SevOutput noSrcSpan sty msg +logOutput dflags sty msg + = log_action dflags dflags NoReason SevOutput noSrcSpan sty msg prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a prettyPrintGhcErrors dflags diff --git a/compiler/main/ErrUtils.hs-boot b/compiler/main/ErrUtils.hs-boot index 31edcc05ee..b991ec4958 100644 --- a/compiler/main/ErrUtils.hs-boot +++ b/compiler/main/ErrUtils.hs-boot @@ -16,3 +16,4 @@ data Severity type MsgDoc = SDoc mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc +mkLocMessageAnn :: Maybe String -> Severity -> SrcSpan -> MsgDoc -> MsgDoc diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 7bbe4be495..1729a5bfdc 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -678,7 +678,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs -- | Each module is given a unique 'LogQueue' to redirect compilation messages -- to. A 'Nothing' value contains the result of compilation, and denotes the -- end of the message queue. -data LogQueue = LogQueue !(IORef [Maybe (Severity, SrcSpan, PprStyle, MsgDoc)]) +data LogQueue = LogQueue !(IORef [Maybe (WarnReason, Severity, SrcSpan, PprStyle, MsgDoc)]) !(MVar ()) -- | The graph of modules to compile and their corresponding result 'MVar' and @@ -879,7 +879,7 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do return (success_flag,ok_results) where - writeLogQueue :: LogQueue -> Maybe (Severity,SrcSpan,PprStyle,MsgDoc) -> IO () + writeLogQueue :: LogQueue -> Maybe (WarnReason,Severity,SrcSpan,PprStyle,MsgDoc) -> IO () writeLogQueue (LogQueue ref sem) msg = do atomicModifyIORef' ref $ \msgs -> (msg:msgs,()) _ <- tryPutMVar sem () @@ -888,8 +888,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do -- The log_action callback that is used to synchronize messages from a -- worker thread. parLogAction :: LogQueue -> LogAction - parLogAction log_queue _dflags !severity !srcSpan !style !msg = do - writeLogQueue log_queue (Just (severity,srcSpan,style,msg)) + parLogAction log_queue _dflags !reason !severity !srcSpan !style !msg = do + writeLogQueue log_queue (Just (reason,severity,srcSpan,style,msg)) -- Print each message from the log_queue using the log_action from the -- session's DynFlags. @@ -902,8 +902,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do print_loop [] = read_msgs print_loop (x:xs) = case x of - Just (severity,srcSpan,style,msg) -> do - log_action dflags dflags severity srcSpan style msg + Just (reason,severity,srcSpan,style,msg) -> do + log_action dflags dflags reason severity srcSpan style msg print_loop xs -- Exit the loop once we encounter the end marker. Nothing -> return () diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index c3436edd9e..930ba9ebba 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1367,10 +1367,10 @@ builderMainLoop dflags filter_fn pgm real_args mb_env = do msg <- readChan chan case msg of BuildMsg msg -> do - log_action dflags dflags SevInfo noSrcSpan defaultUserStyle msg + log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle msg loop chan hProcess t p exitcode BuildError loc msg -> do - log_action dflags dflags SevError (mkSrcSpan loc loc) defaultUserStyle msg + log_action dflags dflags NoReason SevError (mkSrcSpan loc loc) defaultUserStyle msg loop chan hProcess t p exitcode EOF -> loop chan hProcess (t-1) p exitcode diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index df31fda16c..5bbbdb51f6 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -390,7 +390,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- Print one-line size info ; let cs = coreBindsStats tidy_binds ; when (dopt Opt_D_dump_core_stats dflags) - (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle + (log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (text "Tidy size (terms,types,coercions)" <+> ppr (moduleName mod) <> colon <+> int (cs_tm cs) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 33a1cb447b..2f7e808cfe 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -462,7 +462,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat -- or an occurrence of, a variable on the RHS ; whenWOptM Opt_WarnUnusedPatternBinds $ when (null bndrs && not is_wild_pat) $ - addWarn $ unusedPatBindWarn bind' + addWarn (Reason Opt_WarnUnusedPatternBinds) $ unusedPatBindWarn bind' ; fvs' `seq` -- See Note [Free-variable space leak] return (bind', bndrs, all_fvs) } @@ -1104,7 +1104,7 @@ rnGRHS' ctxt rnBody (GRHS guards rhs) rnBody rhs ; unless (pattern_guards_allowed || is_standard_guard guards') - (addWarn (nonStdGuardErr guards')) + (addWarn NoReason (nonStdGuardErr guards')) ; return (GRHS guards' rhs', fvs) } where diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 5d74d7c94f..0ecd85e3c7 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -743,7 +743,8 @@ lookup_demoted rdr_name dflags Just demoted_name | data_kinds -> do { whenWOptM Opt_WarnUntickedPromotedConstructors $ - addWarn (untickedPromConstrWarn demoted_name) + addWarn (Reason Opt_WarnUntickedPromotedConstructors) + (untickedPromConstrWarn demoted_name) ; return demoted_name } | otherwise -> unboundNameX WL_Any rdr_name suggest_dk } @@ -1068,7 +1069,8 @@ warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss }) -- See Note [Handling of deprecations] do { iface <- loadInterfaceForName doc name ; case lookupImpDeprec iface gre of - Just txt -> addWarn (mk_msg imp_spec txt) + Just txt -> addWarn (Reason Opt_WarnWarningsDeprecations) + (mk_msg imp_spec txt) Nothing -> return () } } | otherwise = return () @@ -1738,7 +1740,9 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns -- we don't find any GREs that are in scope qualified-only complain [] = return () - complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs) + complain pp_locs = addWarnAt (Reason Opt_WarnNameShadowing) + loc + (shadowedNameWarn occ pp_locs) is_shadowed_gre :: GlobalRdrElt -> RnM Bool -- Returns False for record selectors that are shadowed, when @@ -2118,7 +2122,8 @@ warnUnusedLocals names = do warnUnusedLocal :: NameEnv (FieldLabelString, Name) -> Name -> RnM () warnUnusedLocal fld_env name = when (reportable name) $ - addUnusedWarning occ (nameSrcSpan name) + addUnusedWarning Opt_WarnUnusedLocalBinds + occ (nameSrcSpan name) (text "Defined but not used") where occ = case lookupNameEnv fld_env name of @@ -2132,7 +2137,7 @@ warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is }) | otherwise = when (reportable name) (mapM_ warn is) where occ = greOccName gre - warn spec = addUnusedWarning occ span msg + warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg where span = importSpecLoc spec pp_mod = quotes (ppr (importSpecModule spec)) @@ -2154,9 +2159,9 @@ reportable name -- from Data.Tuple | otherwise = not (startsWithUnderscore (nameOccName name)) -addUnusedWarning :: OccName -> SrcSpan -> SDoc -> RnM () -addUnusedWarning occ span msg - = addWarnAt span $ +addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM () +addUnusedWarning flag occ span msg + = addWarnAt (Reason flag) span $ sep [msg <> colon, nest 2 $ pprNonVarNameSpace (occNameSpace occ) <+> quotes (ppr occ)] diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 75191adc74..70f76b9a54 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -236,7 +236,8 @@ rnImportDecl this_mod _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () | otherwise -> whenWOptM Opt_WarnMissingImportList $ - addWarn (missingImportListWarn imp_mod_name) + addWarn (Reason Opt_WarnMissingImportList) + (missingImportListWarn imp_mod_name) iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg) @@ -253,7 +254,8 @@ rnImportDecl this_mod -- the non-boot module depends on the compilation order, which -- is not deterministic. The hs-boot test can show this up. dflags <- getDynFlags - warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags)) + warnIf NoReason + (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags)) (warnRedundantSourceImport imp_mod_name) when (mod_safe && not (safeImportsOn dflags)) $ addErr (text "safe import can't be used as Safe Haskell isn't on!" @@ -297,7 +299,8 @@ rnImportDecl this_mod -- Complain if we import a deprecated module whenWOptM Opt_WarnWarningsDeprecations ( case (mi_warns iface) of - WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt + WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations) + (moduleWarn imp_mod_name txt) _ -> return () ) @@ -814,11 +817,11 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) where -- Warn when importing T(..) if T was exported abstractly emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $ - addWarn (dodgyImportWarn n) + addWarn (Reason Opt_WarnDodgyImports) (dodgyImportWarn n) emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ - addWarn (missingImportListItem ieRdr) + addWarn (Reason Opt_WarnMissingImportList) (missingImportListItem ieRdr) emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $ - addWarn (lookup_err_msg BadImport) + addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg BadImport) run_lookup :: IELookupM a -> TcRn (Maybe a) run_lookup m = case m of @@ -1262,7 +1265,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod | (L _ (IEModuleContents (L _ mod))) <- ie_names ] , mod `elem` earlier_mods -- Duplicate export of M = do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ; - warnIf warn_dup_exports (dupModuleExport mod) ; + warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports + (dupModuleExport mod) ; return acc } | otherwise @@ -1276,7 +1280,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod } ; checkErr exportValid (moduleNotImported mod) - ; warnIf (warnDodgyExports && exportValid && null gre_prs) + ; warnIf (Reason Opt_WarnDodgyExports) + (warnDodgyExports && exportValid && null gre_prs) (nullModuleExport mod) ; traceRn (text "efa" <+> (ppr mod $$ ppr all_gres)) @@ -1373,7 +1378,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod warnDodgyExports <- woptM Opt_WarnDodgyExports when (null gres) $ if isTyConName name - then when warnDodgyExports $ addWarn (dodgyExportWarn name) + then when warnDodgyExports $ + addWarn (Reason Opt_WarnDodgyExports) + (dodgyExportWarn name) else -- This occurs when you export T(..), but -- only import T abstractly, or T is a synonym. addErr (exportItemErr ie) @@ -1416,7 +1423,8 @@ check_occs ie occs names -- 'names' are the entities specifed by 'ie' -- by two different module exports. See ticket #4478. -> do unless (dupExport_ok name ie ie') $ do warn_dup_exports <- woptM Opt_WarnDuplicateExports - warnIf warn_dup_exports (dupExportWarn name_occ ie ie') + warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports + (dupExportWarn name_occ ie ie') return occs | otherwise -- Same occ name but different names: an error @@ -1550,7 +1558,7 @@ warnUnusedImportDecls gbl_env ; traceRn (vcat [ text "Uses:" <+> ppr uses , text "Import usage" <+> ppr usage]) ; whenWOptM Opt_WarnUnusedImports $ - mapM_ (warnUnusedImport fld_env) usage + mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports usage } @@ -1570,9 +1578,15 @@ warnMissingSignatures gbl_env ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures ; let sig_warn - | warn_only_exported = topSigWarnIfExported exports sig_ns - | warn_missing_sigs || warn_pat_syns = topSigWarn sig_ns - | otherwise = noSigWarn + | warn_only_exported + = topSigWarnIfExported Opt_WarnMissingExportedSignatures + exports sig_ns + | warn_missing_sigs + = topSigWarn Opt_WarnMissingSignatures sig_ns + | warn_pat_syns + = topSigWarn Opt_WarnMissingPatternSynonymSignatures sig_ns + | otherwise + = noSigWarn ; let binders = (if warn_pat_syns then ps_binders else []) @@ -1591,35 +1605,36 @@ type SigWarn = [(Type, Name)] -> RnM () noSigWarn :: SigWarn noSigWarn _ = return () -topSigWarnIfExported :: NameSet -> NameSet -> SigWarn -topSigWarnIfExported exported sig_ns ids - = mapM_ (topSigWarnIdIfExported exported sig_ns) ids +topSigWarnIfExported :: WarningFlag -> NameSet -> NameSet -> SigWarn +topSigWarnIfExported flag exported sig_ns ids + = mapM_ (topSigWarnIdIfExported flag exported sig_ns) ids -topSigWarnIdIfExported :: NameSet -> NameSet -> (Type, Name) -> RnM () -topSigWarnIdIfExported exported sig_ns (ty, name) +topSigWarnIdIfExported :: WarningFlag -> NameSet -> NameSet -> (Type, Name) + -> RnM () +topSigWarnIdIfExported flag exported sig_ns (ty, name) | name `elemNameSet` exported - = topSigWarnId sig_ns (ty, name) + = topSigWarnId flag sig_ns (ty, name) | otherwise = return () -topSigWarn :: NameSet -> SigWarn -topSigWarn sig_ns ids = mapM_ (topSigWarnId sig_ns) ids +topSigWarn :: WarningFlag -> NameSet -> SigWarn +topSigWarn flag sig_ns ids = mapM_ (topSigWarnId flag sig_ns) ids -topSigWarnId :: NameSet -> (Type, Name) -> RnM () +topSigWarnId :: WarningFlag -> NameSet -> (Type, Name) -> RnM () -- The NameSet is the Ids that *lack* a signature -- We have to do it this way round because there are -- lots of top-level bindings that are generated by GHC -- and that don't have signatures -topSigWarnId sig_ns (ty, name) - | name `elemNameSet` sig_ns = warnMissingSig msg (ty, name) +topSigWarnId flag sig_ns (ty, name) + | name `elemNameSet` sig_ns = warnMissingSig flag msg (ty, name) | otherwise = return () where msg = text "Top-level binding with no type signature:" -warnMissingSig :: SDoc -> (Type, Name) -> RnM () -warnMissingSig msg (ty, name) = do +warnMissingSig :: WarningFlag -> SDoc -> (Type, Name) -> RnM () +warnMissingSig flag msg (ty, name) = do tymsg <- getMsg ty - addWarnAt (getSrcSpan name) (mk_msg tymsg) + addWarnAt (Reason flag) (getSrcSpan name) (mk_msg tymsg) where mk_msg endmsg = sep [ msg, nest 2 $ pprPrefixName name <+> endmsg ] @@ -1723,9 +1738,9 @@ extendImportMap gre imp_map -- For srcSpanEnd see Note [The ImportMap] avail = availFromGRE gre -warnUnusedImport :: NameEnv (FieldLabelString, Name) -> ImportDeclUsage - -> RnM () -warnUnusedImport fld_env (L loc decl, used, unused) +warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name) + -> ImportDeclUsage -> RnM () +warnUnusedImport flag fld_env (L loc decl, used, unused) | Just (False,L _ []) <- ideclHiding decl = return () -- Do not warn for 'import M()' @@ -1733,9 +1748,9 @@ warnUnusedImport fld_env (L loc decl, used, unused) , not (null hides) , pRELUDE_NAME == unLoc (ideclName decl) = return () -- Note [Do not warn about Prelude hiding] - | null used = addWarnAt loc msg1 -- Nothing used; drop entire decl + | null used = addWarnAt (Reason flag) loc msg1 -- Nothing used; drop entire decl | null unused = return () -- Everything imported is used; nop - | otherwise = addWarnAt loc msg2 -- Some imports are unused + | otherwise = addWarnAt (Reason flag) loc msg2 -- Some imports are unused where msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used, nest 2 (text "except perhaps to import instances from" diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 4f655090c6..f3851ba770 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -500,10 +500,12 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == pureAName, isAliasMG mg == Just returnMName - -> addWarnNonCanonicalMethod1 "pure" "return" + -> addWarnNonCanonicalMethod1 + Opt_WarnNonCanonicalMonadInstances "pure" "return" | name == thenAName, isAliasMG mg == Just thenMName - -> addWarnNonCanonicalMethod1 "(*>)" "(>>)" + -> addWarnNonCanonicalMethod1 + Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)" _ -> return () @@ -512,10 +514,12 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == returnMName, isAliasMG mg /= Just pureAName - -> addWarnNonCanonicalMethod2 "return" "pure" + -> addWarnNonCanonicalMethod2 + Opt_WarnNonCanonicalMonadInstances "return" "pure" | name == thenMName, isAliasMG mg /= Just thenAName - -> addWarnNonCanonicalMethod2 "(>>)" "(*>)" + -> addWarnNonCanonicalMethod2 + Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)" _ -> return () @@ -540,7 +544,9 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == failMName, isAliasMG mg == Just failMName_preMFP - -> addWarnNonCanonicalMethod1 "fail" "Control.Monad.fail" + -> addWarnNonCanonicalMethod1 + Opt_WarnNonCanonicalMonadFailInstances "fail" + "Control.Monad.fail" _ -> return () @@ -549,8 +555,9 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == failMName_preMFP, isAliasMG mg /= Just failMName - -> addWarnNonCanonicalMethod2 "fail" - "Control.Monad.Fail.fail" + -> addWarnNonCanonicalMethod2 + Opt_WarnNonCanonicalMonadFailInstances "fail" + "Control.Monad.Fail.fail" _ -> return () | otherwise = return () @@ -574,7 +581,8 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == sappendName, isAliasMG mg == Just mappendName - -> addWarnNonCanonicalMethod1 "(<>)" "mappend" + -> addWarnNonCanonicalMethod1 + Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend" _ -> return () @@ -583,7 +591,8 @@ checkCanonicalInstances cls poly_ty mbinds = do case mbind of FunBind { fun_id = L _ name, fun_matches = mg } | name == mappendName, isAliasMG mg /= Just sappendName - -> addWarnNonCanonicalMethod2NoDefault "mappend" "(<>)" + -> addWarnNonCanonicalMethod2NoDefault + Opt_WarnNonCanonicalMonoidInstances "mappend" "(<>)" _ -> return () @@ -599,8 +608,9 @@ checkCanonicalInstances cls poly_ty mbinds = do isAliasMG _ = Nothing -- got "lhs = rhs" but expected something different - addWarnNonCanonicalMethod1 lhs rhs = do - addWarn $ vcat [ text "Noncanonical" <+> + addWarnNonCanonicalMethod1 flag lhs rhs = do + addWarn (Reason flag) $ vcat + [ text "Noncanonical" <+> quotes (text (lhs ++ " = " ++ rhs)) <+> text "definition detected" , instDeclCtxt1 poly_ty @@ -610,8 +620,9 @@ checkCanonicalInstances cls poly_ty mbinds = do ] -- expected "lhs = rhs" but got something else - addWarnNonCanonicalMethod2 lhs rhs = do - addWarn $ vcat [ text "Noncanonical" <+> + addWarnNonCanonicalMethod2 flag lhs rhs = do + addWarn (Reason flag) $ vcat + [ text "Noncanonical" <+> quotes (text lhs) <+> text "definition detected" , instDeclCtxt1 poly_ty @@ -621,8 +632,9 @@ checkCanonicalInstances cls poly_ty mbinds = do ] -- like above, but method has no default impl - addWarnNonCanonicalMethod2NoDefault lhs rhs = do - addWarn $ vcat [ text "Noncanonical" <+> + addWarnNonCanonicalMethod2NoDefault flag lhs rhs = do + addWarn (Reason flag) $ vcat + [ text "Noncanonical" <+> quotes (text lhs) <+> text "definition detected" , instDeclCtxt1 poly_ty diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 118a32b392..7e82ddc32a 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1409,7 +1409,7 @@ warnUnusedForAll :: SDoc -> LHsTyVarBndr Name -> FreeVars -> TcM () warnUnusedForAll in_doc (L loc tv) used_names = whenWOptM Opt_WarnUnusedForalls $ unless (hsTyVarName tv `elemNameSet` used_names) $ - addWarnAt loc $ + addWarnAt (Reason Opt_WarnUnusedForalls) loc $ vcat [ text "Unused quantified type variable" <+> quotes (ppr tv) , in_doc ] diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 13a7512ffa..de22e65132 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -825,7 +825,7 @@ msg sev doc user_sty = mkUserStyle unqual AllTheWay dump_sty = mkDumpStyle unqual ; liftIO $ - (log_action dflags) dflags sev loc sty doc } + (log_action dflags) dflags NoReason sev loc sty doc } -- | Output a String message to the screen putMsgS :: String -> CoreM () diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 6badbf83db..1e7020e4d0 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -428,7 +428,8 @@ ruleCheckPass current_phase pat guts = do dflags <- getDynFlags vis_orphs <- getVisibleOrphanMods liftIO $ Err.showPass dflags "RuleCheck" - liftIO $ log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + liftIO $ log_action dflags dflags NoReason Err.SevDump noSrcSpan + defaultDumpStyle (ruleCheckProgram current_phase pat (RuleEnv rb vis_orphs) (mg_binds guts)) return guts diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index b8491fcbbe..3b636882fe 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -37,7 +37,7 @@ stg2stg dflags module_name binds ; us <- mkSplitUniqSupply 'g' ; when (dopt Opt_D_verbose_stg2stg dflags) - (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (text "VERBOSE STG-TO-STG:")) + (log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (text "VERBOSE STG-TO-STG:")) ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 498687efb2..ab9a4e28c7 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -639,7 +639,9 @@ newClsInst overlap_mode dfun_name tvs theta clas tys ; oflag <- getOverlapFlag overlap_mode ; let inst = mkLocalInstance dfun oflag tvs' clas tys' ; dflags <- getDynFlags - ; warnIf (isOrphan (is_orphan inst) && wopt Opt_WarnOrphans dflags) (instOrphWarn inst) + ; warnIf (Reason Opt_WarnOrphans) + (isOrphan (is_orphan inst) && wopt Opt_WarnOrphans dflags) + (instOrphWarn inst) ; return inst } instOrphWarn :: ClsInst -> SDoc diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs index b80d5bd236..00dac01227 100644 --- a/compiler/typecheck/TcAnnotations.hs +++ b/compiler/typecheck/TcAnnotations.hs @@ -14,6 +14,8 @@ import {-# SOURCE #-} TcSplice ( runAnnotation ) import Module import DynFlags import Control.Monad ( when ) +#else +import DynFlags ( WarnReason(NoReason) ) #endif import HsSyn @@ -29,7 +31,7 @@ tcAnnotations :: [LAnnDecl Name] -> TcM [Annotation] -- No GHCI; emit a warning (not an error) and ignore. cf Trac #4268 tcAnnotations [] = return [] tcAnnotations anns@(L loc _ : _) - = do { setSrcSpan loc $ addWarnTc $ + = do { setSrcSpan loc $ addWarnTc NoReason $ (text "Ignoring ANN annotation" <> plural anns <> comma <+> text "because this is a stage-1 compiler or doesn't support GHCi") ; return [] } diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 58f3761c4a..3d5a401d0f 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -707,7 +707,8 @@ mkExport prag_fn qtvs theta tcSubType_NC sig_ctxt sel_poly_ty (mkCheckExpType poly_ty) ; warn_missing_sigs <- woptM Opt_WarnMissingLocalSignatures - ; when warn_missing_sigs $ localSigWarn poly_id mb_sig + ; when warn_missing_sigs $ + localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig ; return (ABE { abe_wrap = wrap -- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty) @@ -797,7 +798,8 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs , ppr annotated_theta, ppr inferred_theta , ppr inferred_diff ] ; case partial_sigs of - True | warn_partial_sigs -> reportWarning msg + True | warn_partial_sigs -> + reportWarning (Reason Opt_WarnPartialTypeSignatures) msg | otherwise -> return () False -> reportError msg @@ -851,19 +853,19 @@ mk_inf_msg poly_name poly_ty tidy_env -- | Warn the user about polymorphic local binders that lack type signatures. -localSigWarn :: Id -> Maybe TcIdSigInfo -> TcM () -localSigWarn id mb_sig +localSigWarn :: WarningFlag -> Id -> Maybe TcIdSigInfo -> TcM () +localSigWarn flag id mb_sig | Just _ <- mb_sig = return () | not (isSigmaTy (idType id)) = return () - | otherwise = warnMissingSignatures msg id + | otherwise = warnMissingSignatures flag msg id where msg = text "Polymorphic local binding with no type signature:" -warnMissingSignatures :: SDoc -> Id -> TcM () -warnMissingSignatures msg id +warnMissingSignatures :: WarningFlag -> SDoc -> Id -> TcM () +warnMissingSignatures flag msg id = do { env0 <- tcInitTidyEnv ; let (env1, tidy_ty) = tidyOpenType env0 (idType id) - ; addWarnTcM (env1, mk_msg tidy_ty) } + ; addWarnTcM (Reason flag) (env1, mk_msg tidy_ty) } where mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ] @@ -1126,7 +1128,8 @@ tcSpecPrags poly_id prag_sigs is_bad_sig s = not (isSpecLSig s || isInlineLSig s) warn_discarded_sigs - = addWarnTc (hang (text "Discarding unexpected pragmas for" <+> ppr poly_id) + = addWarnTc NoReason + (hang (text "Discarding unexpected pragmas for" <+> ppr poly_id) 2 (vcat (map (ppr . getLoc) bad_sigs))) -------------- @@ -1140,7 +1143,7 @@ tcSpecPrag poly_id prag@(SpecSig fun_name hs_tys inl) -- However we want to use fun_name in the error message, since that is -- what the user wrote (Trac #8537) = addErrCtxt (spec_ctxt prag) $ - do { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) + do { warnIf NoReason (not (isOverloadedTy poly_ty || isInlinePragma inl)) (text "SPECIALISE pragma for non-overloaded function" <+> quotes (ppr fun_name)) -- Note [SPECIALISE pragmas] @@ -1206,7 +1209,7 @@ tcImpSpec :: (Name, Sig Name) -> TcM [TcSpecPrag] tcImpSpec (name, prag) = do { id <- tcLookupId name ; unless (isAnyInlinePragma (idInlinePragma id)) - (addWarnTc (impSpecErr name)) + (addWarnTc NoReason (impSpecErr name)) ; tcSpecPrag id prag } impSpecErr :: Name -> SDoc diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index b1baabb963..602ef64d86 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -210,7 +210,8 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ; spec_prags <- discardConstraints $ tcSpecPrags global_dm_id prags - ; warnTc (not (null spec_prags)) + ; warnTc NoReason + (not (null spec_prags)) (text "Ignoring SPECIALISE pragmas on default method" <+> quotes (ppr sel_name)) @@ -280,7 +281,7 @@ tcClassMinimalDef _clas sigs op_info -- class ops without default methods are required, since we -- have no way to fill them in otherwise whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $ - (\bf -> addWarnTc (warningMinimalDefIncomplete bf)) + (\bf -> addWarnTc NoReason (warningMinimalDefIncomplete bf)) return mindef where -- By default require all methods without a default @@ -487,7 +488,7 @@ warnMissingAT :: Name -> TcM () warnMissingAT name = do { warn <- woptM Opt_WarnMissingMethods ; traceTc "warn" (ppr name <+> ppr warn) - ; warnTc warn -- Warn only if -Wmissing-methods + ; warnTc (Reason Opt_WarnMissingMethods) warn -- Warn only if -Wmissing-methods (text "No explicit" <+> text "associated type" <+> text "or default declaration for " <+> quotes (ppr name)) } diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index c2b344dd77..e98ca8852d 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -559,7 +559,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) warnUselessTypeable :: TcM () warnUselessTypeable = do { warn <- woptM Opt_WarnDerivingTypeable - ; when warn $ addWarnTc + ; when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable) $ text "Deriving" <+> quotes (ppr typeableClassName) <+> text "has no effect: all types now auto-derive Typeable" } @@ -1499,7 +1499,8 @@ mkNewTypeEqn dflags overlap_mode tvs -- CanDerive/DerivableViaInstance _ -> do when (newtype_deriving && deriveAnyClass) $ - addWarnTc (sep [ text "Both DeriveAnyClass and GeneralizedNewtypeDeriving are enabled" + addWarnTc NoReason + (sep [ text "Both DeriveAnyClass and GeneralizedNewtypeDeriving are enabled" , text "Defaulting to the DeriveAnyClass strategy for instantiating" <+> ppr cls ]) go_for_it where diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 15cacafeba..b1cc44975c 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -343,13 +343,13 @@ warnRedundantConstraints ctxt env info ev_vars addErrCtxt (text "In" <+> ppr info) $ do { env <- getLclEnv ; msg <- mkErrorReport ctxt env (important doc) - ; reportWarning msg } + ; reportWarning NoReason msg } | otherwise -- But for InstSkol there already *is* a surrounding -- "In the instance declaration for Eq [a]" context -- and we don't want to say it twice. Seems a bit ad-hoc = do { msg <- mkErrorReport ctxt env (important doc) - ; reportWarning msg } + ; reportWarning NoReason msg } where doc = text "Redundant constraint" <> plural redundant_evs <> colon <+> pprEvVarTheta redundant_evs @@ -573,8 +573,9 @@ reportGroup mk_err ctxt cts = case partition isMonadFailInstanceMissing cts of -- Only warn about missing MonadFail constraint when -- there are no other missing contstraints! - (monadFailCts, []) -> do { err <- mk_err ctxt monadFailCts - ; reportWarning err } + (monadFailCts, []) -> + do { err <- mk_err ctxt monadFailCts + ; reportWarning (Reason Opt_WarnMissingMonadFailInstances) err } (_, cts') -> do { err <- mk_err ctxt cts' ; maybeReportError ctxt err @@ -598,7 +599,7 @@ maybeReportHoleError ctxt ct err -- only if -fwarn_partial_type_signatures is on case cec_type_holes ctxt of HoleError -> reportError err - HoleWarn -> reportWarning err + HoleWarn -> reportWarning (Reason Opt_WarnPartialTypeSignatures) err HoleDefer -> return () -- Otherwise this is a typed hole in an expression @@ -606,7 +607,7 @@ maybeReportHoleError ctxt ct err = -- If deferring, report a warning only if -Wtyped-holds is on case cec_expr_holes ctxt of HoleError -> reportError err - HoleWarn -> reportWarning err + HoleWarn -> reportWarning (Reason Opt_WarnTypedHoles) err HoleDefer -> return () maybeReportError :: ReportErrCtxt -> ErrMsg -> TcM () @@ -616,12 +617,12 @@ maybeReportError ctxt err = return () -- so suppress this error/warning | cec_errors_as_warns ctxt - = reportWarning err + = reportWarning NoReason err | otherwise = case cec_defer_type_errors ctxt of TypeDefer -> return () - TypeWarn -> reportWarning err + TypeWarn -> reportWarning NoReason err TypeError -> reportError err addDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM () @@ -2365,7 +2366,7 @@ warnDefaulting wanteds default_ty , quotes (ppr default_ty) ]) 2 ppr_wanteds - ; setCtLocM loc $ warnTc warn_default warn_msg } + ; setCtLocM loc $ warnTc (Reason Opt_WarnTypeDefaults) warn_default warn_msg } {- Note [Runtime skolems] diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index b98e1de3fd..a2b6bfc063 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -2227,7 +2227,8 @@ checkMissingFields con_like rbinds warn <- woptM Opt_WarnMissingFields unless (not (warn && notNull missing_ns_fields)) - (warnTc True (missingFields con_like missing_ns_fields)) + (warnTc (Reason Opt_WarnMissingFields) True + (missingFields con_like missing_ns_fields)) where missing_s_fields diff --git a/compiler/typecheck/TcForeign.hs b/compiler/typecheck/TcForeign.hs index bc3a9283c6..cb4c9ce385 100644 --- a/compiler/typecheck/TcForeign.hs +++ b/compiler/typecheck/TcForeign.hs @@ -349,7 +349,8 @@ checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM () checkMissingAmpersand dflags arg_tys res_ty | null arg_tys && isFunPtrTy res_ty && wopt Opt_WarnDodgyForeignImports dflags - = addWarn (text "possible missing & in foreign import of FunPtr") + = addWarn (Reason Opt_WarnDodgyForeignImports) + (text "possible missing & in foreign import of FunPtr") | otherwise = return () @@ -522,7 +523,8 @@ checkCConv StdCallConv = do dflags <- getDynFlags then return StdCallConv else do -- This is a warning, not an error. see #3336 when (wopt Opt_WarnUnsupportedCallingConventions dflags) $ - addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall") + addWarnTc (Reason Opt_WarnUnsupportedCallingConventions) + (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall") return CCallConv checkCConv PrimCallConv = do addErrTc (text "The `prim' calling convention can only be used with `foreign import'") return PrimCallConv diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 460089e457..9da27bfcd3 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -447,7 +447,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls if isHsBootOrSig (tcg_src env) then do warn <- woptM Opt_WarnDerivingTypeable - when warn $ addWarnTc $ vcat + when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable) $ vcat [ ppTypeable <+> text "instances in .hs-boot files are ignored" , text "This warning will become an error in future versions of the compiler" ] @@ -1571,7 +1571,7 @@ derivBindCtxt sel_id clas tys warnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM () warnUnsatisfiedMinimalDefinition mindef = do { warn <- woptM Opt_WarnMissingMethods - ; warnTc warn message + ; warnTc (Reason Opt_WarnMissingMethods) warn message } where message = vcat [text "No explicit implementation for" diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index 5f3bc5b73a..b96746d85f 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -975,7 +975,9 @@ emitMonadFailConstraint pat res_ty ; return () } warnRebindableClash :: LPat TcId -> TcRn () -warnRebindableClash pattern = addWarnAt (getLoc pattern) +warnRebindableClash pattern = addWarnAt + (Reason Opt_WarnMissingMonadFailInstances) + (getLoc pattern) (text "The failable pattern" <+> quotes (ppr pattern) $$ nest 2 (text "is used together with -XRebindableSyntax." diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index bd769bfe29..95946460e1 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -219,7 +219,8 @@ addInlinePrags poly_id prags warn_multiple_inlines inl2 inls | otherwise = setSrcSpan loc $ - addWarnTc (hang (text "Multiple INLINE pragmas for" <+> ppr poly_id) + addWarnTc NoReason + (hang (text "Multiple INLINE pragmas for" <+> ppr poly_id) 2 (vcat (text "Ignoring all but the first" : map pp_inl (inl1:inl2:inls)))) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index a2a04e9bde..93da03f754 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -310,7 +310,8 @@ tcRnModuleTcRnM hsc_env hsc_src implicit_prelude import_decls } ; whenWOptM Opt_WarnImplicitPrelude $ - when (notNull prel_imports) $ addWarn (implicitPreludeWarn) ; + when (notNull prel_imports) $ + addWarn (Reason Opt_WarnImplicitPrelude) (implicitPreludeWarn) ; tcg_env <- {-# SCC "tcRnImports" #-} tcRnImports hsc_env (prel_imports ++ import_decls) ; @@ -1286,7 +1287,7 @@ tcPreludeClashWarn warnFlag name = do ; traceTc "tcPreludeClashWarn/prelude_functions" (hang (ppr name) 4 (sep [ppr clashingElts])) - ; let warn_msg x = addWarnAt (nameSrcSpan (gre_name x)) (hsep + ; let warn_msg x = addWarnAt (Reason warnFlag) (nameSrcSpan (gre_name x)) (hsep [ text "Local definition of" , (quotes . ppr . nameOccName . gre_name) x , text "clashes with a future Prelude name." ] @@ -1397,7 +1398,7 @@ tcMissingParentClassWarn warnFlag isName shouldName -- <should>" e.g. "Foo is an instance of Monad but not Applicative" ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst warnMsg (Just name:_) = - addWarnAt instLoc $ + addWarnAt (Reason warnFlag) instLoc $ hsep [ (quotes . ppr . nameOccName) name , text "is an instance of" , (ppr . nameOccName . className) isClass diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 8cf0d748e3..77ad2ac071 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -719,9 +719,10 @@ checkErr :: Bool -> MsgDoc -> TcRn () -- Add the error if the bool is False checkErr ok msg = unless ok (addErr msg) -warnIf :: Bool -> MsgDoc -> TcRn () -warnIf True msg = addWarn msg -warnIf False _ = return () +-- | Display a warning if a condition is met. +warnIf :: WarnReason -> Bool -> MsgDoc -> TcRn () +warnIf reason True msg = addWarn reason msg +warnIf _ False _ = return () addMessages :: Messages -> TcRn () addMessages msgs1 @@ -777,9 +778,9 @@ reportError err (warns, errs) <- readTcRef errs_var ; writeTcRef errs_var (warns, errs `snocBag` err) } -reportWarning :: ErrMsg -> TcRn () -reportWarning err - = do { let warn = makeIntoWarning err +reportWarning :: WarnReason -> ErrMsg -> TcRn () +reportWarning reason err + = do { let warn = makeIntoWarning reason err -- 'err' was built by mkLongErrMsg or something like that, -- so it's of error severity. For a warning we downgrade -- its severity to SevWarning @@ -1081,44 +1082,54 @@ failIfTcM True err = failWithTcM err -- Warnings have no 'M' variant, nor failure -warnTc :: Bool -> MsgDoc -> TcM () -warnTc warn_if_true warn_msg - | warn_if_true = addWarnTc warn_msg +-- | Display a warning if a condition is met. +warnTc :: WarnReason -> Bool -> MsgDoc -> TcM () +warnTc reason warn_if_true warn_msg + | warn_if_true = addWarnTc reason warn_msg | otherwise = return () -warnTcM :: Bool -> (TidyEnv, MsgDoc) -> TcM () -warnTcM warn_if_true warn_msg - | warn_if_true = addWarnTcM warn_msg +-- | Display a warning if a condition is met. +warnTcM :: WarnReason -> Bool -> (TidyEnv, MsgDoc) -> TcM () +warnTcM reason warn_if_true warn_msg + | warn_if_true = addWarnTcM reason warn_msg | otherwise = return () -addWarnTc :: MsgDoc -> TcM () -addWarnTc msg = do { env0 <- tcInitTidyEnv - ; addWarnTcM (env0, msg) } +-- | Display a warning in the current context. +addWarnTc :: WarnReason -> MsgDoc -> TcM () +addWarnTc reason msg + = do { env0 <- tcInitTidyEnv ; + addWarnTcM reason (env0, msg) } -addWarnTcM :: (TidyEnv, MsgDoc) -> TcM () -addWarnTcM (env0, msg) +-- | Display a warning in a given context. +addWarnTcM :: WarnReason -> (TidyEnv, MsgDoc) -> TcM () +addWarnTcM reason (env0, msg) = do { ctxt <- getErrCtxt ; err_info <- mkErrInfo env0 ctxt ; - add_warn msg err_info } + add_warn reason msg err_info } -addWarn :: MsgDoc -> TcRn () -addWarn msg = add_warn msg Outputable.empty +-- | Display a warning for the current source location. +addWarn :: WarnReason -> MsgDoc -> TcRn () +addWarn reason msg = add_warn reason msg Outputable.empty -addWarnAt :: SrcSpan -> MsgDoc -> TcRn () -addWarnAt loc msg = add_warn_at loc msg Outputable.empty +-- | Display a warning for a given source location. +addWarnAt :: WarnReason -> SrcSpan -> MsgDoc -> TcRn () +addWarnAt reason loc msg = add_warn_at reason loc msg Outputable.empty -add_warn :: MsgDoc -> MsgDoc -> TcRn () -add_warn msg extra_info +-- | Display a warning, with an optional flag, for the current source +-- location. +add_warn :: WarnReason -> MsgDoc -> MsgDoc -> TcRn () +add_warn reason msg extra_info = do { loc <- getSrcSpanM - ; add_warn_at loc msg extra_info } + ; add_warn_at reason loc msg extra_info } -add_warn_at :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn () -add_warn_at loc msg extra_info +-- | Display a warning, with an optional flag, for a given location. +add_warn_at :: WarnReason -> SrcSpan -> MsgDoc -> MsgDoc -> TcRn () +add_warn_at reason loc msg extra_info = do { dflags <- getDynFlags ; printer <- getPrintUnqualified dflags ; let { warn = mkLongWarnMsg dflags loc printer msg extra_info } ; - reportWarning warn } + reportWarning reason warn } tcInitTidyEnv :: TcM TidyEnv tcInitTidyEnv @@ -1486,7 +1497,8 @@ failIfM msg = do { env <- getLclEnv ; let full_msg = (if_loc env <> colon) $$ nest 2 msg ; dflags <- getDynFlags - ; liftIO (log_action dflags dflags SevFatal noSrcSpan (defaultErrStyle dflags) full_msg) + ; liftIO (log_action dflags dflags NoReason SevFatal + noSrcSpan (defaultErrStyle dflags) full_msg) ; failM } -------------------- @@ -1522,7 +1534,13 @@ forkM_maybe doc thing_inside dflags <- getDynFlags let msg = hang (text "forkM failed:" <+> doc) 2 (text (show exn)) - liftIO $ log_action dflags dflags SevFatal noSrcSpan (defaultErrStyle dflags) msg + liftIO $ log_action dflags + dflags + NoReason + SevFatal + noSrcSpan + (defaultErrStyle dflags) + msg ; traceIf (text "} ending fork (badly)" <+> doc) ; return Nothing } diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 4e5cceb07a..303fee8edb 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -2351,9 +2351,10 @@ wrapWarnTcS :: TcM a -> TcS a wrapWarnTcS = wrapTcS failTcS, panicTcS :: SDoc -> TcS a -warnTcS, addErrTcS :: SDoc -> TcS () +warnTcS :: WarningFlag -> SDoc -> TcS () +addErrTcS :: SDoc -> TcS () failTcS = wrapTcS . TcM.failWith -warnTcS = wrapTcS . TcM.addWarn +warnTcS flag = wrapTcS . TcM.addWarn (Reason flag) addErrTcS = wrapTcS . TcM.addErr panicTcS doc = pprPanic "TcCanonical" doc diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index a19ceaa39d..b99823e728 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -18,6 +18,7 @@ module TcSimplify( import Bag import Class ( Class, classKey, classTyCon ) import DynFlags ( WarningFlag ( Opt_WarnMonomorphism ) + , WarnReason ( Reason ) , DynFlags( solverIterations ) ) import Inst import ListSetOps @@ -742,7 +743,7 @@ decideQuantification apply_mr sigs name_taus constraints -- Warn about the monomorphism restriction ; warn_mono <- woptM Opt_WarnMonomorphism ; let mr_bites = constrained_tvs `intersectsVarSet` zonked_tkvs - ; warnTc (warn_mono && mr_bites) $ + ; warnTc (Reason Opt_WarnMonomorphism) (warn_mono && mr_bites) $ hang (text "The Monomorphism Restriction applies to the binding" <> plural bndrs <+> text "for" <+> pp_bndrs) 2 (text "Consider giving a type signature for" diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index ac2ad01864..cabe75e90c 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -807,7 +807,7 @@ instance TH.Quasi TcM where -- 'msg' is forced to ensure exceptions don't escape, -- see Note [Exceptions in TH] qReport True msg = seqList msg $ addErr (text msg) - qReport False msg = seqList msg $ addWarn (text msg) + qReport False msg = seqList msg $ addWarn NoReason (text msg) qLocation = do { m <- getModule ; l <- getSrcSpanM diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 6fee0124a3..31eaeb0d5d 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -2141,13 +2141,13 @@ checkValidDataCon dflags existential_ok tc con (bad_bang n (text "Lazy annotation (~) without StrictData")) check_bang (HsSrcBang _ want_unpack strict_mark) rep_bang n | isSrcUnpacked want_unpack, not is_strict - = addWarnTc (bad_bang n (text "UNPACK pragma lacks '!'")) + = addWarnTc NoReason (bad_bang n (text "UNPACK pragma lacks '!'")) | isSrcUnpacked want_unpack , case rep_bang of { HsUnpack {} -> False; _ -> True } , not (gopt Opt_OmitInterfacePragmas dflags) -- If not optimising, se don't unpack, so don't complain! -- See MkId.dataConArgRep, the (HsBang True) case - = addWarnTc (bad_bang n (text "Ignoring unusable UNPACK pragma")) + = addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma")) where is_strict = case strict_mark of NoSrcStrict -> xopt LangExt.StrictData dflags diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 319c15dd77..784cfa0211 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -684,8 +684,9 @@ check_valid_theta _ _ [] = return () check_valid_theta env ctxt theta = do { dflags <- getDynFlags - ; warnTcM (wopt Opt_WarnDuplicateConstraints dflags && - notNull dups) (dupPredWarn env dups) + ; warnTcM (Reason Opt_WarnDuplicateConstraints) + (wopt Opt_WarnDuplicateConstraints dflags && notNull dups) + (dupPredWarn env dups) ; traceTc "check_valid_theta" (ppr theta) ; mapM_ (check_pred_ty env dflags ctxt) theta } where @@ -1455,7 +1456,7 @@ checkValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) -- (b) failure of injectivity check_branch_compat prev_branches cur_branch | cur_branch `isDominatedBy` prev_branches - = do { addWarnAt (coAxBranchSpan cur_branch) $ + = do { addWarnAt NoReason (coAxBranchSpan cur_branch) $ inaccessibleCoAxBranch ax cur_branch ; return prev_branches } | otherwise diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 24f8039451..3f24f6a6dc 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -102,6 +102,15 @@ The following flags are simple ways to select standard "packages" of warnings: Warnings are treated only as warnings, not as errors. This is the default, but can be useful to negate a :ghc-flag:`-Werror` flag. +When a warning is emitted, the specific warning flag which controls +it, as well as the group it belongs to, are shown. + +.. ghc-flag:: -fshow-warning-groups + + Name the group a warning flag belongs to. + + This is enabled by default. Disable with ``-fno-show-warning-groups``. + The full set of warning options is described below. To turn off any warning, simply give the corresponding ``-Wno-...`` option on the command line. For backwards compatibility with GHC versions prior to 8.0, diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index deb37556ce..4b39159c83 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -473,8 +473,8 @@ resetLastErrorLocations = do liftIO $ writeIORef (lastErrorLocations st) [] ghciLogAction :: IORef [(FastString, Int)] -> LogAction -ghciLogAction lastErrLocations dflags severity srcSpan style msg = do - defaultLogAction dflags severity srcSpan style msg +ghciLogAction lastErrLocations dflags flag severity srcSpan style msg = do + defaultLogAction dflags flag severity srcSpan style msg case severity of SevError -> case srcSpan of RealSrcSpan rsp -> modifyIORef lastErrLocations diff --git a/testsuite/tests/deSugar/should_compile/ds041.stderr b/testsuite/tests/deSugar/should_compile/ds041.stderr index c276b77ce9..5580c5eda3 100644 --- a/testsuite/tests/deSugar/should_compile/ds041.stderr +++ b/testsuite/tests/deSugar/should_compile/ds041.stderr @@ -1,8 +1,8 @@ -ds041.hs:1:14: Warning: +ds041.hs:1:14: warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -ds041.hs:16:7: Warning: - Fields of ‘Foo’ not initialised: x - In the expression: Foo {} - In an equation for ‘foo’: foo = Foo {} +ds041.hs:16:7: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘Foo’ not initialised: x + • In the expression: Foo {} + In an equation for ‘foo’: foo = Foo {} diff --git a/testsuite/tests/deSugar/should_compile/ds053.stderr b/testsuite/tests/deSugar/should_compile/ds053.stderr index 52aa9d7917..6e7cb2572c 100644 --- a/testsuite/tests/deSugar/should_compile/ds053.stderr +++ b/testsuite/tests/deSugar/should_compile/ds053.stderr @@ -1,2 +1,3 @@ -ds053.hs:5:1: Warning: Defined but not used: ‘f’ +ds053.hs:5:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘f’ diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr index 49a39a96e8..f6ec57e03d 100644 --- a/testsuite/tests/dependent/should_compile/T11241.stderr +++ b/testsuite/tests/dependent/should_compile/T11241.stderr @@ -1,5 +1,5 @@ -T11241.hs:5:21: warning: +T11241.hs:5:21: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘*’ • In the type signature: foo :: forall (a :: _). a -> a diff --git a/testsuite/tests/deriving/should_compile/T4966.stderr b/testsuite/tests/deriving/should_compile/T4966.stderr index 765c69756d..9cd16e50f2 100644 --- a/testsuite/tests/deriving/should_compile/T4966.stderr +++ b/testsuite/tests/deriving/should_compile/T4966.stderr @@ -1,8 +1,8 @@ -T4966.hs:3:14: Warning: +T4966.hs:3:14: warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -T4966.hs:35:30: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (TreeListObject a)’ +T4966.hs:35:30: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (TreeListObject a)’ diff --git a/testsuite/tests/deriving/should_compile/deriving-1935.stderr b/testsuite/tests/deriving/should_compile/deriving-1935.stderr index 9901a367d7..091990bcd9 100644 --- a/testsuite/tests/deriving/should_compile/deriving-1935.stderr +++ b/testsuite/tests/deriving/should_compile/deriving-1935.stderr @@ -1,15 +1,15 @@ -deriving-1935.hs:17:11: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (T a)’ +deriving-1935.hs:17:11: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (T a)’ -deriving-1935.hs:20:11: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (S a)’ +deriving-1935.hs:20:11: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (S a)’ -deriving-1935.hs:21:11: Warning: - No explicit implementation for - either ‘compare’ or ‘<=’ - In the instance declaration for ‘Ord (S a)’ +deriving-1935.hs:21:11: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘compare’ or ‘<=’ + • In the instance declaration for ‘Ord (S a)’ diff --git a/testsuite/tests/deriving/should_compile/drv003.stderr b/testsuite/tests/deriving/should_compile/drv003.stderr index ead606d28a..f939631a8e 100644 --- a/testsuite/tests/deriving/should_compile/drv003.stderr +++ b/testsuite/tests/deriving/should_compile/drv003.stderr @@ -1,10 +1,10 @@ -drv003.hs:14:10: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (Foo a)’ +drv003.hs:14:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (Foo a)’ -drv003.hs:17:10: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (Bar b)’ +drv003.hs:17:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (Bar b)’ diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr index 00240a07b3..09424963b2 100644 --- a/testsuite/tests/driver/werror.stderr +++ b/testsuite/tests/driver/werror.stderr @@ -1,20 +1,22 @@ -werror.hs:6:1: warning: +werror.hs:6:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: main :: IO () -werror.hs:7:13: warning: +werror.hs:7:13: warning: [-Wname-shadowing (in -Wall)] This binding for ‘main’ shadows the existing binding defined at werror.hs:6:1 -werror.hs:7:13: warning: Defined but not used: ‘main’ +werror.hs:7:13: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘main’ werror.hs:8:1: warning: Tab character found here. Please use spaces instead. -werror.hs:10:1: warning: Defined but not used: ‘f’ +werror.hs:10:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘f’ -werror.hs:10:1: warning: +werror.hs:10:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: f :: forall t t1. [t] -> [t1] diff --git a/testsuite/tests/ffi/should_compile/T1357.stderr b/testsuite/tests/ffi/should_compile/T1357.stderr index 6678973fe4..0a91e883f8 100644 --- a/testsuite/tests/ffi/should_compile/T1357.stderr +++ b/testsuite/tests/ffi/should_compile/T1357.stderr @@ -1,3 +1,3 @@ -T1357.hs:5:1: - Warning: possible missing & in foreign import of FunPtr +T1357.hs:5:1: warning: [-Wdodgy-foreign-imports (in -Wdefault)] + possible missing & in foreign import of FunPtr diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs index dc6edb21a8..bd6fb37d8b 100644 --- a/testsuite/tests/ghc-api/T7478/T7478.hs +++ b/testsuite/tests/ghc-api/T7478/T7478.hs @@ -41,9 +41,9 @@ compileInGhc targets handlerOutput = do TargetFile file Nothing -> file _ -> error "fileFromTarget: not a known target" - collectSrcError handlerOutput flags SevOutput _srcspan style msg + collectSrcError handlerOutput flags _ SevOutput _srcspan style msg = handlerOutput $ GHC.showSDocForUser flags (queryQual style) msg - collectSrcError _ _ _ _ _ _ + collectSrcError _ _ _ _ _ _ _ = return () main :: IO () diff --git a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr index d778df2783..a943e48a3b 100644 --- a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr +++ b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr @@ -1,9 +1,9 @@ -B.hs:4:1: warning: +B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: +B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘Integer’ (Enum a0) arising from the arithmetic sequence ‘1 .. 23 * 2’ at B.hs:5:12-20 @@ -12,14 +12,14 @@ B.hs:5:12: warning: In the first argument of ‘(-)’, namely ‘length [1 .. 23 * 2]’ In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: +A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: main :: IO () -B.hs:4:1: warning: +B.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: answer_to_live_the_universe_and_everything :: Int -B.hs:5:12: warning: +B.hs:5:12: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘Integer’ (Enum a0) arising from the arithmetic sequence ‘1 .. 23 * 2’ at B.hs:5:12-20 @@ -28,5 +28,5 @@ B.hs:5:12: warning: In the first argument of ‘(-)’, namely ‘length [1 .. 23 * 2]’ In the expression: length [1 .. 23 * 2] - 4 -A.hs:7:1: warning: +A.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: main :: IO () diff --git a/testsuite/tests/ghci/scripts/T5820.stderr b/testsuite/tests/ghci/scripts/T5820.stderr index dc89a5fa9b..3f46fdbc47 100644 --- a/testsuite/tests/ghci/scripts/T5820.stderr +++ b/testsuite/tests/ghci/scripts/T5820.stderr @@ -1,5 +1,5 @@ -T5820.hs:3:10: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq Foo’ +T5820.hs:3:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq Foo’ diff --git a/testsuite/tests/ghci/scripts/T8353.stderr b/testsuite/tests/ghci/scripts/T8353.stderr index 8914820a61..41be9353c1 100644 --- a/testsuite/tests/ghci/scripts/T8353.stderr +++ b/testsuite/tests/ghci/scripts/T8353.stderr @@ -4,7 +4,7 @@ Defer03.hs:4:5: warning: • In the expression: 'p' In an equation for ‘a’: a = 'p' -Defer03.hs:7:5: warning: +Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In the expression: _ In an equation for ‘f’: f = _ @@ -26,7 +26,7 @@ Defer03.hs:4:5: warning: • In the expression: 'p' In an equation for ‘a’: a = 'p' -Defer03.hs:7:5: warning: +Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In the expression: _ In an equation for ‘f’: f = _ @@ -48,7 +48,7 @@ Defer03.hs:4:5: warning: • In the expression: 'p' In an equation for ‘a’: a = 'p' -Defer03.hs:7:5: warning: +Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In the expression: _ In an equation for ‘f’: f = _ diff --git a/testsuite/tests/ghci/scripts/ghci019.stderr b/testsuite/tests/ghci/scripts/ghci019.stderr index aedf854e8a..0d3378ec8e 100644 --- a/testsuite/tests/ghci/scripts/ghci019.stderr +++ b/testsuite/tests/ghci/scripts/ghci019.stderr @@ -1,5 +1,5 @@ -ghci019.hs:9:10: warning: +ghci019.hs:9:10: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for either ‘Prelude.==’ or ‘Prelude./=’ • In the instance declaration for ‘Prelude.Eq Foo’ diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index 25225797d4..96cafba30f 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -186,10 +186,14 @@ m = undefined -Test.hs:33:9: Warning: ‘p’ is exported by ‘p’ and ‘R(..)’ +Test.hs:33:9: warning: [-Wduplicate-exports (in -Wdefault)] + ‘p’ is exported by ‘p’ and ‘R(..)’ -Test.hs:33:12: Warning: ‘q’ is exported by ‘q’ and ‘R(..)’ +Test.hs:33:12: warning: [-Wduplicate-exports (in -Wdefault)] + ‘q’ is exported by ‘q’ and ‘R(..)’ -Test.hs:33:15: Warning: ‘u’ is exported by ‘u’ and ‘R(..)’ +Test.hs:33:15: warning: [-Wduplicate-exports (in -Wdefault)] + ‘u’ is exported by ‘u’ and ‘R(..)’ -Test.hs:39:9: Warning: ‘a’ is exported by ‘a’ and ‘C(a, b)’ +Test.hs:39:9: warning: [-Wduplicate-exports (in -Wdefault)] + ‘a’ is exported by ‘a’ and ‘C(a, b)’ diff --git a/testsuite/tests/indexed-types/should_compile/Class3.stderr b/testsuite/tests/indexed-types/should_compile/Class3.stderr index 2616c2e3f5..86aa24c69d 100644 --- a/testsuite/tests/indexed-types/should_compile/Class3.stderr +++ b/testsuite/tests/indexed-types/should_compile/Class3.stderr @@ -1,5 +1,5 @@ -Class3.hs:7:10: Warning: - No explicit implementation for - ‘foo’ - In the instance declaration for ‘C ()’ +Class3.hs:7:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo’ + • In the instance declaration for ‘C ()’ diff --git a/testsuite/tests/indexed-types/should_compile/Simple2.stderr b/testsuite/tests/indexed-types/should_compile/Simple2.stderr index 11ea628034..4b3b0f619a 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple2.stderr +++ b/testsuite/tests/indexed-types/should_compile/Simple2.stderr @@ -1,31 +1,31 @@ -Simple2.hs:21:1: Warning: - No explicit associated type or default declaration for ‘S3n’ - In the instance declaration for ‘C3 Char’ +Simple2.hs:21:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘S3n’ + • In the instance declaration for ‘C3 Char’ -Simple2.hs:21:10: Warning: - No explicit implementation for - ‘foo3n’ and ‘bar3n’ - In the instance declaration for ‘C3 Char’ +Simple2.hs:21:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo3n’ and ‘bar3n’ + • In the instance declaration for ‘C3 Char’ -Simple2.hs:29:1: Warning: - No explicit associated type or default declaration for ‘S3n’ - In the instance declaration for ‘C3 Bool’ +Simple2.hs:29:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘S3n’ + • In the instance declaration for ‘C3 Bool’ -Simple2.hs:29:10: Warning: - No explicit implementation for - ‘foo3n’ and ‘bar3n’ - In the instance declaration for ‘C3 Bool’ +Simple2.hs:29:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo3n’ and ‘bar3n’ + • In the instance declaration for ‘C3 Bool’ -Simple2.hs:39:1: Warning: - No explicit associated type or default declaration for ‘S3’ - In the instance declaration for ‘C3 Float’ +Simple2.hs:39:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘S3’ + • In the instance declaration for ‘C3 Float’ -Simple2.hs:39:1: Warning: - No explicit associated type or default declaration for ‘S3n’ - In the instance declaration for ‘C3 Float’ +Simple2.hs:39:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘S3n’ + • In the instance declaration for ‘C3 Float’ -Simple2.hs:39:10: Warning: - No explicit implementation for - ‘foo3n’ and ‘bar3n’ - In the instance declaration for ‘C3 Float’ +Simple2.hs:39:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo3n’ and ‘bar3n’ + • In the instance declaration for ‘C3 Float’ diff --git a/testsuite/tests/indexed-types/should_compile/T3023.stderr b/testsuite/tests/indexed-types/should_compile/T3023.stderr index 81afa91f60..95fee97355 100644 --- a/testsuite/tests/indexed-types/should_compile/T3023.stderr +++ b/testsuite/tests/indexed-types/should_compile/T3023.stderr @@ -1,3 +1,3 @@ -T3023.hs:18:1: Warning: +T3023.hs:18:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: bar :: Bool -> Bool diff --git a/testsuite/tests/indexed-types/should_compile/T8889.stderr b/testsuite/tests/indexed-types/should_compile/T8889.stderr index 44cb453421..b93be8cc36 100644 --- a/testsuite/tests/indexed-types/should_compile/T8889.stderr +++ b/testsuite/tests/indexed-types/should_compile/T8889.stderr @@ -1,5 +1,5 @@ -T8889.hs:12:1: warning: +T8889.hs:12:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: f :: forall (f :: * -> *) a b. (C f, C_fmap f a) => diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr index 1bfced7943..1ff5858094 100644 --- a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr +++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr @@ -1,15 +1,12 @@ -UnusedTyVarWarnings.hs:8:5: warning: + +UnusedTyVarWarnings.hs:8:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ -UnusedTyVarWarnings.hs:11:18: warning: +UnusedTyVarWarnings.hs:11:18: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ -UnusedTyVarWarnings.hs:27:5: warning: +UnusedTyVarWarnings.hs:27:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘a’ -UnusedTyVarWarnings.hs:33:17: warning: +UnusedTyVarWarnings.hs:33:17: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ - - - - diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr index c4895aaab8..889f1921f9 100644 --- a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr +++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr @@ -1,12 +1,12 @@ -UnusedTyVarWarningsNamedWCs.hs:8:5: warning: + +UnusedTyVarWarningsNamedWCs.hs:8:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ -UnusedTyVarWarningsNamedWCs.hs:11:18: warning: +UnusedTyVarWarningsNamedWCs.hs:11:18: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ -UnusedTyVarWarningsNamedWCs.hs:27:5: warning: +UnusedTyVarWarningsNamedWCs.hs:27:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘a’ -UnusedTyVarWarningsNamedWCs.hs:33:17: warning: +UnusedTyVarWarningsNamedWCs.hs:33:17: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: type variable ‘b’ - diff --git a/testsuite/tests/indexed-types/should_fail/T7862.stderr b/testsuite/tests/indexed-types/should_fail/T7862.stderr index 5a14fc3480..d430310aa9 100644 --- a/testsuite/tests/indexed-types/should_fail/T7862.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7862.stderr @@ -1,7 +1,7 @@ -T7862.hs:23:10: Warning: - No explicit implementation for - ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’ - or - ‘-’) - In the instance declaration for ‘Num (Tower s a)’ +T7862.hs:23:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’ + or + ‘-’) + • In the instance declaration for ‘Num (Tower s a)’ diff --git a/testsuite/tests/module/mod128.stderr b/testsuite/tests/module/mod128.stderr index bfd02c6b8d..c4e1e21c34 100644 --- a/testsuite/tests/module/mod128.stderr +++ b/testsuite/tests/module/mod128.stderr @@ -1,2 +1,3 @@ -Mod128_A.hs:2:19: Warning: ‘T’ is exported by ‘T(Con)’ and ‘T’ +Mod128_A.hs:2:19: warning: [-Wduplicate-exports (in -Wdefault)] + ‘T’ is exported by ‘T(Con)’ and ‘T’ diff --git a/testsuite/tests/module/mod14.stderr b/testsuite/tests/module/mod14.stderr index 682cbe3400..1eef269d33 100644 --- a/testsuite/tests/module/mod14.stderr +++ b/testsuite/tests/module/mod14.stderr @@ -1,3 +1,3 @@ -mod14.hs:2:10: Warning: +mod14.hs:2:10: warning: [-Wduplicate-exports (in -Wdefault)] ‘m2’ is exported by ‘C(m1, m2, m2, m3)’ and ‘C(m1, m2, m2, m3)’ diff --git a/testsuite/tests/module/mod176.stderr b/testsuite/tests/module/mod176.stderr index d69ba608f6..20ccfc1ffb 100644 --- a/testsuite/tests/module/mod176.stderr +++ b/testsuite/tests/module/mod176.stderr @@ -1,4 +1,4 @@ -mod176.hs:4:1: Warning: +mod176.hs:4:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Monad, return’ from module ‘Control.Monad’ is redundant diff --git a/testsuite/tests/module/mod177.stderr b/testsuite/tests/module/mod177.stderr index d695eead60..2f9ffbbe0b 100644 --- a/testsuite/tests/module/mod177.stderr +++ b/testsuite/tests/module/mod177.stderr @@ -1,5 +1,5 @@ -mod177.hs:5:1: warning: +mod177.hs:5:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Data.Maybe’ is redundant except perhaps to import instances from ‘Data.Maybe’ To import instances alone, use: import Data.Maybe() diff --git a/testsuite/tests/module/mod5.stderr b/testsuite/tests/module/mod5.stderr index 07967f0e21..e8d5adb36e 100644 --- a/testsuite/tests/module/mod5.stderr +++ b/testsuite/tests/module/mod5.stderr @@ -1,3 +1,3 @@ -mod5.hs:2:10: Warning: +mod5.hs:2:10: warning: [-Wduplicate-exports (in -Wdefault)] ‘K1’ is exported by ‘T(K1, K1)’ and ‘T(K1, K1)’ diff --git a/testsuite/tests/module/mod89.stderr b/testsuite/tests/module/mod89.stderr index 5b2f422455..a1e335c9ff 100644 --- a/testsuite/tests/module/mod89.stderr +++ b/testsuite/tests/module/mod89.stderr @@ -1,10 +1,10 @@ -mod89.hs:5:1: warning: +mod89.hs:5:1: warning: [-Wdodgy-imports (in -Wextra)] The import item ‘map(..)’ suggests that ‘map’ has (in-scope) constructors or class methods, but it has none -mod89.hs:5:1: warning: +mod89.hs:5:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Prelude’ is redundant except perhaps to import instances from ‘Prelude’ To import instances alone, use: import Prelude() diff --git a/testsuite/tests/monadfail/MonadFailWarnings.stderr b/testsuite/tests/monadfail/MonadFailWarnings.stderr index af2606a392..544f14aeb4 100644 --- a/testsuite/tests/monadfail/MonadFailWarnings.stderr +++ b/testsuite/tests/monadfail/MonadFailWarnings.stderr @@ -1,5 +1,5 @@ -MonadFailWarnings.hs:19:5: warning: +MonadFailWarnings.hs:19:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • Could not deduce (MonadFail m) arising from the failable pattern ‘Just x’ (this will become an error in a future GHC release) @@ -20,7 +20,7 @@ MonadFailWarnings.hs:19:5: warning: = do { Just x <- undefined; undefined } -MonadFailWarnings.hs:35:5: warning: +MonadFailWarnings.hs:35:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail Identity) arising from the failable pattern ‘Just x’ (this will become an error in a future GHC release) @@ -33,7 +33,7 @@ MonadFailWarnings.hs:35:5: warning: = do { Just x <- undefined; undefined } -MonadFailWarnings.hs:51:5: warning: +MonadFailWarnings.hs:51:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail (ST s)) arising from the failable pattern ‘Just x’ (this will become an error in a future GHC release) @@ -46,7 +46,7 @@ MonadFailWarnings.hs:51:5: warning: = do { Just x <- undefined; undefined } -MonadFailWarnings.hs:59:5: warning: +MonadFailWarnings.hs:59:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail ((->) r)) arising from the failable pattern ‘Just x’ (this will become an error in a future GHC release) diff --git a/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr index 9610f8971f..7b6cd1ba6d 100644 --- a/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr +++ b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr @@ -1,5 +1,5 @@ -MonadFailWarningsWithRebindableSyntax.hs:13:5: warning: +MonadFailWarningsWithRebindableSyntax.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] The failable pattern ‘Just x’ is used together with -XRebindableSyntax. If this is intentional, compile with -Wno-missing-monadfail-instances. diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr index 687d6d6eda..90d38fd712 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr @@ -1,5 +1,5 @@ -overloadedrecfldsfail05.hs:7:16: warning: +overloadedrecfldsfail05.hs:7:16: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: ‘foo’ <no location info>: error: diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr index 6a1b939a55..6161755562 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr @@ -1,29 +1,29 @@ [1 of 2] Compiling OverloadedRecFldsFail06_A ( OverloadedRecFldsFail06_A.hs, OverloadedRecFldsFail06_A.o ) -OverloadedRecFldsFail06_A.hs:9:15: warning: +OverloadedRecFldsFail06_A.hs:9:15: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: data constructor ‘MkUnused’ -OverloadedRecFldsFail06_A.hs:9:42: warning: +OverloadedRecFldsFail06_A.hs:9:42: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: ‘unused2’ -OverloadedRecFldsFail06_A.hs:9:59: warning: +OverloadedRecFldsFail06_A.hs:9:59: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] Defined but not used: ‘used_locally’ [2 of 2] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o ) -overloadedrecfldsfail06.hs:7:1: warning: +overloadedrecfldsfail06.hs:7:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Unused(unused), V(x), U(y), MkV, Unused’ from module ‘OverloadedRecFldsFail06_A’ is redundant -overloadedrecfldsfail06.hs:8:1: warning: +overloadedrecfldsfail06.hs:8:1: warning: [-Wunused-imports (in -Wextra)] The qualified import of ‘OverloadedRecFldsFail06_A’ is redundant except perhaps to import instances from ‘OverloadedRecFldsFail06_A’ To import instances alone, use: import OverloadedRecFldsFail06_A() -overloadedrecfldsfail06.hs:9:1: warning: +overloadedrecfldsfail06.hs:9:1: warning: [-Wunused-imports (in -Wextra)] The qualified import of ‘V(y)’ from module ‘OverloadedRecFldsFail06_A’ is redundant -overloadedrecfldsfail06.hs:10:1: warning: +overloadedrecfldsfail06.hs:10:1: warning: [-Wunused-imports (in -Wextra)] The qualified import of ‘U(x), U’ from module ‘OverloadedRecFldsFail06_A’ is redundant diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr index 771a46f10c..dac6d29ef2 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr @@ -1,9 +1,9 @@ [1 of 2] Compiling OverloadedRecFldsFail11_A ( OverloadedRecFldsFail11_A.hs, OverloadedRecFldsFail11_A.o ) [2 of 2] Compiling Main ( overloadedrecfldsfail11.hs, overloadedrecfldsfail11.o ) -overloadedrecfldsfail11.hs:5:15: warning: +overloadedrecfldsfail11.hs:5:15: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘foo’ (imported from OverloadedRecFldsFail11_A): "Warning on a record field" -<no location info>: error: +<no location info>: error: Failing due to -Werror. diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr index f4a2f7bcfc..7cd9151c56 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr @@ -1,15 +1,15 @@ [1 of 2] Compiling OverloadedRecFldsFail12_A ( OverloadedRecFldsFail12_A.hs, OverloadedRecFldsFail12_A.o ) [2 of 2] Compiling Main ( overloadedrecfldsfail12.hs, overloadedrecfldsfail12.o ) -overloadedrecfldsfail12.hs:10:11: warning: +overloadedrecfldsfail12.hs:10:11: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A): "Deprecated foo" -overloadedrecfldsfail12.hs:10:20: warning: +overloadedrecfldsfail12.hs:10:20: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘bar’ (imported from OverloadedRecFldsFail12_A): "Deprecated bar" -overloadedrecfldsfail12.hs:13:5: warning: +overloadedrecfldsfail12.hs:13:5: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A): "Deprecated foo" diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr index 783b751b34..7a4e868c9f 100644 --- a/testsuite/tests/parser/should_compile/T2245.stderr +++ b/testsuite/tests/parser/should_compile/T2245.stderr @@ -1,17 +1,17 @@ -T2245.hs:4:10: warning: +T2245.hs:4:10: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’ or ‘-’) • In the instance declaration for ‘Num T’ -T2245.hs:5:10: warning: +T2245.hs:5:10: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for ‘fromRational’ and (either ‘recip’ or ‘/’) • In the instance declaration for ‘Fractional T’ -T2245.hs:7:29: warning: +T2245.hs:7:29: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘T’ (Fractional a0) arising from the literal ‘1e400’ at T2245.hs:7:29-33 diff --git a/testsuite/tests/parser/should_compile/T3303.stderr b/testsuite/tests/parser/should_compile/T3303.stderr index a8d2f631cf..38690441ff 100644 --- a/testsuite/tests/parser/should_compile/T3303.stderr +++ b/testsuite/tests/parser/should_compile/T3303.stderr @@ -1,9 +1,9 @@ -T3303.hs:7:7: warning: +T3303.hs:7:7: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘foo’ (imported from T3303A): Deprecated: "This is a multi-line deprecation message for foo" -T3303.hs:10:8: warning: +T3303.hs:10:8: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘foo2’ (imported from T3303A): Deprecated: "" diff --git a/testsuite/tests/parser/should_compile/read014.stderr b/testsuite/tests/parser/should_compile/read014.stderr index 030b2c52de..f7a6508d2a 100644 --- a/testsuite/tests/parser/should_compile/read014.stderr +++ b/testsuite/tests/parser/should_compile/read014.stderr @@ -1,13 +1,15 @@ -read014.hs:4:1: warning: +read014.hs:4:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: ng1 :: forall t a. Num a => t -> a -> a -read014.hs:4:5: warning: Defined but not used: ‘x’ +read014.hs:4:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘x’ -read014.hs:6:10: warning: +read014.hs:6:10: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for ‘+’, ‘*’, ‘abs’, ‘signum’, and ‘fromInteger’ • In the instance declaration for ‘Num (a, b)’ -read014.hs:8:53: warning: Defined but not used: ‘x’ +read014.hs:8:53: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘x’ diff --git a/testsuite/tests/partial-sigs/should_compile/ExprSigLocal.stderr b/testsuite/tests/partial-sigs/should_compile/ExprSigLocal.stderr index 7e02028874..5a3f40f353 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExprSigLocal.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExprSigLocal.stderr @@ -1,5 +1,5 @@ -ExprSigLocal.hs:9:35: warning: +ExprSigLocal.hs:9:35: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘a’ Where: ‘a’ is a rigid type variable bound by the inferred type of <expression> :: a -> a at ExprSigLocal.hs:9:27 @@ -9,7 +9,7 @@ ExprSigLocal.hs:9:35: warning: • Relevant bindings include y :: b -> b (bound at ExprSigLocal.hs:9:1) -ExprSigLocal.hs:11:21: warning: +ExprSigLocal.hs:11:21: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘a’ Where: ‘a’ is a rigid type variable bound by the inferred type of g :: a -> a at ExprSigLocal.hs:11:13 diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr index 333a78f97b..abc5f44138 100644 --- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr @@ -1,14 +1,14 @@ [1 of 2] Compiling Splices ( Splices.hs, Splices.o ) [2 of 2] Compiling SplicesUsed ( SplicesUsed.hs, SplicesUsed.o ) -SplicesUsed.hs:7:16: warning: +SplicesUsed.hs:7:16: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Maybe Bool’ • In the type signature: maybeBool :: _ • Relevant bindings include maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1) -SplicesUsed.hs:8:15: warning: +SplicesUsed.hs:8:15: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by the inferred type of <expression> :: t -> t at SplicesUsed.hs:8:15 @@ -18,7 +18,7 @@ SplicesUsed.hs:8:15: warning: • Relevant bindings include maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1) -SplicesUsed.hs:8:27: warning: +SplicesUsed.hs:8:27: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Bool’ • In an expression type signature: Maybe _ In the first argument of ‘id :: _a -> _a’, namely @@ -27,7 +27,7 @@ SplicesUsed.hs:8:27: warning: • Relevant bindings include maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1) -SplicesUsed.hs:10:17: warning: +SplicesUsed.hs:10:17: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(Char, a)’ Where: ‘a’ is a rigid type variable bound by the inferred type of charA :: a -> (Char, a) @@ -37,7 +37,7 @@ SplicesUsed.hs:10:17: warning: • Relevant bindings include charA :: a -> (Char, a) (bound at SplicesUsed.hs:11:1) -SplicesUsed.hs:13:14: warning: +SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘a -> Bool’ Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] @@ -47,7 +47,7 @@ SplicesUsed.hs:13:14: warning: • Relevant bindings include filter' :: (a -> Bool) -> [a] -> [a] (bound at SplicesUsed.hs:14:1) -SplicesUsed.hs:13:14: warning: +SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘[a]’ Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] @@ -57,7 +57,7 @@ SplicesUsed.hs:13:14: warning: • Relevant bindings include filter' :: (a -> Bool) -> [a] -> [a] (bound at SplicesUsed.hs:14:1) -SplicesUsed.hs:13:14: warning: +SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘[a]’ Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] @@ -67,12 +67,12 @@ SplicesUsed.hs:13:14: warning: • Relevant bindings include filter' :: (a -> Bool) -> [a] -> [a] (bound at SplicesUsed.hs:14:1) -SplicesUsed.hs:16:3: warning: +SplicesUsed.hs:16:3: warning: [-Wpartial-type-signatures (in -Wdefault)] Found constraint wildcard ‘_’ standing for ‘Eq a’ In the type signature: foo :: _ => _ -SplicesUsed.hs:16:3: warning: +SplicesUsed.hs:16:3: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘a -> a -> Bool’ Where: ‘a’ is a rigid type variable bound by the inferred type of foo :: Eq a => a -> a -> Bool @@ -82,14 +82,14 @@ SplicesUsed.hs:16:3: warning: • Relevant bindings include foo :: a -> a -> Bool (bound at SplicesUsed.hs:16:3) -SplicesUsed.hs:18:3: warning: +SplicesUsed.hs:18:3: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘Bool’ • In the type signature: bar :: _a -> _b -> (_a, _b) • Relevant bindings include bar :: Bool -> t -> (Bool, t) (bound at SplicesUsed.hs:18:3) -SplicesUsed.hs:18:3: warning: +SplicesUsed.hs:18:3: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_b’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by the inferred type of bar :: Bool -> t -> (Bool, t) diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr index 9cda918ae8..d814f67c08 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -1,10 +1,10 @@ -T10403.hs:15:7: warning: +T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)] Found constraint wildcard ‘_’ standing for ‘Functor f’ In the type signature: h1 :: _ => _ -T10403.hs:15:12: warning: +T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’ Where: ‘f’ is a rigid type variable bound by the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f @@ -20,7 +20,7 @@ T10403.hs:15:12: warning: • Relevant bindings include h1 :: (a -> b) -> f a -> H f (bound at T10403.hs:17:1) -T10403.hs:19:7: warning: +T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’ Where: ‘f0’ is an ambiguous type variable ‘b’ is a rigid type variable bound by diff --git a/testsuite/tests/partial-sigs/should_compile/T10438.stderr b/testsuite/tests/partial-sigs/should_compile/T10438.stderr index d04fca208b..3871a6345e 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10438.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10438.stderr @@ -1,5 +1,5 @@ -T10438.hs:7:22: warning: +T10438.hs:7:22: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t2’ Where: ‘t2’ is a rigid type variable bound by the inferred type of g :: t2 -> t2 at T10438.hs:6:9 diff --git a/testsuite/tests/partial-sigs/should_compile/T10463.stderr b/testsuite/tests/partial-sigs/should_compile/T10463.stderr index 9a3215e9fb..4ae894f8fe 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10463.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10463.stderr @@ -1,8 +1,8 @@ -T10463.hs:5:9: warning: - Found type wildcard ‘_’ standing for ‘[Char]’ - In a pattern type signature: _ - In the pattern: x :: _ - In an equation for ‘f’: f (x :: _) = x ++ "" - Relevant bindings include - f :: [Char] -> [Char] (bound at T10463.hs:5:1) +T10463.hs:5:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘[Char]’ + • In a pattern type signature: _ + In the pattern: x :: _ + In an equation for ‘f’: f (x :: _) = x ++ "" + • Relevant bindings include + f :: [Char] -> [Char] (bound at T10463.hs:5:1) diff --git a/testsuite/tests/partial-sigs/should_compile/T10519.stderr b/testsuite/tests/partial-sigs/should_compile/T10519.stderr index 603d0bc929..ba98d7a3b0 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10519.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10519.stderr @@ -1,5 +1,5 @@ -T10519.hs:5:18: warning: +T10519.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] Found constraint wildcard ‘_’ standing for ‘Eq a’ In the type signature: foo :: forall a. _ => a -> a -> Bool diff --git a/testsuite/tests/partial-sigs/should_compile/T11016.stderr b/testsuite/tests/partial-sigs/should_compile/T11016.stderr index 74dd18d9bf..5d9ad095c1 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11016.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11016.stderr @@ -1,10 +1,10 @@ -T11016.hs:5:19: warning: +T11016.hs:5:19: warning: [-Wpartial-type-signatures (in -Wdefault)] Found constraint wildcard ‘_’ standing for ‘()’ In the type signature: f1 :: (?x :: Int, _) => Int -T11016.hs:8:22: warning: +T11016.hs:8:22: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Int’ • In the type signature: f2 :: (?x :: Int) => _ diff --git a/testsuite/tests/partial-sigs/should_compile/T11192.stderr b/testsuite/tests/partial-sigs/should_compile/T11192.stderr index f2892b7fae..558097ca2b 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11192.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11192.stderr @@ -1,5 +1,5 @@ -T11192.hs:7:14: warning: +T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Int -> t -> t’ Where: ‘t’ is a rigid type variable bound by the inferred type of go :: Int -> t -> t at T11192.hs:8:8 @@ -20,7 +20,7 @@ T11192.hs:7:14: warning: go :: Int -> t -> t (bound at T11192.hs:8:8) fails :: a (bound at T11192.hs:6:1) -T11192.hs:13:14: warning: +T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t1 -> t -> t’ Where: ‘t’ is a rigid type variable bound by the inferred type of go :: t1 -> t -> t at T11192.hs:14:8 diff --git a/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr b/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr index 2f92c657f3..a132b725e8 100644 --- a/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr +++ b/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr @@ -1,16 +1,16 @@ -TypedSplice.hs:9:22: warning: - Found type wildcard ‘_’ standing for ‘Bool’ - In an expression type signature: _ -> _b - In the Template Haskell quotation [|| not :: _ -> _b ||] - In the expression: [|| not :: _ -> _b ||] - Relevant bindings include - metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1) +TypedSplice.hs:9:22: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Bool’ + • In an expression type signature: _ -> _b + In the Template Haskell quotation [|| not :: _ -> _b ||] + In the expression: [|| not :: _ -> _b ||] + • Relevant bindings include + metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1) -TypedSplice.hs:9:27: warning: - Found type wildcard ‘_b’ standing for ‘Bool’ - In an expression type signature: _ -> _b - In the Template Haskell quotation [|| not :: _ -> _b ||] - In the expression: [|| not :: _ -> _b ||] - Relevant bindings include - metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1) +TypedSplice.hs:9:27: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_b’ standing for ‘Bool’ + • In an expression type signature: _ -> _b + In the Template Haskell quotation [|| not :: _ -> _b ||] + In the expression: [|| not :: _ -> _b ||] + • Relevant bindings include + metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1) diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr index 3fd0860bb8..7013696580 100644 --- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr @@ -5,9 +5,9 @@ TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, - integer-gmp-1.0.0.0] + integer-gmp-1.0.0.1] -WarningWildcardInstantiations.hs:5:14: warning: +WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘a’ Where: ‘a’ is a rigid type variable bound by the inferred type of foo :: (Show a, Enum a) => a -> String @@ -17,19 +17,19 @@ WarningWildcardInstantiations.hs:5:14: warning: • Relevant bindings include foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1) -WarningWildcardInstantiations.hs:5:18: warning: +WarningWildcardInstantiations.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] Found constraint wildcard ‘_’ standing for ‘Enum a’ In the type signature: foo :: (Show _a, _) => _a -> _ -WarningWildcardInstantiations.hs:5:30: warning: +WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘String’ • In the type signature: foo :: (Show _a, _) => _a -> _ • Relevant bindings include foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1) -WarningWildcardInstantiations.hs:8:8: warning: +WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t1’ Where: ‘t1’ is a rigid type variable bound by the inferred type of bar :: t1 -> (t1 -> t) -> t @@ -40,7 +40,7 @@ WarningWildcardInstantiations.hs:8:8: warning: bar :: t1 -> (t1 -> t) -> t (bound at WarningWildcardInstantiations.hs:9:1) -WarningWildcardInstantiations.hs:8:13: warning: +WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t1 -> t’ Where: ‘t’ is a rigid type variable bound by the inferred type of bar :: t1 -> (t1 -> t) -> t @@ -54,7 +54,7 @@ WarningWildcardInstantiations.hs:8:13: warning: bar :: t1 -> (t1 -> t) -> t (bound at WarningWildcardInstantiations.hs:9:1) -WarningWildcardInstantiations.hs:8:18: warning: +WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t’ Where: ‘t’ is a rigid type variable bound by the inferred type of bar :: t1 -> (t1 -> t) -> t diff --git a/testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr b/testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr index 6cc4f94d2f..460bc63a44 100644 --- a/testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr +++ b/testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr @@ -1,5 +1,5 @@ -Defaulting1MROff.hs:7:10: warning: +Defaulting1MROff.hs:7:10: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Integer’ • In the type signature: alpha :: _ diff --git a/testsuite/tests/partial-sigs/should_fail/T11122.stderr b/testsuite/tests/partial-sigs/should_fail/T11122.stderr index 57a74f9e58..4a8b75be4a 100644 --- a/testsuite/tests/partial-sigs/should_fail/T11122.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T11122.stderr @@ -1,5 +1,5 @@ -T11122.hs:19:18: warning: +T11122.hs:19:18: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Int’ • In the type signature: parser :: Parser _ diff --git a/testsuite/tests/patsyn/should_compile/T11283.stderr b/testsuite/tests/patsyn/should_compile/T11283.stderr index 86d8575224..15b5bd033c 100644 --- a/testsuite/tests/patsyn/should_compile/T11283.stderr +++ b/testsuite/tests/patsyn/should_compile/T11283.stderr @@ -1,5 +1,5 @@ -T11283.hs:6:5: warning: +T11283.hs:6:5: warning: [-Wmissing-fields (in -Wdefault)] • Fields of ‘S’ not initialised: x • In the expression: S {..} In an equation for ‘e’: e = S {..} diff --git a/testsuite/tests/patsyn/should_fail/T11053.stderr b/testsuite/tests/patsyn/should_fail/T11053.stderr index 8bc6563e29..e583aa1b08 100644 --- a/testsuite/tests/patsyn/should_fail/T11053.stderr +++ b/testsuite/tests/patsyn/should_fail/T11053.stderr @@ -1,19 +1,19 @@ -T11053.hs:7:1: warning: +T11053.hs:7:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Top-level binding with no type signature: T :: Bool -T11053.hs:9:1: warning: +T11053.hs:9:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Top-level binding with no type signature: J :: forall t. t -> Maybe t -T11053.hs:11:1: warning: +T11053.hs:11:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Top-level binding with no type signature: J1 :: forall t. t -> Maybe t -T11053.hs:13:1: warning: +T11053.hs:13:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Top-level binding with no type signature: J2 :: forall t. t -> Maybe t -T11053.hs:15:1: warning: +T11053.hs:15:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Top-level binding with no type signature: J3 :: forall t. t -> Maybe t diff --git a/testsuite/tests/rename/should_compile/T1789.stderr b/testsuite/tests/rename/should_compile/T1789.stderr index e4057921d5..dc7f00360a 100644 --- a/testsuite/tests/rename/should_compile/T1789.stderr +++ b/testsuite/tests/rename/should_compile/T1789.stderr @@ -1,12 +1,12 @@ -T1789.hs:6:1: Warning: +T1789.hs:6:1: warning: [-Wmissing-import-lists] The module ‘Prelude’ does not have an explicit import list -T1789.hs:7:1: Warning: +T1789.hs:7:1: warning: [-Wmissing-import-lists] The module ‘Data.Map’ does not have an explicit import list -T1789.hs:9:1: Warning: +T1789.hs:9:1: warning: [-Wmissing-import-lists] The import item ‘Maybe(..)’ does not have an explicit import list -T1789.hs:10:1: Warning: +T1789.hs:10:1: warning: [-Wmissing-import-lists] The module ‘Data.Maybe’ does not have an explicit import list diff --git a/testsuite/tests/rename/should_compile/T17a.stderr b/testsuite/tests/rename/should_compile/T17a.stderr index 308cabe23c..9d0457ee15 100644 --- a/testsuite/tests/rename/should_compile/T17a.stderr +++ b/testsuite/tests/rename/should_compile/T17a.stderr @@ -1 +1,3 @@ - T17a.hs:8:1: Warning: Defined but not used: ‘top’
\ No newline at end of file + +T17a.hs:8:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘top’ diff --git a/testsuite/tests/rename/should_compile/T17b.stderr b/testsuite/tests/rename/should_compile/T17b.stderr index 3291264463..c94b869401 100644 --- a/testsuite/tests/rename/should_compile/T17b.stderr +++ b/testsuite/tests/rename/should_compile/T17b.stderr @@ -1 +1,3 @@ - T17b.hs:17:12: Warning: Defined but not used: ‘local’
\ No newline at end of file + +T17b.hs:17:12: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘local’ diff --git a/testsuite/tests/rename/should_compile/T17c.stderr b/testsuite/tests/rename/should_compile/T17c.stderr index bfab9f83da..194e598099 100644 --- a/testsuite/tests/rename/should_compile/T17c.stderr +++ b/testsuite/tests/rename/should_compile/T17c.stderr @@ -1 +1,3 @@ - T17c.hs:11:11: Warning: This pattern-binding binds no variables: True = True
\ No newline at end of file + +T17c.hs:11:11: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] + This pattern-binding binds no variables: True = True diff --git a/testsuite/tests/rename/should_compile/T17d.stderr b/testsuite/tests/rename/should_compile/T17d.stderr index babe6b780e..6c99f1798d 100644 --- a/testsuite/tests/rename/should_compile/T17d.stderr +++ b/testsuite/tests/rename/should_compile/T17d.stderr @@ -1 +1,3 @@ - T17d.hs:14:5: Warning: Defined but not used: ‘match’
\ No newline at end of file + +T17d.hs:14:5: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘match’ diff --git a/testsuite/tests/rename/should_compile/T17e.stderr b/testsuite/tests/rename/should_compile/T17e.stderr index 48f28b8db4..e63f479db5 100644 --- a/testsuite/tests/rename/should_compile/T17e.stderr +++ b/testsuite/tests/rename/should_compile/T17e.stderr @@ -1,7 +1,9 @@ -T17e.hs:8:1: Warning: Defined but not used: ‘top’ +T17e.hs:8:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘top’ -T17e.hs:11:11: Warning: +T17e.hs:11:11: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] This pattern-binding binds no variables: True = True -T17e.hs:17:12: Warning: Defined but not used: ‘local’ +T17e.hs:17:12: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘local’ diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index 32af87af0e..439684a20c 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -1,12 +1,13 @@ -T1972.hs:12:3: warning: +T1972.hs:12:3: warning: [-Wname-shadowing (in -Wall)] This binding for ‘name’ shadows the existing binding defined at T1972.hs:9:19 -T1972.hs:14:3: warning: +T1972.hs:14:3: warning: [-Wname-shadowing (in -Wall)] This binding for ‘mapAccumL’ shadows the existing bindings imported from ‘Data.List’ at T1972.hs:7:1-16 (and originally defined in ‘Data.Traversable’) defined at T1972.hs:16:1 -T1972.hs:20:10: warning: Defined but not used: ‘c’ +T1972.hs:20:10: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘c’ diff --git a/testsuite/tests/rename/should_compile/T3262.stderr b/testsuite/tests/rename/should_compile/T3262.stderr index 0639076dc0..69500176b8 100644 --- a/testsuite/tests/rename/should_compile/T3262.stderr +++ b/testsuite/tests/rename/should_compile/T3262.stderr @@ -1,8 +1,8 @@ -T3262.hs:12:11: Warning: +T3262.hs:12:11: warning: [-Wname-shadowing (in -Wall)] This binding for ‘not_ignored’ shadows the existing binding bound at T3262.hs:11:11 -T3262.hs:20:15: Warning: +T3262.hs:20:15: warning: [-Wname-shadowing (in -Wall)] This binding for ‘not_ignored’ shadows the existing binding bound at T3262.hs:19:15 diff --git a/testsuite/tests/rename/should_compile/T3371.stderr b/testsuite/tests/rename/should_compile/T3371.stderr index 20a597fd3e..d5434040b5 100644 --- a/testsuite/tests/rename/should_compile/T3371.stderr +++ b/testsuite/tests/rename/should_compile/T3371.stderr @@ -1,2 +1,3 @@ -T3371.hs:10:14: Warning: Defined but not used: ‘a’ +T3371.hs:10:14: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘a’ diff --git a/testsuite/tests/rename/should_compile/T3449.stderr b/testsuite/tests/rename/should_compile/T3449.stderr index bfb0021140..4f854d1455 100644 --- a/testsuite/tests/rename/should_compile/T3449.stderr +++ b/testsuite/tests/rename/should_compile/T3449.stderr @@ -1,2 +1,3 @@ -T3449.hs-boot:8:1: Warning: Defined but not used: ‘unused’ +T3449.hs-boot:8:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘unused’ diff --git a/testsuite/tests/rename/should_compile/T4489.stderr b/testsuite/tests/rename/should_compile/T4489.stderr index 2e7f9186a8..abb6438745 100644 --- a/testsuite/tests/rename/should_compile/T4489.stderr +++ b/testsuite/tests/rename/should_compile/T4489.stderr @@ -1,6 +1,6 @@ -T4489.hs:4:1: Warning: +T4489.hs:4:1: warning: [-Wmissing-import-lists] The module ‘Data.Maybe’ does not have an explicit import list -T4489.hs:5:1: Warning: +T4489.hs:5:1: warning: [-Wmissing-import-lists] The import item ‘Maybe(..)’ does not have an explicit import list diff --git a/testsuite/tests/rename/should_compile/T5331.stderr b/testsuite/tests/rename/should_compile/T5331.stderr index 6a783e5831..9bc0b102b7 100644 --- a/testsuite/tests/rename/should_compile/T5331.stderr +++ b/testsuite/tests/rename/should_compile/T5331.stderr @@ -1,12 +1,12 @@ -T5331.hs:8:17: warning: +T5331.hs:8:17: warning: [-Wunused-foralls (in -Wextra)] Unused quantified type variable ‘a’ In the definition of data constructor ‘S1’ -T5331.hs:11:16: warning: +T5331.hs:11:16: warning: [-Wunused-foralls (in -Wextra)] Unused quantified type variable ‘a’ In the type ‘forall a. W’ -T5331.hs:13:13: warning: +T5331.hs:13:13: warning: [-Wunused-foralls (in -Wextra)] Unused quantified type variable ‘a’ In the type ‘forall a. Int’ diff --git a/testsuite/tests/rename/should_compile/T5334.stderr b/testsuite/tests/rename/should_compile/T5334.stderr index 866eae20fc..3e15e5b9f0 100644 --- a/testsuite/tests/rename/should_compile/T5334.stderr +++ b/testsuite/tests/rename/should_compile/T5334.stderr @@ -1,13 +1,13 @@ -T5334.hs:7:5: Warning: - Fields of ‘T’ not initialised: b - In the expression: T {..} - In an equation for ‘t’: - t = T {..} - where - a = 1 +T5334.hs:7:5: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘T’ not initialised: b + • In the expression: T {..} + In an equation for ‘t’: + t = T {..} + where + a = 1 -T5334.hs:14:5: Warning: - Fields of ‘S’ not initialised: y - In the expression: S {x = 1} - In an equation for ‘s’: s = S {x = 1} +T5334.hs:14:5: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘S’ not initialised: y + • In the expression: S {x = 1} + In an equation for ‘s’: s = S {x = 1} diff --git a/testsuite/tests/rename/should_compile/T5867.stderr b/testsuite/tests/rename/should_compile/T5867.stderr index b347240a9e..34724ad487 100644 --- a/testsuite/tests/rename/should_compile/T5867.stderr +++ b/testsuite/tests/rename/should_compile/T5867.stderr @@ -1,8 +1,8 @@ -T5867.hs:4:7: Warning: +T5867.hs:4:7: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘f’ (imported from T5867a): Deprecated: "Don't use f!" -T5867.hs:5:7: Warning: +T5867.hs:5:7: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘f’ (imported from T5867a): Deprecated: "Don't use f!" diff --git a/testsuite/tests/rename/should_compile/T7085.stderr b/testsuite/tests/rename/should_compile/T7085.stderr index b642ed6a44..eb54e062eb 100644 --- a/testsuite/tests/rename/should_compile/T7085.stderr +++ b/testsuite/tests/rename/should_compile/T7085.stderr @@ -1,3 +1,3 @@ -T7085.hs:8:6: Warning: +T7085.hs:8:6: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] This pattern-binding binds no variables: Nothing = Just n diff --git a/testsuite/tests/rename/should_compile/T7145b.stderr b/testsuite/tests/rename/should_compile/T7145b.stderr index ed2333e8c4..3327446b3b 100644 --- a/testsuite/tests/rename/should_compile/T7145b.stderr +++ b/testsuite/tests/rename/should_compile/T7145b.stderr @@ -1,2 +1,3 @@ -T7145b.hs:7:1: Warning: Defined but not used: ‘pure’ +T7145b.hs:7:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘pure’ diff --git a/testsuite/tests/rename/should_compile/T7167.stderr b/testsuite/tests/rename/should_compile/T7167.stderr index ecad80cfd2..22aaf640eb 100644 --- a/testsuite/tests/rename/should_compile/T7167.stderr +++ b/testsuite/tests/rename/should_compile/T7167.stderr @@ -1,2 +1,3 @@ -T7167.hs:5:1: Warning: Module ‘Data.List’ does not export ‘foo’ +T7167.hs:5:1: warning: [-Wdodgy-imports (in -Wextra)] + Module ‘Data.List’ does not export ‘foo’ diff --git a/testsuite/tests/rename/should_compile/T9778.stderr b/testsuite/tests/rename/should_compile/T9778.stderr index 3d2e40fce4..81c69fdb8e 100644 --- a/testsuite/tests/rename/should_compile/T9778.stderr +++ b/testsuite/tests/rename/should_compile/T9778.stderr @@ -1,3 +1,4 @@ - T9778.hs:8:10: Warning: - Unticked promoted constructor: ‘A’. - Use ‘'A’ instead of ‘A’. + +T9778.hs:8:10: warning: [-Wunticked-promoted-constructors (in -Wall)] + Unticked promoted constructor: ‘A’. + Use ‘'A’ instead of ‘A’. diff --git a/testsuite/tests/rename/should_compile/mc10.stderr b/testsuite/tests/rename/should_compile/mc10.stderr index b0d32552b4..aa33c1447b 100644 --- a/testsuite/tests/rename/should_compile/mc10.stderr +++ b/testsuite/tests/rename/should_compile/mc10.stderr @@ -1,2 +1,3 @@ -mc10.hs:14:11: Warning: Defined but not used: ‘y’ +mc10.hs:14:11: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘y’ diff --git a/testsuite/tests/rename/should_compile/rn037.stderr b/testsuite/tests/rename/should_compile/rn037.stderr index 8dea678d42..eaf268f6ca 100644 --- a/testsuite/tests/rename/should_compile/rn037.stderr +++ b/testsuite/tests/rename/should_compile/rn037.stderr @@ -1,5 +1,5 @@ -rn037.hs:3:1: Warning: +rn037.hs:3:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Data.List’ is redundant except perhaps to import instances from ‘Data.List’ To import instances alone, use: import Data.List() diff --git a/testsuite/tests/rename/should_compile/rn039.stderr b/testsuite/tests/rename/should_compile/rn039.stderr index de8618d5f0..b662775e53 100644 --- a/testsuite/tests/rename/should_compile/rn039.stderr +++ b/testsuite/tests/rename/should_compile/rn039.stderr @@ -1,5 +1,5 @@ -rn039.hs:6:16: Warning: +rn039.hs:6:16: warning: [-Wname-shadowing (in -Wall)] This binding for ‘-’ shadows the existing binding imported from ‘Prelude’ at rn039.hs:2:8-20 (and originally defined in ‘GHC.Num’) diff --git a/testsuite/tests/rename/should_compile/rn040.stderr b/testsuite/tests/rename/should_compile/rn040.stderr index f482b47511..1e0d4a341a 100644 --- a/testsuite/tests/rename/should_compile/rn040.stderr +++ b/testsuite/tests/rename/should_compile/rn040.stderr @@ -1,4 +1,6 @@ -rn040.hs:6:12: Warning: Defined but not used: ‘y’ +rn040.hs:6:12: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘y’ -rn040.hs:8:8: Warning: Defined but not used: ‘w’ +rn040.hs:8:8: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘w’ diff --git a/testsuite/tests/rename/should_compile/rn041.stderr b/testsuite/tests/rename/should_compile/rn041.stderr index e9c2727742..891a2b21f0 100644 --- a/testsuite/tests/rename/should_compile/rn041.stderr +++ b/testsuite/tests/rename/should_compile/rn041.stderr @@ -1,6 +1,9 @@ -rn041.hs:7:1: Warning: Defined but not used: ‘f’ +rn041.hs:7:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘f’ -rn041.hs:9:1: Warning: Defined but not used: ‘g’ +rn041.hs:9:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘g’ -rn041.hs:10:1: Warning: Defined but not used: ‘h’ +rn041.hs:10:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘h’ diff --git a/testsuite/tests/rename/should_compile/rn046.stderr b/testsuite/tests/rename/should_compile/rn046.stderr index c2a4195287..458feae39f 100644 --- a/testsuite/tests/rename/should_compile/rn046.stderr +++ b/testsuite/tests/rename/should_compile/rn046.stderr @@ -1,8 +1,8 @@ -rn046.hs:2:1: Warning: +rn046.hs:2:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Data.List’ is redundant except perhaps to import instances from ‘Data.List’ To import instances alone, use: import Data.List() -rn046.hs:3:1: Warning: +rn046.hs:3:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘ord’ from module ‘Data.Char’ is redundant diff --git a/testsuite/tests/rename/should_compile/rn047.stderr b/testsuite/tests/rename/should_compile/rn047.stderr index 0987f356fa..168adb5877 100644 --- a/testsuite/tests/rename/should_compile/rn047.stderr +++ b/testsuite/tests/rename/should_compile/rn047.stderr @@ -1,2 +1,3 @@ -rn047.hs:12:11: Warning: Defined but not used: ‘y’ +rn047.hs:12:11: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘y’ diff --git a/testsuite/tests/rename/should_compile/rn050.stderr b/testsuite/tests/rename/should_compile/rn050.stderr index 472333ed57..93df1a93ea 100644 --- a/testsuite/tests/rename/should_compile/rn050.stderr +++ b/testsuite/tests/rename/should_compile/rn050.stderr @@ -1,8 +1,8 @@ -rn050.hs:13:7: Warning: +rn050.hs:13:7: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘op’ (imported from Rn050_A): Deprecated: "Use bop instead" -rn050.hs:13:10: Warning: +rn050.hs:13:10: warning: [-Wdeprecations (in -Wdefault)] In the use of data constructor ‘C’ (imported from Rn050_A): Deprecated: "Use D instead" diff --git a/testsuite/tests/rename/should_compile/rn055.stderr b/testsuite/tests/rename/should_compile/rn055.stderr index 1b928b46cf..93c74ff6a8 100644 --- a/testsuite/tests/rename/should_compile/rn055.stderr +++ b/testsuite/tests/rename/should_compile/rn055.stderr @@ -1,2 +1,3 @@ -rn055.hs:1:1: Warning: Module `Prelude' implicitly imported +rn055.hs:1:1: warning: [-Wimplicit-prelude] + Module `Prelude' implicitly imported diff --git a/testsuite/tests/rename/should_compile/rn063.stderr b/testsuite/tests/rename/should_compile/rn063.stderr index 93cd8654f3..ff4d409b36 100644 --- a/testsuite/tests/rename/should_compile/rn063.stderr +++ b/testsuite/tests/rename/should_compile/rn063.stderr @@ -1,4 +1,6 @@ -rn063.hs:10:9: Warning: Defined but not used: ‘x’ +rn063.hs:10:9: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘x’ -rn063.hs:13:9: Warning: Defined but not used: ‘y’ +rn063.hs:13:9: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘y’ diff --git a/testsuite/tests/rename/should_compile/rn064.stderr b/testsuite/tests/rename/should_compile/rn064.stderr index 09d95871de..cac51b1a39 100644 --- a/testsuite/tests/rename/should_compile/rn064.stderr +++ b/testsuite/tests/rename/should_compile/rn064.stderr @@ -1,4 +1,4 @@ -rn064.hs:13:12: Warning: +rn064.hs:13:12: warning: [-Wname-shadowing (in -Wall)] This binding for ‘r’ shadows the existing binding bound at rn064.hs:15:9 diff --git a/testsuite/tests/rename/should_compile/rn066.stderr b/testsuite/tests/rename/should_compile/rn066.stderr index b82b50fcdb..660129f07a 100644 --- a/testsuite/tests/rename/should_compile/rn066.stderr +++ b/testsuite/tests/rename/should_compile/rn066.stderr @@ -1,8 +1,8 @@ -rn066.hs:13:7: Warning: +rn066.hs:13:7: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘op’ (imported from Rn066_A): "Is that really a good idea?" -rn066.hs:13:10: Warning: +rn066.hs:13:10: warning: [-Wdeprecations (in -Wdefault)] In the use of data constructor ‘C’ (imported from Rn066_A): "Are you sure you want to do that?" diff --git a/testsuite/tests/rename/should_fail/T2723.stderr b/testsuite/tests/rename/should_fail/T2723.stderr index 66b2deef47..682479ac98 100644 --- a/testsuite/tests/rename/should_fail/T2723.stderr +++ b/testsuite/tests/rename/should_fail/T2723.stderr @@ -1,4 +1,4 @@ -T2723.hs:15:5: Warning: +T2723.hs:15:5: warning: [-Wname-shadowing (in -Wall)] This binding for ‘field3’ shadows the existing binding defined at T2723.hs:7:1 diff --git a/testsuite/tests/rename/should_fail/T5211.stderr b/testsuite/tests/rename/should_fail/T5211.stderr index 2a736dbdaa..dc02ab4085 100644 --- a/testsuite/tests/rename/should_fail/T5211.stderr +++ b/testsuite/tests/rename/should_fail/T5211.stderr @@ -1,5 +1,5 @@ -T5211.hs:5:1: Warning: +T5211.hs:5:1: warning: [-Wunused-imports (in -Wextra)] The qualified import of ‘Foreign.Storable’ is redundant except perhaps to import instances from ‘Foreign.Storable’ To import instances alone, use: import Foreign.Storable() diff --git a/testsuite/tests/rename/should_fail/T5281.stderr b/testsuite/tests/rename/should_fail/T5281.stderr index d8bcc8f787..26d7b8da77 100644 --- a/testsuite/tests/rename/should_fail/T5281.stderr +++ b/testsuite/tests/rename/should_fail/T5281.stderr @@ -1,4 +1,4 @@ -T5281.hs:6:5: Warning: +T5281.hs:6:5: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘deprec’ (imported from T5281A): Deprecated: "This is deprecated" diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr index f382cd3811..b3f1145481 100644 --- a/testsuite/tests/rename/should_fail/T5892a.stderr +++ b/testsuite/tests/rename/should_fail/T5892a.stderr @@ -1,10 +1,10 @@ -T5892a.hs:12:8: Warning: - Fields of ‘Node’ not initialised: subForest - In the expression: Node {..} - In the expression: let rootLabel = [] in Node {..} - In an equation for ‘foo’: - foo (Node {..}) = let rootLabel = ... in Node {..} +T5892a.hs:12:8: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘Node’ not initialised: subForest + • In the expression: Node {..} + In the expression: let rootLabel = [] in Node {..} + In an equation for ‘foo’: + foo (Node {..}) = let rootLabel = ... in Node {..} -<no location info>: +<no location info>: error: Failing due to -Werror. diff --git a/testsuite/tests/rename/should_fail/T7454.stderr b/testsuite/tests/rename/should_fail/T7454.stderr index 9f8998591a..8baef5d139 100644 --- a/testsuite/tests/rename/should_fail/T7454.stderr +++ b/testsuite/tests/rename/should_fail/T7454.stderr @@ -1,3 +1,3 @@ -T7454.hs:5:1: Warning: +T7454.hs:5:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Arrow’ from module ‘Control.Arrow’ is redundant diff --git a/testsuite/tests/rename/should_fail/T8149.stderr b/testsuite/tests/rename/should_fail/T8149.stderr index 1bb7f0dc9d..3cef09b317 100644 --- a/testsuite/tests/rename/should_fail/T8149.stderr +++ b/testsuite/tests/rename/should_fail/T8149.stderr @@ -1,4 +1,4 @@ -T8149.hs:5:1: Warning: +T8149.hs:5:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘WriterT’ from module ‘Control.Monad.Trans.Writer’ is redundant diff --git a/testsuite/tests/semigroup/SemigroupWarnings.stderr b/testsuite/tests/semigroup/SemigroupWarnings.stderr index 2c75819cf8..277fea66ff 100644 --- a/testsuite/tests/semigroup/SemigroupWarnings.stderr +++ b/testsuite/tests/semigroup/SemigroupWarnings.stderr @@ -1,8 +1,8 @@ -SemigroupWarnings.hs:17:10: warning: +SemigroupWarnings.hs:17:10: warning: [-Wsemigroup (in -Wcompat)] ‘LacksSemigroup’ is an instance of Monoid but not Semigroup. This will become an error in a future release. -SemigroupWarnings.hs:34:1: warning: +SemigroupWarnings.hs:34:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. diff --git a/testsuite/tests/simplCore/should_compile/simpl020.stderr b/testsuite/tests/simplCore/should_compile/simpl020.stderr index b21a41267c..2ac861f888 100644 --- a/testsuite/tests/simplCore/should_compile/simpl020.stderr +++ b/testsuite/tests/simplCore/should_compile/simpl020.stderr @@ -1,5 +1,5 @@ -Simpl020_A.hs:26:10: warning: +Simpl020_A.hs:26:10: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for ‘toGUIObject’ and ‘cset’ • In the instance declaration for ‘GUIObject ()’ diff --git a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr index 70e210fa3e..3893a29237 100644 --- a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr +++ b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr @@ -1,5 +1,5 @@ -B.hs:7:10: Warning: - No explicit implementation for - ‘row’ - In the instance declaration for ‘Matrix Bool Val’ +B.hs:7:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘row’ + • In the instance declaration for ‘Matrix Bool Val’ diff --git a/testsuite/tests/typecheck/should_compile/HasKey.stderr b/testsuite/tests/typecheck/should_compile/HasKey.stderr index dd4d290cda..76b78a6491 100644 --- a/testsuite/tests/typecheck/should_compile/HasKey.stderr +++ b/testsuite/tests/typecheck/should_compile/HasKey.stderr @@ -1,5 +1,5 @@ -HasKey.hs:22:10: Warning: - No explicit implementation for - either ‘compare’ or ‘<=’ - In the instance declaration for ‘Ord (Keyed x)’ +HasKey.hs:22:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘compare’ or ‘<=’ + • In the instance declaration for ‘Ord (Keyed x)’ diff --git a/testsuite/tests/typecheck/should_compile/T10935.stderr b/testsuite/tests/typecheck/should_compile/T10935.stderr index 2279cfc90b..b8db0fb4bd 100644 --- a/testsuite/tests/typecheck/should_compile/T10935.stderr +++ b/testsuite/tests/typecheck/should_compile/T10935.stderr @@ -1,6 +1,6 @@ -T10935.hs:5:11: warning: - The Monomorphism Restriction applies to the binding for ‘y’ - Consider giving a type signature for ‘y’ - In the expression: let y = x + 1 in (y, y) - In an equation for ‘f’: f x = let y = x + 1 in (y, y) +T10935.hs:5:11: warning: [-Wmonomorphism-restriction] + • The Monomorphism Restriction applies to the binding for ‘y’ + Consider giving a type signature for ‘y’ + • In the expression: let y = x + 1 in (y, y) + In an equation for ‘f’: f x = let y = x + 1 in (y, y) diff --git a/testsuite/tests/typecheck/should_compile/T10971a.stderr b/testsuite/tests/typecheck/should_compile/T10971a.stderr index eea8a11ea3..0702b32384 100644 --- a/testsuite/tests/typecheck/should_compile/T10971a.stderr +++ b/testsuite/tests/typecheck/should_compile/T10971a.stderr @@ -1,38 +1,38 @@ -T10971a.hs:7:1: warning: +T10971a.hs:7:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: f :: forall a. [a] -> Int -T10971a.hs:7:11: warning: +T10971a.hs:7:11: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraint to type ‘[]’ Foldable t0 arising from a use of ‘length’ • In the expression: length x In the expression: \ x -> length x In an equation for ‘f’: f = \ x -> length x -T10971a.hs:8:1: warning: +T10971a.hs:8:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: g :: forall a b. (a -> b) -> [a] -> [b] -T10971a.hs:8:6: warning: +T10971a.hs:8:6: warning: [-Wname-shadowing (in -Wall)] This binding for ‘f’ shadows the existing binding defined at T10971a.hs:7:1 -T10971a.hs:8:13: warning: +T10971a.hs:8:13: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraint to type ‘[]’ Traversable t0 arising from a use of ‘fmapDefault’ • In the expression: fmapDefault f x In the expression: \ f x -> fmapDefault f x In an equation for ‘g’: g = \ f x -> fmapDefault f x -T10971a.hs:9:1: warning: +T10971a.hs:9:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: h :: forall b a. (a -> b) -> [a] -> ([b], Int) -T10971a.hs:9:6: warning: +T10971a.hs:9:6: warning: [-Wname-shadowing (in -Wall)] This binding for ‘f’ shadows the existing binding defined at T10971a.hs:7:1 -T10971a.hs:9:31: warning: +T10971a.hs:9:31: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘[]’ (Foldable t0) arising from a use of ‘length’ at T10971a.hs:9:31-38 (Traversable t0) diff --git a/testsuite/tests/typecheck/should_compile/T2497.stderr b/testsuite/tests/typecheck/should_compile/T2497.stderr index da730a05aa..2fefbbd8af 100644 --- a/testsuite/tests/typecheck/should_compile/T2497.stderr +++ b/testsuite/tests/typecheck/should_compile/T2497.stderr @@ -1,2 +1,3 @@ -T2497.hs:22:1: warning: Defined but not used: ‘beq’ +T2497.hs:22:1: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] + Defined but not used: ‘beq’ diff --git a/testsuite/tests/typecheck/should_compile/T3696.stderr b/testsuite/tests/typecheck/should_compile/T3696.stderr index 06229b8fa3..6058e70d50 100644 --- a/testsuite/tests/typecheck/should_compile/T3696.stderr +++ b/testsuite/tests/typecheck/should_compile/T3696.stderr @@ -1,3 +1,3 @@ -T3696.hs:9:1: warning: +T3696.hs:9:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: def :: Int diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr index 02ff1ad40e..104275cdda 100644 --- a/testsuite/tests/typecheck/should_compile/T4912.stderr +++ b/testsuite/tests/typecheck/should_compile/T4912.stderr @@ -1,11 +1,11 @@ -T4912.hs:10:1: warning: +T4912.hs:10:1: warning: [-Worphans (in -Wall)] Orphan instance: instance Foo TheirData To avoid this move the instance declaration to the module of the class or of the type, or wrap the type with a newtype and declare the instance on the new type. -T4912.hs:13:1: warning: +T4912.hs:13:1: warning: [-Worphans (in -Wall)] Orphan instance: instance Bar OurData To avoid this move the instance declaration to the module of the class or of the type, or diff --git a/testsuite/tests/typecheck/should_compile/T7903.stderr b/testsuite/tests/typecheck/should_compile/T7903.stderr index 7020e1c0e5..efffb2e8ad 100644 --- a/testsuite/tests/typecheck/should_compile/T7903.stderr +++ b/testsuite/tests/typecheck/should_compile/T7903.stderr @@ -1,10 +1,10 @@ -T7903.hs:6:10: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (a -> b)’ +T7903.hs:6:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (a -> b)’ -T7903.hs:7:10: Warning: - No explicit implementation for - either ‘compare’ or ‘<=’ - In the instance declaration for ‘Ord (a -> b)’ +T7903.hs:7:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘compare’ or ‘<=’ + • In the instance declaration for ‘Ord (a -> b)’ diff --git a/testsuite/tests/typecheck/should_compile/T9497a.stderr b/testsuite/tests/typecheck/should_compile/T9497a.stderr index ca22451023..ddbb5b93f6 100644 --- a/testsuite/tests/typecheck/should_compile/T9497a.stderr +++ b/testsuite/tests/typecheck/should_compile/T9497a.stderr @@ -1,5 +1,5 @@ -T9497a.hs:2:8: warning: +T9497a.hs:2:8: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _main :: IO () Or perhaps ‘_main’ is mis-spelled, or not in scope • In the expression: _main diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr index 8551f66c3b..0d0582d126 100644 --- a/testsuite/tests/typecheck/should_compile/holes.stderr +++ b/testsuite/tests/typecheck/should_compile/holes.stderr @@ -1,5 +1,5 @@ -holes.hs:3:5: warning: +holes.hs:3:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by the inferred type of f :: t at holes.hs:3:1 @@ -7,7 +7,7 @@ holes.hs:3:5: warning: In an equation for ‘f’: f = _ • Relevant bindings include f :: t (bound at holes.hs:3:1) -holes.hs:6:7: warning: +holes.hs:6:7: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Char • In the expression: _ In an equation for ‘g’: g x = _ @@ -15,14 +15,14 @@ holes.hs:6:7: warning: x :: Int (bound at holes.hs:6:3) g :: Int -> Char (bound at holes.hs:6:1) -holes.hs:8:5: warning: +holes.hs:8:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: [Char] • In the first argument of ‘(++)’, namely ‘_’ In the expression: _ ++ "a" In an equation for ‘h’: h = _ ++ "a" • Relevant bindings include h :: [Char] (bound at holes.hs:8:1) -holes.hs:11:15: warning: +holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: b0 Where: ‘b0’ is an ambiguous type variable • In the second argument of ‘const’, namely ‘_’ diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index 08d1b466d1..51c4da9562 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -13,7 +13,7 @@ holes2.hs:3:5: warning: • In the expression: show _ In an equation for ‘f’: f = show _ -holes2.hs:3:10: warning: +holes2.hs:3:10: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: a0 Where: ‘a0’ is an ambiguous type variable • In the first argument of ‘show’, namely ‘_’ diff --git a/testsuite/tests/typecheck/should_compile/tc078.stderr b/testsuite/tests/typecheck/should_compile/tc078.stderr index fa9d3acd2e..453ad780e0 100644 --- a/testsuite/tests/typecheck/should_compile/tc078.stderr +++ b/testsuite/tests/typecheck/should_compile/tc078.stderr @@ -1,10 +1,10 @@ -tc078.hs:9:10: Warning: - No explicit implementation for - either ‘==’ or ‘/=’ - In the instance declaration for ‘Eq (Bar a)’ +tc078.hs:9:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘==’ or ‘/=’ + • In the instance declaration for ‘Eq (Bar a)’ -tc078.hs:10:10: Warning: - No explicit implementation for - either ‘compare’ or ‘<=’ - In the instance declaration for ‘Ord (Bar a)’ +tc078.hs:10:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘compare’ or ‘<=’ + • In the instance declaration for ‘Ord (Bar a)’ diff --git a/testsuite/tests/typecheck/should_compile/tc115.stderr b/testsuite/tests/typecheck/should_compile/tc115.stderr index 4f7981ac56..449e4cdbe8 100644 --- a/testsuite/tests/typecheck/should_compile/tc115.stderr +++ b/testsuite/tests/typecheck/should_compile/tc115.stderr @@ -1,5 +1,5 @@ -tc115.hs:13:10: Warning: - No explicit implementation for - ‘foo’ - In the instance declaration for ‘Foo [m a] (m a)’ +tc115.hs:13:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo’ + • In the instance declaration for ‘Foo [m a] (m a)’ diff --git a/testsuite/tests/typecheck/should_compile/tc116.stderr b/testsuite/tests/typecheck/should_compile/tc116.stderr index 074a795956..d4de632323 100644 --- a/testsuite/tests/typecheck/should_compile/tc116.stderr +++ b/testsuite/tests/typecheck/should_compile/tc116.stderr @@ -1,5 +1,5 @@ -tc116.hs:13:10: Warning: - No explicit implementation for - ‘foo’ - In the instance declaration for ‘Foo [m a] (m a)’ +tc116.hs:13:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘foo’ + • In the instance declaration for ‘Foo [m a] (m a)’ diff --git a/testsuite/tests/typecheck/should_compile/tc125.stderr b/testsuite/tests/typecheck/should_compile/tc125.stderr index d57cda2b19..b1136b602c 100644 --- a/testsuite/tests/typecheck/should_compile/tc125.stderr +++ b/testsuite/tests/typecheck/should_compile/tc125.stderr @@ -1,25 +1,26 @@ -tc125.hs:17:10: Warning: - No explicit implementation for - ‘add’ - In the instance declaration for ‘Add Z a a’ +tc125.hs:17:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘add’ + • In the instance declaration for ‘Add Z a a’ -tc125.hs:18:10: Warning: - No explicit implementation for - ‘add’ - In the instance declaration for ‘Add (S a) b (S c)’ +tc125.hs:18:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘add’ + • In the instance declaration for ‘Add (S a) b (S c)’ -tc125.hs:22:10: Warning: - No explicit implementation for - ‘mul’ - In the instance declaration for ‘Mul Z a Z’ +tc125.hs:22:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘mul’ + • In the instance declaration for ‘Mul Z a Z’ -tc125.hs:23:10: Warning: - No explicit implementation for - ‘mul’ - In the instance declaration for ‘Mul (S a) b d’ +tc125.hs:23:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘mul’ + • In the instance declaration for ‘Mul (S a) b d’ -tc125.hs:30:10: Warning: - No explicit implementation for - ‘add’ - In the instance declaration for ‘Add (Q a b) (Q c d) (Q ad_bc bd)’ +tc125.hs:30:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘add’ + • In the instance declaration for + ‘Add (Q a b) (Q c d) (Q ad_bc bd)’ diff --git a/testsuite/tests/typecheck/should_compile/tc126.stderr b/testsuite/tests/typecheck/should_compile/tc126.stderr index 3c766d813e..6ccb8d6b25 100644 --- a/testsuite/tests/typecheck/should_compile/tc126.stderr +++ b/testsuite/tests/typecheck/should_compile/tc126.stderr @@ -1,10 +1,10 @@ -tc126.hs:16:25: Warning: - No explicit implementation for - ‘bug’ - In the instance declaration for ‘Bug (Int -> r) Int r’ +tc126.hs:16:25: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘bug’ + • In the instance declaration for ‘Bug (Int -> r) Int r’ -tc126.hs:17:10: Warning: - No explicit implementation for - ‘bug’ - In the instance declaration for ‘Bug f (c a) (c r)’ +tc126.hs:17:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘bug’ + • In the instance declaration for ‘Bug f (c a) (c r)’ diff --git a/testsuite/tests/typecheck/should_compile/tc161.stderr b/testsuite/tests/typecheck/should_compile/tc161.stderr index 163fde19cd..6140a7cac1 100644 --- a/testsuite/tests/typecheck/should_compile/tc161.stderr +++ b/testsuite/tests/typecheck/should_compile/tc161.stderr @@ -1,5 +1,5 @@ -tc161.hs:17:10: Warning: - No explicit implementation for - ‘op’ - In the instance declaration for ‘Foo Int’ +tc161.hs:17:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘op’ + • In the instance declaration for ‘Foo Int’ diff --git a/testsuite/tests/typecheck/should_compile/tc175.stderr b/testsuite/tests/typecheck/should_compile/tc175.stderr index b7a0eedb68..57959c1396 100644 --- a/testsuite/tests/typecheck/should_compile/tc175.stderr +++ b/testsuite/tests/typecheck/should_compile/tc175.stderr @@ -1,5 +1,5 @@ -tc175.hs:13:10: Warning: - No explicit implementation for - either ‘showsPrec’ or ‘show’ - In the instance declaration for ‘Show (a -> b)’ +tc175.hs:13:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘showsPrec’ or ‘show’ + • In the instance declaration for ‘Show (a -> b)’ diff --git a/testsuite/tests/typecheck/should_compile/tc243.stderr b/testsuite/tests/typecheck/should_compile/tc243.stderr index 0219817408..f96fede5e6 100644 --- a/testsuite/tests/typecheck/should_compile/tc243.stderr +++ b/testsuite/tests/typecheck/should_compile/tc243.stderr @@ -1,3 +1,3 @@ -tc243.hs:10:1: warning: +tc243.hs:10:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: (.+.) :: forall a. a diff --git a/testsuite/tests/typecheck/should_compile/tc254.stderr b/testsuite/tests/typecheck/should_compile/tc254.stderr index 885b505828..663279d71a 100644 --- a/testsuite/tests/typecheck/should_compile/tc254.stderr +++ b/testsuite/tests/typecheck/should_compile/tc254.stderr @@ -1,4 +1,4 @@ -tc254.hs:8:1: Warning: - No explicit associated type or default declaration for ‘Typ’ - In the instance declaration for ‘Cls Int’ +tc254.hs:8:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘Typ’ + • In the instance declaration for ‘Cls Int’ diff --git a/testsuite/tests/typecheck/should_fail/T5051.stderr b/testsuite/tests/typecheck/should_fail/T5051.stderr index 2ad01e86ba..83a9ac8aef 100644 --- a/testsuite/tests/typecheck/should_fail/T5051.stderr +++ b/testsuite/tests/typecheck/should_fail/T5051.stderr @@ -1,5 +1,5 @@ -T5051.hs:8:30: warning: +T5051.hs:8:30: warning: [-Wmissing-methods (in -Wdefault)] • No explicit implementation for either ‘==’ or ‘/=’ • In the instance declaration for ‘Eq [T]’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail204.stderr b/testsuite/tests/typecheck/should_fail/tcfail204.stderr index f4b6ec791b..f3326faf0e 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail204.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail204.stderr @@ -1,5 +1,5 @@ -tcfail204.hs:10:15: warning: +tcfail204.hs:10:15: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘Double’ (Fractional a0) arising from the literal ‘6.3’ at tcfail204.hs:10:15-17 diff --git a/testsuite/tests/warnings/minimal/WarnMinimal.stderr b/testsuite/tests/warnings/minimal/WarnMinimal.stderr index d07eee875a..d907a6ced8 100644 --- a/testsuite/tests/warnings/minimal/WarnMinimal.stderr +++ b/testsuite/tests/warnings/minimal/WarnMinimal.stderr @@ -1,54 +1,54 @@ -WarnMinimal.hs:16:10: Warning: - No explicit implementation for - either ‘foo1’ or ‘foo2’ - In the instance declaration for ‘Foo Int’ - -WarnMinimal.hs:60:10: Warning: - No explicit implementation for - either ‘join'’ or ‘bind'’ - In the instance declaration for ‘Monad' ((->) e)’ - -WarnMinimal.hs:66:10: Warning: - No explicit implementation for - ‘return'’ - In the instance declaration for ‘Monad' Id’ - -WarnMinimal.hs:72:10: Warning: - No explicit implementation for - ‘return'’ - In the instance declaration for ‘Monad' Id2’ - -WarnMinimal.hs:79:10: Warning: - No explicit implementation for - ‘return'’ and (either (‘fmap'’ and ‘join'’) or ‘bind'’) - In the instance declaration for ‘Monad' Id3’ - -WarnMinimal.hs:84:1: Warning: - The MINIMAL pragma does not require: - ‘cheater’ - but there is no default implementation. - In the class declaration for ‘Cheater’ - -WarnMinimal.hs:92:1: Warning: - The MINIMAL pragma does not require: - ‘cheater3b’ - but there is no default implementation. - In the class declaration for ‘Cheater3’ - -WarnMinimal.hs:99:10: Warning: - No explicit implementation for - ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’ - or - ‘-’) - In the instance declaration for ‘Num Bool’ - -WarnMinimal.hs:105:10: Warning: - No explicit implementation for - ‘needed’ - In the instance declaration for ‘NoExplicit Int’ - -WarnMinimal.hs:116:10: Warning: - No explicit implementation for - either ‘===’ or ‘/==’ - In the instance declaration for ‘Eq' Blarg’ +WarnMinimal.hs:16:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘foo1’ or ‘foo2’ + • In the instance declaration for ‘Foo Int’ + +WarnMinimal.hs:60:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘join'’ or ‘bind'’ + • In the instance declaration for ‘Monad' ((->) e)’ + +WarnMinimal.hs:66:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘return'’ + • In the instance declaration for ‘Monad' Id’ + +WarnMinimal.hs:72:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘return'’ + • In the instance declaration for ‘Monad' Id2’ + +WarnMinimal.hs:79:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘return'’ and (either (‘fmap'’ and ‘join'’) or ‘bind'’) + • In the instance declaration for ‘Monad' Id3’ + +WarnMinimal.hs:84:1: warning: + • The MINIMAL pragma does not require: + ‘cheater’ + but there is no default implementation. + • In the class declaration for ‘Cheater’ + +WarnMinimal.hs:92:1: warning: + • The MINIMAL pragma does not require: + ‘cheater3b’ + but there is no default implementation. + • In the class declaration for ‘Cheater3’ + +WarnMinimal.hs:99:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’ + or + ‘-’) + • In the instance declaration for ‘Num Bool’ + +WarnMinimal.hs:105:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘needed’ + • In the instance declaration for ‘NoExplicit Int’ + +WarnMinimal.hs:116:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘===’ or ‘/==’ + • In the instance declaration for ‘Eq' Blarg’ diff --git a/testsuite/tests/warnings/should_compile/DeprU.stderr b/testsuite/tests/warnings/should_compile/DeprU.stderr index c27dccb474..158f25228f 100644 --- a/testsuite/tests/warnings/should_compile/DeprU.stderr +++ b/testsuite/tests/warnings/should_compile/DeprU.stderr @@ -1,10 +1,10 @@ [1 of 2] Compiling DeprM ( DeprM.hs, DeprM.o ) [2 of 2] Compiling A ( DeprU.hs, DeprU.o ) -DeprU.hs:3:1: Warning: +DeprU.hs:3:1: warning: [-Wdeprecations (in -Wdefault)] Module ‘DeprM’ is deprecated: Here can be your menacing deprecation warning! -DeprU.hs:6:5: Warning: +DeprU.hs:6:5: warning: [-Wdeprecations (in -Wdefault)] In the use of ‘f’ (imported from DeprM): Deprecated: "Here can be your menacing deprecation warning!" diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr index 1c975abdb2..a06ab5eb6c 100644 --- a/testsuite/tests/warnings/should_compile/PluralS.stderr +++ b/testsuite/tests/warnings/should_compile/PluralS.stderr @@ -1,12 +1,12 @@ -PluralS.hs:15:17: warning: +PluralS.hs:15:17: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraint to type ‘Integer’ Num t0 arising from the literal ‘123’ • In the first argument of ‘seq’, namely ‘123’ In the expression: 123 `seq` () In an equation for ‘defaultingNum’: defaultingNum = 123 `seq` () -PluralS.hs:17:29: warning: +PluralS.hs:17:29: warning: [-Wtype-defaults (in -Wall)] • Defaulting the following constraints to type ‘Integer’ (Num a0) arising from the literal ‘123’ at PluralS.hs:17:29-31 (Show a0) arising from a use of ‘show’ at PluralS.hs:17:24-31 diff --git a/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr b/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr index a693c47a03..d676ca9556 100644 --- a/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr +++ b/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr @@ -1,5 +1,5 @@ -T10890_2.hs:12:1: warning: +T10890_2.hs:12:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘T10890_2B’ is redundant except perhaps to import instances from ‘T10890_2B’ To import instances alone, use: import T10890_2B() diff --git a/testsuite/tests/warnings/should_compile/T11077.stderr b/testsuite/tests/warnings/should_compile/T11077.stderr index 84034f8c65..fcaa385679 100644 --- a/testsuite/tests/warnings/should_compile/T11077.stderr +++ b/testsuite/tests/warnings/should_compile/T11077.stderr @@ -1,3 +1,3 @@ -T11077.hs:3:1: warning: +T11077.hs:3:1: warning: [-Wmissing-exported-sigs] Top-level binding with no type signature: foo :: forall a. a diff --git a/testsuite/tests/warnings/should_compile/T11128.stderr b/testsuite/tests/warnings/should_compile/T11128.stderr index f924a19306..b8d788236c 100644 --- a/testsuite/tests/warnings/should_compile/T11128.stderr +++ b/testsuite/tests/warnings/should_compile/T11128.stderr @@ -1,20 +1,20 @@ -T11128.hs:28:5: warning: +T11128.hs:28:5: warning: [-Wnoncanonical-monad-instances] Noncanonical ‘pure = return’ definition detected in the instance declaration for ‘Applicative T1’. Move definition from ‘return’ to ‘pure’ -T11128.hs:30:5: warning: +T11128.hs:30:5: warning: [-Wnoncanonical-monad-instances] Noncanonical ‘(*>) = (>>)’ definition detected in the instance declaration for ‘Applicative T1’. Move definition from ‘(>>)’ to ‘(*>)’ -T11128.hs:34:5: warning: +T11128.hs:34:5: warning: [-Wnoncanonical-monad-instances] Noncanonical ‘return’ definition detected in the instance declaration for ‘Monad T1’. Either remove definition for ‘return’ or define as ‘return = pure’ -T11128.hs:35:5: warning: +T11128.hs:35:5: warning: [-Wnoncanonical-monad-instances] Noncanonical ‘(>>)’ definition detected in the instance declaration for ‘Monad T1’. Either remove definition for ‘(>>)’ or define as ‘(>>) = (*>)’ diff --git a/testsuite/tests/warnings/should_compile/T11128b.stderr b/testsuite/tests/warnings/should_compile/T11128b.stderr index 57aa22beea..e3fd3e83dc 100644 --- a/testsuite/tests/warnings/should_compile/T11128b.stderr +++ b/testsuite/tests/warnings/should_compile/T11128b.stderr @@ -1,10 +1,10 @@ -T11128b.hs:40:5: warning: +T11128b.hs:40:5: warning: [-Wnoncanonical-monadfail-instances] Noncanonical ‘fail’ definition detected in the instance declaration for ‘Monad T1’. Either remove definition for ‘fail’ or define as ‘fail = Control.Monad.Fail.fail’ -T11128b.hs:43:5: warning: +T11128b.hs:43:5: warning: [-Wnoncanonical-monadfail-instances] Noncanonical ‘fail = Control.Monad.fail’ definition detected in the instance declaration for ‘MonadFail T1’. Move definition from ‘Control.Monad.fail’ to ‘fail’ diff --git a/testsuite/tests/warnings/should_compile/T2526.stderr b/testsuite/tests/warnings/should_compile/T2526.stderr index 585c22dca4..07cf8d835f 100644 --- a/testsuite/tests/warnings/should_compile/T2526.stderr +++ b/testsuite/tests/warnings/should_compile/T2526.stderr @@ -1,3 +1,3 @@ -T2526.hs:4:1: Warning: +T2526.hs:4:1: warning: [-Wmissing-exported-sigs] Top-level binding with no type signature: foo :: Integer diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr index d22f428763..6edcbff5ec 100644 --- a/testsuite/tests/warnings/should_compile/T9178.stderr +++ b/testsuite/tests/warnings/should_compile/T9178.stderr @@ -1,7 +1,7 @@ [1 of 2] Compiling T9178DataType ( T9178DataType.hs, T9178DataType.o ) [2 of 2] Compiling T9178 ( T9178.hs, T9178.o ) -T9178.hs:8:1: warning: +T9178.hs:8:1: warning: [-Worphans (in -Wall)] Orphan instance: instance Show T9178_Type To avoid this move the instance declaration to the module of the class or of the type, or diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index 9a28fb3e21..91d3189e60 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -1,5 +1,5 @@ -WCompatWarningsOn.hs:13:5: warning: +WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • Could not deduce (Control.Monad.Fail.MonadFail m) arising from the failable pattern ‘Just _’ (this will become an error in a future GHC release) @@ -20,16 +20,16 @@ WCompatWarningsOn.hs:13:5: warning: = do { Just _ <- undefined; undefined } -WCompatWarningsOn.hs:16:1: warning: +WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -WCompatWarningsOn.hs:22:3: warning: +WCompatWarningsOn.hs:22:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semi.Semigroup S’. Move definition from ‘mappend’ to ‘(<>)’ -WCompatWarningsOn.hs:25:3: warning: +WCompatWarningsOn.hs:25:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. Define as ‘mappend = (<>)’ diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs index a72395e194..b194bf2995 100644 --- a/utils/mkUserGuidePart/Options/Warnings.hs +++ b/utils/mkUserGuidePart/Options/Warnings.hs @@ -43,6 +43,11 @@ warningsOptions = , flagType = DynamicFlag , flagReverse = "-Wno-unrecognised-warning-flags" } + , flag { flagName = "-fshow-warning-groups" + , flagDescription = "show which group an emitted warning belongs to." + , flagType = DynamicFlag + , flagReverse = "-fno-show-warning-groups" + } , flag { flagName = "-fdefer-type-errors" , flagDescription = "Turn type errors into warnings, :ref:`deferring the error until "++ |