
Hi, On Thu, Feb 27, 2020 at 03:43:35PM +0000, Tseen She wrote:
Sorry for the spam, but I think this is definitely a bug/regression in ghc-8.8.1 (still present in 8.8.3).
No worries
I don't know which commit introduced the problem, but it seems that getModSummary is no longer reporting the correct ms_hspp_opts, at least for an in-memory file but it could also be for a file on disk as well (I haven't excluded that as a possibility).
On a quick testcase I cannot reproduce this behaviour: -- $ ghc -package ghc -package ghc-paths TargetContents.hs module Main where import GHC import GHC.Paths (libdir) import MonadUtils import DynFlags import StringBuffer import Data.Time.Clock main :: IO () main = do defaultErrorHandler defaultFatalMessager defaultFlushOut $ do runGhc (Just libdir) $ do dflags0 <- getSessionDynFlags (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc ["-package", "base"] _ <- setSessionDynFlags dflags1 t <- liftIO getCurrentTime setTargets [Target (TargetFile "Main.hs" Nothing) False (Just (stringToStringBuffer buffer, t)) ] _ <- depanal [] False ms <- getModSummary (mkModuleName "Main") pm <- parseModule ms liftIO $ print $ extensions $ ms_hspp_opts ms _ <- typecheckModule pm return () buffer = "{-# LANGUAGE PackageImports #-}\nimport \"base\" Data.List\nmain = return ()" Running it it prints the PackageImports ext from the in-memory buffer just fine: $ ghc-8.8.1 -package ghc -package ghc-paths TargetContents.hs $ ./TargetContents [On PackageImports] One change in behaviour to note is that when doing this with <8.8 we first need to create the Main.hs file so GHC doesn't complain about it missing. Maybe you can fiddle with the test case until it reflects what you're doing? --Daniel