diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-05-20 10:38:10 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-24 09:47:52 -0400 |
commit | 098c7794953ee11334b6a450e6eda598a7ee09dc (patch) | |
tree | 0164e283dff4b13e0bd25b44c6f5b4e78e3d892d /utils/check-exact/Main.hs | |
parent | 3e4ef4b2d05ce0bdd70abd96066f0376dc0e13d6 (diff) | |
download | haskell-098c7794953ee11334b6a450e6eda598a7ee09dc.tar.gz |
check-{ppr/exact}: Rewrite more directly to just parse files
There was quite a large amount of indirection in these tests, so I have
rewritten them to just directly parse the files rather than making a
module graph and entering other twisty packages.
Diffstat (limited to 'utils/check-exact/Main.hs')
-rw-r--r-- | utils/check-exact/Main.hs | 31 |
1 files changed, 12 insertions, 19 deletions
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 4316f2bea0..4789f5188b 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -10,9 +10,12 @@ import Data.List (intercalate) import Data.Data import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader +import GHC.Unit.Module.ModSummary +import Control.Monad.IO.Class import GHC hiding (moduleName) import GHC.Driver.Ppr import GHC.Driver.Session +import GHC.Driver.Make import GHC.Hs.Dump import GHC.Data.Bag import System.Environment( getArgs ) @@ -336,29 +339,19 @@ ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast parseOneFile :: FilePath -> FilePath -> IO (ParsedModule, [Located Token]) -parseOneFile libdir fileName = do - let modByFile m = - case ml_hs_file $ ms_location m of - Nothing -> False - Just fn -> fn == fileName +parseOneFile libdir fileName = runGhc (Just libdir) $ do dflags <- getSessionDynFlags let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream _ <- setSessionDynFlags dflags2 - addTarget Target { targetId = TargetFile fileName Nothing - , targetUnitId = homeUnitId_ dflags - , targetAllowObjCode = True - , targetContents = Nothing } - _ <- load LoadAllTargets - graph <- getModuleGraph - let - modSum = case filter modByFile (mgModSummaries graph) of - [x] -> x - xs -> error $ "Can't find module, got:" - ++ show (map (ml_hs_file . ms_location) xs) - pm <- GHC.parseModule modSum - toks <- getTokenStream (ms_mod modSum) - return (pm, toks) + hsc_env <- getSession + emodSum <- liftIO $ summariseFile hsc_env [] fileName Nothing True Nothing + case emsModSummary <$> emodSum of + Left _err -> error "parseOneFile" + Right modSum -> do + pm <- GHC.parseModule modSum + toks <- liftIO $ getTokenStream modSum + return (pm, toks) -- --------------------------------------------------------------------- |