diff options
| author | Michael Walker <mike@barrucadu.co.uk> | 2016-02-25 17:34:07 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-02-25 17:44:33 +0100 |
| commit | 736c2fe705f083fe42bd5fe9318f0636b6b2fca6 (patch) | |
| tree | d55e5e571c21850cbabec1c9f8387d56033b0edc /compiler/ghci | |
| parent | e38c07bf5ceb8f50fa5110b70b3b83f0ce1358ba (diff) | |
| download | haskell-wip/warning-origins.tar.gz | |
Print which warning-flag controls an emitted warning.wip/warning-origins
Both gcc and clang tell which warning flag a reported warning can be
controlled with, this patch makes ghc do the same. More generally, this
allows for annotated compiler output, where an optional annotation is
displayed in brackets after the severity.
Display which group enables a warning.
Add flag to show which group a warning belongs to
``-f(no-)show-warning-groups``, used to show/hide the group an emitted
warning belongs to. On by default.
Fix compilation error in ghc-api test
Reviewers: goldfire, hvr, quchen, austin, bgamari
Reviewed By: quchen, bgamari
Subscribers: goldfire, thomie
Differential Revision: https://phabricator.haskell.org/D1943
GHC Trac Issues: #10752
Diffstat (limited to 'compiler/ghci')
| -rw-r--r-- | compiler/ghci/Debugger.hs | 2 | ||||
| -rw-r--r-- | compiler/ghci/Linker.hs | 11 |
2 files changed, 9 insertions, 4 deletions
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") |