summaryrefslogtreecommitdiff
path: root/utils/check-exact/Main.hs
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-05-20 10:38:10 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-05-24 09:47:52 -0400
commit098c7794953ee11334b6a450e6eda598a7ee09dc (patch)
tree0164e283dff4b13e0bd25b44c6f5b4e78e3d892d /utils/check-exact/Main.hs
parent3e4ef4b2d05ce0bdd70abd96066f0376dc0e13d6 (diff)
downloadhaskell-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.hs31
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)
-- ---------------------------------------------------------------------