diff options
| author | Michael Walker <mike@barrucadu.co.uk> | 2016-02-20 09:15:46 +0100 |
|---|---|---|
| committer | Herbert Valerio Riedel <hvr@gnu.org> | 2016-02-20 09:15:46 +0100 |
| commit | ed0d72d892b2e70099aaac758343e1e733478c1e (patch) | |
| tree | 4745a60f25fafce047c625664edc13f51b970b99 /compiler/main/DynFlags.hs | |
| parent | a8653c84a6322d10c646b05ea5406a23a4b7ffbb (diff) | |
| download | haskell-wip/D1934.tar.gz | |
Print which warning-flag controls an emitted warning.wip/D1934
Summary:
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.
Fixes T10752.
Reviewers: austin, hvr, goldfire, bgamari
Subscribers: goldfire, thomie
Differential Revision: https://phabricator.haskell.org/D1934
Diffstat (limited to 'compiler/main/DynFlags.hs')
| -rw-r--r-- | compiler/main/DynFlags.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 52da3005bf..df95312edc 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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 @@ -1616,13 +1616,13 @@ interpreterDynamic dflags -------------------------------------------------------------------------- type FatalMessager = String -> IO () -type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () +type LogAction = DynFlags -> Maybe WarningFlag -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () defaultFatalMessager :: FatalMessager defaultFatalMessager = hPutStrLn stderr defaultLogAction :: LogAction -defaultLogAction dflags severity srcSpan style msg +defaultLogAction dflags flag severity srcSpan style msg = case severity of SevOutput -> printSDoc msg style SevDump -> printSDoc (msg $$ blankLine) style @@ -1630,7 +1630,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 (mkLocMessageAnn flagMsg severity srcSpan msg) 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 +1638,9 @@ 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) + flagMsg = (\wf -> '-':'W':flagSpecName wf) <$> (flag >>= \f -> + listToMaybe $ filter (\fs -> flagSpecFlag fs == f) wWarningFlags) defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () defaultLogActionHPrintDoc dflags h d sty |