From 16b1db8a1c1c54afb970cfb94b6b73bf81c46a9a Mon Sep 17 00:00:00 2001 From: Shayne Fletcher Date: Mon, 25 Nov 2024 21:11:30 -0500 Subject: [PATCH] adapt to caaf53881d5cc82ebff617f39ad5363429d2eccf --- .../ghc-lib-test-mini-compile/src/Main.hs | 55 ++++++++++++++++++- examples/ghc-lib-test-mini-hlint/src/Main.hs | 53 +++++++++++++++++- 2 files changed, 105 insertions(+), 3 deletions(-) diff --git a/examples/ghc-lib-test-mini-compile/src/Main.hs b/examples/ghc-lib-test-mini-compile/src/Main.hs index 3b1d7bc3..e846d030 100644 --- a/examples/ghc-lib-test-mini-compile/src/Main.hs +++ b/examples/ghc-lib-test-mini-compile/src/Main.hs @@ -193,6 +193,23 @@ mkDynFlags filename s = do (dflags, _, _) <- parseDynamicFilePragma dflags0 opts return dflags +#elif (defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)) + + let baseFlags = + (defaultDynFlags fakeSettings) { + ghcLink = NoLink + , backend = noBackend + , homeUnitId_ = toUnitId (stringToUnit ghclibPrimUnitId) + } + parsePragmasIntoDynFlags filename s baseFlags + where + parsePragmasIntoDynFlags :: String -> String -> DynFlags -> IO DynFlags + parsePragmasIntoDynFlags filepath contents dflags0 = do + let (_, opts) = getOptions (initParserOpts dflags0) + (stringToStringBuffer contents) filepath + (dflags, _, _) <- parseDynamicFilePragma dflags0 opts + return dflags + #else let baseFlags = @@ -206,6 +223,7 @@ mkDynFlags filename s = do parsePragmasIntoDynFlags :: String -> String -> DynFlags -> IO DynFlags parsePragmasIntoDynFlags filepath contents dflags0 = do let (_, opts) = getOptions (initParserOpts dflags0) + (supportedLanguagePragmas dflags0) (stringToStringBuffer contents) filepath (dflags, _, _) <- parseDynamicFilePragma dflags0 opts return dflags @@ -394,16 +412,51 @@ fakeSettings = Settings { platform = genericPlatform +#elif (defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)) + sGhcNameVersion=ghcNameVersion + , sFileSettings=fileSettings + , sTargetPlatform=platform + , sPlatformMisc=platformMisc + , sToolSettings=toolSettings + } + where + fileSettings = FileSettings { + fileSettings_topDir="." + , fileSettings_toolDir=Nothing + , fileSettings_ghcUsagePath="." + , fileSettings_ghciUsagePath="." + , fileSettings_globalPackageDatabase="." + } + + toolSettings = ToolSettings { + toolSettings_opt_P_fingerprint=fingerprint0 + } + + platformMisc = PlatformMisc { + } + + ghcNameVersion = GhcNameVersion{ + ghcNameVersion_programName="ghc" + , ghcNameVersion_projectVersion=cProjectVersion + } + + platform = genericPlatform + #else - {- defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -} + {- defined (GHC_9_14) -} sGhcNameVersion=ghcNameVersion , sFileSettings=fileSettings , sTargetPlatform=platform , sPlatformMisc=platformMisc , sToolSettings=toolSettings + , sUnitSettings=unitSettings } where + unitSettings = UnitSettings { + unitSettings_baseUnitId = stringToUnitId "base" + } + fileSettings = FileSettings { fileSettings_topDir="." , fileSettings_toolDir=Nothing diff --git a/examples/ghc-lib-test-mini-hlint/src/Main.hs b/examples/ghc-lib-test-mini-hlint/src/Main.hs index 40de391a..a0c7a3ed 100644 --- a/examples/ghc-lib-test-mini-hlint/src/Main.hs +++ b/examples/ghc-lib-test-mini-hlint/src/Main.hs @@ -181,11 +181,30 @@ parsePragmasIntoDynFlags flags filepath str = sDoc : _ -> do putStrLn sDoc; return Nothing where sDocs = [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLocDefault . getMessages $ srcErrorMessages msgs ] +#elif (defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)) + catchErrors $ do + let (_, opts) = getOptions (initParserOpts flags) + (stringToStringBuffer str) filepath + (flags, _, _) <- parseDynamicFilePragma flags opts + return $ Just flags + where + catchErrors :: IO (Maybe DynFlags) -> IO (Maybe DynFlags) + catchErrors act = handleGhcException reportGhcException + (handleSourceError reportSourceErr act) + + reportGhcException e = do print e; return Nothing + + reportSourceErr msgs = case sDocs of + [] -> return Nothing + sDoc : _ -> do putStrLn sDoc; return Nothing + where + sDocs = [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLocDefault . getMessages $ srcErrorMessages msgs ] #else - {- defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -} + {- defined (GHC_9_14) -} catchErrors $ do let (_, opts) = getOptions (initParserOpts flags) + (supportedLanguagePragmas flags) (stringToStringBuffer str) filepath (flags, _, _) <- parseDynamicFilePragma flags opts return $ Just flags @@ -631,16 +650,46 @@ fakeSettings = Settings { platform=genericPlatform +#elif (defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)) + + sGhcNameVersion=ghcNameVersion + , sFileSettings=fileSettings + , sTargetPlatform=platform + , sPlatformMisc=platformMisc + , sToolSettings=toolSettings + } + where + fileSettings = FileSettings { + } + + toolSettings = ToolSettings { + toolSettings_opt_P_fingerprint=fingerprint0 + } + + platformMisc = PlatformMisc { + } + + ghcNameVersion = GhcNameVersion{ + ghcNameVersion_programName="ghc" + , ghcNameVersion_projectVersion=cProjectVersion + } + + platform=genericPlatform #else - {- defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -} + {- defined (GHC_9_14) -} sGhcNameVersion=ghcNameVersion , sFileSettings=fileSettings , sTargetPlatform=platform , sPlatformMisc=platformMisc , sToolSettings=toolSettings + , sUnitSettings=unitSettings } where + unitSettings = UnitSettings { + unitSettings_baseUnitId = stringToUnitId "base" + } + fileSettings = FileSettings { }