adapt to caaf53881d5cc82ebff617f39ad5363429d2eccf

shayne-fletcher · Nov 26, 2024 · 16b1db8 · 16b1db8
1 parent d5a49d3
commit 16b1db8
Show file tree

Hide file tree

Showing 2 changed files with 105 additions and 3 deletions.
diff --git 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
@@ -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 {
       }