From 098c7794953ee11334b6a450e6eda598a7ee09dc Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Thu, 20 May 2021 10:38:10 +0100
Subject: 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.
---
 utils/check-exact/Main.hs | 31 ++++++++++++-------------------
 1 file changed, 12 insertions(+), 19 deletions(-)

(limited to 'utils/check-exact/Main.hs')

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)
 
 
 -- ---------------------------------------------------------------------
-- 
cgit v1.2.1