diff options
Diffstat (limited to 'utils/check-exact/Preprocess.hs')
| -rw-r--r-- | utils/check-exact/Preprocess.hs | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/utils/check-exact/Preprocess.hs b/utils/check-exact/Preprocess.hs index 58cb6d028c..a2d3b53f49 100644 --- a/utils/check-exact/Preprocess.hs +++ b/utils/check-exact/Preprocess.hs @@ -16,26 +16,28 @@ module Preprocess import qualified GHC as GHC hiding (parseModule) import qualified Control.Monad.IO.Class as GHC -import qualified GHC.Data.Bag as GHC import qualified GHC.Data.FastString as GHC import qualified GHC.Data.StringBuffer as GHC import qualified GHC.Driver.Config as GHC import qualified GHC.Driver.Env as GHC +import qualified GHC.Driver.Errors.Types as GHC import qualified GHC.Driver.Phases as GHC import qualified GHC.Driver.Pipeline as GHC import qualified GHC.Fingerprint.Type as GHC import qualified GHC.Parser.Errors.Ppr as GHC -import qualified GHC.Parser.Lexer as GHC +import qualified GHC.Parser.Lexer as GHC hiding (getMessages) import qualified GHC.Settings as GHC +import qualified GHC.Types.Error as GHC (getMessages) import qualified GHC.Types.SourceError as GHC import qualified GHC.Types.SourceFile as GHC import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Utils.Error as GHC import qualified GHC.Utils.Fingerprint as GHC +import qualified GHC.Utils.Outputable as GHC import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc) import GHC.Data.FastString (mkFastString) -import Data.List (isPrefixOf, intercalate) +import Data.List (isPrefixOf) import Data.Maybe import Types import Utils @@ -221,8 +223,13 @@ getPreprocessedSrcDirectPrim cppOptions src_fn = do txt <- GHC.liftIO $ readFileGhc hspp_fn return (txt, buf, dflags') -showErrorMessages :: GHC.ErrorMessages -> String -showErrorMessages msgs = intercalate "\n" $ map show $ GHC.bagToList msgs +showErrorMessages :: GHC.Messages GHC.DriverMessage -> String +showErrorMessages msgs = + GHC.renderWithContext GHC.defaultSDocContext + $ GHC.vcat + $ GHC.pprMsgEnvelopeBagWithLoc + $ GHC.getMessages + $ msgs injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags injectCppOptions CppOptions{..} dflags = @@ -276,7 +283,8 @@ parseError pst = do let -- (warns,errs) = GHC.getMessages pst dflags -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err) - GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst)) + GHC.throwErrors $ + (GHC.foldPsMessages GHC.mkParserErr (GHC.getErrorMessages pst)) -- --------------------------------------------------------------------- |