ghc-prim is merged with ghc-internal: fix ghc-lib-test-mini-compile

CI.hs

@@ -100,7 +100,7 @@ data DaFlavor = DaFlavor
 
 -- Last tested gitlab.haskell.org/ghc/ghc.git at
 current :: String
-current = "70f7741acd9d50a6cc07553aeaae600afe4a72b8" -- 2025-01-26
+current = "70f7741acd9d50a6cc07553aeaae600afe4a72b8" -- 2025-01-27
 
 ghcFlavorOpt :: GhcFlavor -> String
 ghcFlavorOpt = \case
@@ -421,13 +421,7 @@ buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix = do
   cmd "cabal build --ghc-options=-j all"
 
   system_ $ "cd examples/ghc-lib-test-mini-hlint && cabal test --project-dir ../.. --test-show-details direct --test-options \"--color always --test-command ../../ghc-lib-test-mini-hlint " ++ ghcFlavorArg ++ "\""
-
-  -- TODO: Fix me. This test is failing since ghc-prim merged with
-  -- ghc-internal
-  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13752
-  case ghcFlavor of
-    GhcMaster _ -> pure ()
-    _ -> system_ $ "cd examples/ghc-lib-test-mini-compile && cabal test --project-dir ../.. --test-show-details direct --test-options \"--color always --test-command ../../ghc-lib-test-mini-compile " ++ ghcFlavorArg ++ "\""
+  system_ $ "cd examples/ghc-lib-test-mini-compile && cabal test --project-dir ../.. --test-show-details direct --test-options \"--color always --test-command ../../ghc-lib-test-mini-compile " ++ ghcFlavorArg ++ "\""
 
   system_ "cabal -v0 exec -- ghc -ignore-dot-ghci -package=ghc-lib-parser -e \"print 1\""
   system_ "cabal -v0 exec -- ghc -ignore-dot-ghci -package=ghc-lib -e \"print 1\""

examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal

@@ -22,6 +22,7 @@ executable ghc-lib-test-mini-compile
                      , containers
                      , directory
                      , extra
+                     , filepath
                      , ghc-lib-parser
                      , ghc-lib
   hs-source-dirs:      src

examples/ghc-lib-test-mini-compile/src/Main.hs

@@ -54,6 +54,7 @@ import Paths_ghc_lib
 
 import System.Environment
 import System.Directory
+import System.FilePath(takeDirectory)
 import System.IO.Extra
 import qualified Data.Map.Strict as Map
 import Data.IORef
@@ -63,12 +64,14 @@ main = do
   args <- getArgs
   case args of
     [file] -> do
+      let dir = takeDirectory file
       s <- readFile' file
       flags <- mkDynFlags file s
       dataDir <- getDataDir
       createDirectoryIfMissing True $ dataDir ++ "/../mingw" -- hack: avoid "could not detect toolchain mingw"
       cm <- runGhc (Just dataDir) $ do
-              setSessionDynFlags flags
+              let searchPaths = [dir]
+              setSessionDynFlags flags { importPaths = searchPaths }
               compileToCoreSimplified file
       putStrLn $ showSDoc flags $ ppr cm
     _ -> fail "Exactly one file argument required"
@@ -77,8 +80,10 @@ ghclibPrimUnitId :: String
 ghclibPrimUnitId =
 #if defined (DAML_UNIT_IDS)
  "daml-prim"
-#else
+#elif defined(GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)
  "ghc-prim"
+#else
+ "ghc-internal"
 #endif
 
 -- Create a DynFlags which is sufficiently filled in to work, but not

examples/ghc-lib-test-mini-compile/test/GHC/Internal/Prim.hs

@@ -0,0 +1 @@
+module GHC.Internal.Prim where

examples/ghc-lib-test-mini-compile/test/Main.hs

@@ -2,7 +2,7 @@
 -- its affiliates. All rights reserved. SPDX-License-Identifier:
 -- (Apache-2.0 OR BSD-3-Clause)
 
