WIP

Author: alanz

configure.sh

@@ -271,4 +271,4 @@ rm -fr dist*
 # cabal configure -fdev  --with-compiler=/opt/ghc/9.13.20250316/bin/ghc --allow-newer
 # cabal configure -fdev  -froundtrip --enable-tests --with-compiler=/opt/ghc/9.13.20250316/bin/ghc --allow-newer
 # cabal configure -fdev  -froundtrip --enable-tests --with-compiler=/opt/ghc/9.13.20250331/bin/ghc --allow-newer
-cabal configure -fdev  -froundtrip --enable-tests --with-compiler=/opt/ghc/9.13.20250414/bin/ghc --allow-newer
+cabal configure -fdev  -froundtrip --enable-tests --with-compiler=/opt/ghc/9.13.20250427/bin/ghc --allow-newer

roundtrip-config/knownfailures.txt

@@ -1608,7 +1608,7 @@ instance ExactPrint (ImportDecl GhcPs) where
                     = (ideclExt idecl) { ideclAnn = setAnchorEpa (ideclAnn $ ideclExt idecl) anc ts cs} }
 
   exact (ImportDecl (XImportDeclPass ann msrc impl)
-                     modname mpkg src safeflag qualFlag mAs hiding) = do
+                     modname mpkg src st safeflag qualFlag mAs hiding) = do
 
     ann0 <- markLensFun' ann limportDeclAnnImport markEpToken
     let (EpAnn _anc an _cs) = ann0
@@ -1670,7 +1670,7 @@ instance ExactPrint (ImportDecl GhcPs) where
                   }
 
     return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)
-                     modname' mpkg src safeflag qualFlag mAs' hiding')
+                     modname' mpkg src st safeflag qualFlag mAs' hiding')
 
 
 -- ---------------------------------------------------------------------

src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs

@@ -59,6 +59,7 @@ import qualified GHC hiding (parseModule)
 import qualified Control.Monad.IO.Class as GHC
 import qualified GHC.Data.FastString    as GHC
 import qualified GHC.Data.StringBuffer  as GHC
+import qualified GHC.Driver.Config.Diagnostic as GHC
 import qualified GHC.Driver.Config.Parser as GHC
 import qualified GHC.Driver.Env.Types     as GHC
 import qualified GHC.Driver.Errors.Types  as GHC
@@ -117,17 +118,33 @@ runParser parser flags filename str = GHC.unP parser parseState
       -- TODO: precompute the macros first, store them in an IORef
       -- macros = Nothing
       macros = fromMaybe Map.empty macrosFromIORef
-      parseState0 = GHC.initParserStateWithMacrosString flags Nothing (GHC.initParserOpts flags) buffer location
+      -- opts0 = GHC.initParserOpts flags
+      -- opts1 = GHC.enableExtBit GHC.UsePosPragsBit opts0
+      -- opts = opts1
+      opts = myInitParserOpts flags
+      parseState0 = GHC.initParserStateWithMacrosString flags Nothing opts buffer location
       parseState = parseState0 { GHC.pp = (GHC.pp parseState0) { GHC.pp_defines = macros }
                                , GHC.buffer = buffer }
 
+
 macroIORef :: IORef (Maybe GHC.MacroDefines)
 {-# NOINLINE macroIORef #-}
 macroIORef = unsafePerformIO (newIORef Nothing)
 
 macrosFromIORef :: Maybe GHC.MacroDefines
 macrosFromIORef =  unsafePerformIO (readIORef macroIORef)
 
+myInitParserOpts :: GHC.DynFlags -> GHC.ParserOpts
+myInitParserOpts =
+  GHC.mkParserOpts
+    <$> GHC.extensionFlags
+    <*> GHC.initDiagOpts
+    <*> GHC.safeImportsOn
+    <*> GHC.gopt GHC.Opt_Haddock
+    <*> GHC.gopt GHC.Opt_KeepRawTokenStream
+    <*> const False -- do not use LINE/COLUMN to update the internal location
+
+
 -- ---------------------------------------------------------------------
 
 -- | Provides a safe way to consume a properly initialised set of
@@ -277,13 +294,9 @@ parseModuleEpAnnsWithGhcCppInternal cppOptions dflags file = do
   (fileContents, injectedComments, dflags') <-
     if useCpp
       then do
-        -- (contents,dflags1) <- getPreprocessedSrcDirect cppOptions file
-        -- cppComments <- getCppTokensAsComments cppOptions file
-        -- return (contents,cppComments,dflags1)
         txt <- GHC.liftIO $ readFileGhc file
-        -- let (contents1,lp) = stripLinePragmas txt
         let (contents1,lp) = (txt, [])
-        let no_cpp_dflags = GHC.xopt_unset dflags  LangExt.GhcCpp
+        let no_cpp_dflags = GHC.xopt_unset dflags LangExt.Cpp
         return (contents1, lp, GHC.xopt_set no_cpp_dflags LangExt.GhcCpp)
       else do
         txt <- GHC.liftIO $ readFileGhc file

src/Language/Haskell/GHC/ExactPrint/Parsers.hs

@@ -229,7 +229,9 @@ tt' = do
     -- mkParserTest libdir "pre-ghc910" "Utils.hs"
     -- mkParserTest libdir "failing" "CppComment.hs"
     -- mkParserTest libdir "ghc-cpp" "Scan.hs"
-    mkParserTest libdir "ghc-cpp" "Test1.hs"
+    -- mkParserTest libdir "ghc-cpp" "Test1.hs"
+    -- mkParserTest libdir "ghc-cpp" "WithoutSomeFixpoints.hs"
+    mkParserTest libdir "ghc-cpp" "HelperMain.hs"
 
     ]
 

tests/Test.hs

@@ -292,5 +292,11 @@ hhh libdir = ghcWrapper libdir $ do
             , "  (major1) == 2 && (major2) <  0 || \\"
             , "  (major1) == 2 && (major2) == 0 && (minor) <= 1)"
             , ""
+            , "#define VERSION_template_haskell \"2.23.0\""
+            , "#define MIN_VERSION_template_haskell(major1,major2,minor) (\\"
+            , "  (major1) <  2 || \\"
+            , "  (major1) == 2 && (major2) <  23 || \\"
+            , "  (major1) == 2 && (major2) == 23 && (minor) <= 0)"
+            , ""
             ]
     return $ parseMacroDefines dflags macro_defs