-{-# OPTIONS_GHC -Werror=unused-imports -Werror=unused-local-binds -Werror=unused-top-binds -Werror=orphans #-}
+-- {-# OPTIONS_GHC -Werror=unused-imports -Werror=unused-local-binds -Werror=unused-top-binds -Werror=orphans #-}
 
 import Test.Tasty
 import Test.Tasty.Options
@@ -14,9 +14,12 @@ import Data.List.Extra
 import TestUtils
 import System.Process.Extra
 import System.IO.Extra
+import System.Directory
 
 main :: IO ()
 main = do
+  currentDir <- getCurrentDirectory
+  putStrLn $ "Current directory: " ++ currentDir
   defaultMainWithIngredients ings $
     askOption $ \ cmd@(CommandFile _) ->
       askOption $ \ config@(StackYaml _) ->
@@ -34,11 +37,14 @@ main = do
       : defaultIngredients
 
 tests :: CommandFile -> StackYaml -> Resolver -> GhcFlavor -> TestTree
-tests miniCompile _stackYaml _stackResolver _ghcFlavor = testGroup " All tests"
-  [ testCase "MiniCompileTest.hs" $ testMiniCompileTestHs miniCompile ]
+tests miniCompile _stackYaml _stackResolver ghcFlavor =
+  testGroup "All tests" [ testCase "MiniCompileTestHs" $ testMiniCompileTestHs miniCompile ghcFlavor]
 
-testMiniCompileTestHs :: CommandFile -> IO ()
-testMiniCompileTestHs (CommandFile miniCompile) = do
+testMiniCompileTestHs :: CommandFile -> GhcFlavor -> IO ()
+testMiniCompileTestHs (CommandFile miniCompile) ghcFlavor = do
   cmd <- readFile' miniCompile
-  out <- systemOutput_ $ cmd ++ "test/MiniCompileTest.hs"
+  out <- systemOutput_ $
+    cmd ++ case ghcSeries ghcFlavor of
+             s | s < GHC_9_14 -> "test/MiniCompileTest.hs"
+             s | otherwise -> "test/MiniCompileTestGhcInternalPrim.hs"
   assertBool "MiniCompileTest.hs" (isJust $ stripInfix "$tc'TyCon :: TyCon" out)

examples/ghc-lib-test-mini-compile/test/MiniCompileTestGhcInternalPrim.hs

@@ -0,0 +1,92 @@
+-- Copyright (c) 2019-2025, Digital Asset (Switzerland) GmbH and/or
+-- its affiliates. All rights reserved. SPDX-License-Identifier:
+-- (Apache-2.0 OR BSD-3-Clause)
+-- Based on
+-- https://github.com/ghc/ghc/blob/23f6f31dd66d7c370cb8beec3f1d96a0cb577393/libraries/ghc-prim/GHC/Types.hs
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+
+module GHC.Internal.Types (
+        -- Data types that are built-in syntax
+        -- They are defined here, but not explicitly exported
+        --
+        --    Lists:          []( [], (::) )
+
+        Bool(..), Int (..), Word, TextLit,
+        Ordering(..),
+        Symbol,
+        ifThenElse,
+        Multiplicity(..)
+    ) where
+
+import GHC.Internal.Prim
+
+infixr 5 :
+
+-- | The kind of constraints, like `Show a`
+data Constraint
+
+data Multiplicity = Many | One
+
+-- | (Kind) This is the kind of type-level symbols.
+-- Declared here because class IP needs it
+data Symbol
+
+-- | Documentation for lists
+data [] a = [] | a : [a]
+
+
+-- | Information about ordering
+data Ordering = LT | EQ | GT
+
+-- | A 64-bit integer.
+data Int =
+  I# Int#
+
+-- This is a dummy type we need for string literals.
+data Char
+
+type TextLit = [Char]
+
+-- A dummy type for Word.
+data Word
+
+data Bool = False | True
+
+isTrue# :: Int# -> Bool
+{-# INLINE isTrue# #-}
+isTrue# x = tagToEnum# x
+
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse c t f = case c of True -> t; False -> f
+
+data Module = Module
+                TrName   -- Package name
+                TrName   -- Module name
+
+data TrName
+  = TrNameS Addr#  -- Static
+  | TrNameD [Char] -- Dynamic
+
+type KindBndr = Int
+
+data RuntimeRep
+
+data KindRep = KindRepTyConApp TyCon [KindRep]
+             | KindRepVar !KindBndr
+             | KindRepApp KindRep KindRep
+             | KindRepFun KindRep KindRep
+             | KindRepTYPE !RuntimeRep
+             | KindRepTypeLitS TypeLitSort Addr#
+             | KindRepTypeLitD TypeLitSort [Char]
+
+data TypeLitSort = TypeLitSymbol
+                 | TypeLitNat
+                 | TypeLitChar
+
+data TyCon = TyCon Word# Word#           -- Fingerprint
+                   Module                -- Module in which this is defined
+                   TrName                -- Type constructor name
+                   Int#                  -- How many kind variables do we accept?
+                   KindRep               -- A representation of the type's kind

examples/ghc-lib-test-utils/src/TestUtils.hs

@@ -64,6 +64,9 @@ data GhcVersion
   | GhcMaster
   deriving (Eq, Ord, Typeable)
 
+data GhcSeries = GHC_8_8 | GHC_8_10 | GHC_9_0 | GHC_9_2 | GHC_9_4 | GHC_9_6 | GHC_9_8 | GHC_9_10 | GHC_9_12 | GHC_9_14
+  deriving (Eq, Ord)
+
 instance Show GhcVersion where
   show = showGhcVersion
 
@@ -106,6 +109,19 @@ showGhcVersion = \case
 newtype GhcFlavor = GhcFlavor GhcVersion
   deriving (Eq, Ord, Typeable)
 
+ghcSeries :: GhcFlavor -> GhcSeries
+ghcSeries (GhcFlavor f)
+  | DaGhc881 <= f && f < Ghc8101 = GHC_8_8
+  | Ghc8101 <= f && f < Ghc901 = GHC_8_10
+  | Ghc901 <= f && f < Ghc921 = GHC_9_0
+  | Ghc921 <= f && f < Ghc941 = GHC_9_2
+  | Ghc941 <= f && f < Ghc961 = GHC_9_4
+  | Ghc961 <= f && f < Ghc981 = GHC_9_6
+  | Ghc981 <= f && f < Ghc9101 = GHC_9_8
+  | Ghc9101 <= f && f < Ghc9121 = GHC_9_10
+  | Ghc9121 <= f && f < GhcMaster = GHC_9_12
+  | otherwise = GHC_9_14
+
 readFlavor :: String -> Maybe GhcFlavor
 readFlavor =
   (GhcFlavor <$>) . \case