diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs index e12d4569d2f..4c594d2f8b6 100644 --- a/Cabal-syntax/src/Distribution/Compiler.hs +++ b/Cabal-syntax/src/Distribution/Compiler.hs @@ -56,8 +56,10 @@ import Language.Haskell.Extension import Distribution.Version (Version, mkVersion', nullVersion) import qualified Distribution.Compat.CharParsing as P +import Distribution.Package (PackageName) import Distribution.Parsec (Parsec (..)) import Distribution.Pretty (Pretty (..), prettyShow) +import Distribution.Types.UnitId (UnitId) import qualified System.Info (compilerName, compilerVersion) import qualified Text.PrettyPrint as Disp @@ -213,6 +215,12 @@ data CompilerInfo = CompilerInfo -- ^ Supported language standards, if known. , compilerInfoExtensions :: Maybe [Extension] -- ^ Supported extensions, if known. + , compilerInfoWiredInUnitIds :: Maybe [(PackageName, UnitId)] + -- ^ 'UnitId's that the compiler doesn't support reinstalling. + -- 'Nothing' indicates that the compiler hasn't supplied this + -- information and that we should act pessimistically. + -- For instance, when using GHC plugins, one wants to use the exact same + -- version of the `ghc` package as the one the compiler was linked against. } deriving (Generic, Show, Read) @@ -245,4 +253,4 @@ abiTagString (AbiTag tag) = tag -- compiler id's. unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo unknownCompilerInfo compilerId abiTag = - CompilerInfo compilerId abiTag (Just []) Nothing Nothing + CompilerInfo compilerId abiTag (Just []) Nothing Nothing Nothing diff --git a/Cabal-tests/tests/UnitTests/Distribution/Simple/Program/GHC.hs b/Cabal-tests/tests/UnitTests/Distribution/Simple/Program/GHC.hs index d66b2eb4316..daf64ccbb54 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Simple/Program/GHC.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Simple/Program/GHC.hs @@ -54,6 +54,7 @@ tests = testGroup "Distribution.Simple.Program.GHC" , compilerLanguages = [] , compilerExtensions = [] , compilerProperties = Map.singleton "Support parallel --make" "YES" + , compilerWiredInUnitIds = Nothing }) (Platform X86_64 Linux) (mempty { ghcOptNumJobs = Flag (NumJobs (Just 4)) }) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index e298681f272..129f8d0d85c 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -33,4 +33,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy - 0xea86b170fa32ac289cbd1fb6174b5cbf + 0xed69bb9372239b67b14b3e4dd3597c56 diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 4e31bb43430..3a0aa4c917b 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -101,7 +101,9 @@ import Distribution.Pretty import Prelude () import Distribution.Compiler +import Distribution.Package (PackageName) import Distribution.Simple.Utils +import Distribution.Types.UnitId (UnitId) import Distribution.Utils.Path import Distribution.Version @@ -124,6 +126,12 @@ data Compiler = Compiler -- ^ Supported language standards. , compilerExtensions :: [(Extension, Maybe CompilerFlag)] -- ^ Supported extensions. + , compilerWiredInUnitIds :: Maybe [(PackageName, UnitId)] + -- ^ 'UnitId's that the compiler doesn't support reinstalling. + -- For instance, when using GHC plugins, one wants to use the exact same + -- version of the `ghc` package as the one the compiler was linked against. + -- 'Nothing' indicates that the compiler hasn't supplied this + -- information and that we should act pessimistically. , compilerProperties :: Map String String -- ^ A key-value map for properties not covered by the above fields. } @@ -183,6 +191,7 @@ compilerInfo c = (Just . compilerCompat $ c) (Just . map fst . compilerLanguages $ c) (Just . map fst . compilerExtensions $ c) + (compilerWiredInUnitIds c) -- ------------------------------------------------------------ diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 593bf4e9119..271e5eae89f 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -229,6 +229,9 @@ configureCompiler verbosity hcPath conf0 = do compilerId :: CompilerId compilerId = CompilerId GHC ghcVersion + projectUnitId :: Maybe String + projectUnitId = Map.lookup "Project Unit Id" ghcInfoMap + -- The @AbiTag@ is the @Project Unit Id@ but with redundant information from the compiler version removed. -- For development versions of the compiler these look like: -- @Project Unit Id@: "ghc-9.13-inplace" @@ -241,9 +244,17 @@ configureCompiler verbosity hcPath conf0 = do NoAbiTag AbiTag ( dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId) - <$> Map.lookup "Project Unit Id" ghcInfoMap + <$> projectUnitId ) + wiredInUnitIds = do + ghcInternalUnitId <- Map.lookup "ghc-internal Unit Id" ghcInfoMap + ghcUnitId <- projectUnitId + pure + [ (mkPackageName "ghc", mkUnitId ghcUnitId) + , (mkPackageName "ghc-internal", mkUnitId ghcInternalUnitId) + ] + let comp = Compiler { compilerId @@ -252,6 +263,7 @@ configureCompiler verbosity hcPath conf0 = do , compilerLanguages = languages , compilerExtensions = extensions , compilerProperties = ghcInfoMap + , compilerWiredInUnitIds = wiredInUnitIds } compPlatform = Internal.targetPlatform ghcInfo return (comp, compPlatform, progdb1) diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index f705580aff9..c7f91a5b0e2 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -170,6 +170,7 @@ configureCompiler verbosity hcPath conf0 = do , compilerLanguages = languages , compilerExtensions = extensions , compilerProperties = ghcInfoMap + , compilerWiredInUnitIds = Nothing } compPlatform = Internal.targetPlatform ghcjsInfo return (comp, compPlatform, progdb1) diff --git a/Cabal/src/Distribution/Simple/UHC.hs b/Cabal/src/Distribution/Simple/UHC.hs index 0016c93d4a8..3d57cd6b2bc 100644 --- a/Cabal/src/Distribution/Simple/UHC.hs +++ b/Cabal/src/Distribution/Simple/UHC.hs @@ -77,6 +77,7 @@ configure verbosity hcPath progdb = do , compilerLanguages = uhcLanguages , compilerExtensions = uhcLanguageExtensions , compilerProperties = Map.empty + , compilerWiredInUnitIds = Nothing } compPlatform = Nothing return (comp, compPlatform, progdb') diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index d6ffadf0abf..9cc4234e66e 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -318,6 +318,7 @@ showFR _ UnknownPackage = " (unknown package)" showFR _ (GlobalConstraintVersion vr (ConstraintSourceProjectConfig pc)) = '\n' : (render . nest 6 $ docProjectConfigPathFailReason vr pc) showFR _ (GlobalConstraintVersion vr src) = " (" ++ constraintSource src ++ " requires " ++ prettyShow vr ++ ")" showFR _ (GlobalConstraintInstalled src) = " (" ++ constraintSource src ++ " requires installed instance)" +showFR _ (GlobalConstraintInstalledSpecificUnitId unitId src) = " (" ++ constraintSource src ++ " requires installed instance with unit id " ++ prettyShow unitId ++ ")" showFR _ (GlobalConstraintSource src) = " (" ++ constraintSource src ++ " requires source instance)" showFR _ (GlobalConstraintFlag src) = " (" ++ constraintSource src ++ " requires opposite flag selection)" showFR _ ManualFlag = " (manual flag can only be changed explicitly)" diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs index ccd0e4d4a70..876ac2d790c 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs @@ -10,6 +10,7 @@ module Distribution.Solver.Modular.Package , PN , QPV , instI + , instUid , makeIndependent , primaryPP , setupPP @@ -77,6 +78,10 @@ instI :: I -> Bool instI (I _ (Inst _)) = True instI _ = False +instUid :: UnitId -> I -> Bool +instUid uid (I _ (Inst uid')) = uid == uid' +instUid _ _ = False + -- | Is the package in the primary group of packages. This is used to -- determine (1) if we should try to establish stanza preferences -- for this goal, and (2) whether or not a user specified @--constraint@ diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs index 9e0d5fb4d22..4d589595c36 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs @@ -190,6 +190,9 @@ processPackageConstraintP qpn c i (LabeledPackageConstraint (PackageConstraint s go _ PackagePropertyInstalled | instI i = r | otherwise = Fail c (GlobalConstraintInstalled src) + go _ (PackagePropertyInstalledSpecificUnitId unitId) + | instUid unitId i = r + | otherwise = Fail c (GlobalConstraintInstalledSpecificUnitId unitId src) go _ PackagePropertySource | not (instI i) = r | otherwise = Fail c (GlobalConstraintSource src) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs index 36aef5ebac7..a845ad6ef9d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs @@ -118,6 +118,7 @@ data FailReason = UnsupportedExtension Extension | UnknownPackage | GlobalConstraintVersion VR ConstraintSource | GlobalConstraintInstalled ConstraintSource + | GlobalConstraintInstalledSpecificUnitId UnitId ConstraintSource | GlobalConstraintSource ConstraintSource | GlobalConstraintFlag ConstraintSource | ManualFlag diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs index f5d08f2923a..9b5db378b6a 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs @@ -19,7 +19,7 @@ module Distribution.Solver.Types.PackageConstraint ( import Distribution.Solver.Compat.Prelude import Prelude () -import Distribution.Package (PackageName) +import Distribution.Package (PackageName, UnitId) import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment) import Distribution.Pretty (flatStyle, Pretty(pretty)) import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..)) @@ -90,6 +90,7 @@ instance Pretty ConstraintScope where data PackageProperty = PackagePropertyVersion VersionRange | PackagePropertyInstalled + | PackagePropertyInstalledSpecificUnitId UnitId | PackagePropertySource | PackagePropertyFlags FlagAssignment | PackagePropertyStanzas [OptionalStanza] @@ -102,6 +103,7 @@ instance Structured PackageProperty instance Pretty PackageProperty where pretty (PackagePropertyVersion verrange) = pretty verrange pretty PackagePropertyInstalled = Disp.text "installed" + pretty (PackagePropertyInstalledSpecificUnitId unitId) = Disp.text "installed(" <> pretty unitId <> Disp.text ")" pretty PackagePropertySource = Disp.text "source" pretty (PackagePropertyFlags flags) = dispFlagAssignment flags pretty (PackagePropertyStanzas stanzas) = @@ -139,6 +141,7 @@ packageConstraintToDependency (PackageConstraint scope prop) = toDep prop where toDep (PackagePropertyVersion vr) = Just $ PackageVersionConstraint (scopeToPackageName scope) vr toDep (PackagePropertyInstalled) = Nothing + toDep (PackagePropertyInstalledSpecificUnitId {}) = Nothing toDep (PackagePropertySource) = Nothing toDep (PackagePropertyFlags _) = Nothing toDep (PackagePropertyStanzas _) = Nothing diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 594afb9e24f..a65c41cb046 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -443,6 +443,16 @@ setSolverVerbosity verbosity params = { depResolverVerbosity = verbosity } +dependOnWiredIns :: CompilerInfo -> DepResolverParams -> DepResolverParams +dependOnWiredIns compiler params = addConstraints extraConstraints params + where + extraConstraints = + [ LabeledPackageConstraint + (PackageConstraint (ScopeAnyQualifier pkgName) (PackagePropertyInstalledSpecificUnitId unitId)) + ConstraintSourceNonReinstallablePackage + | (pkgName, unitId) <- fromMaybe [] $ compilerInfoWiredInUnitIds compiler + ] + -- | Some packages are specific to a given compiler version and should never be -- reinstalled. dontInstallNonReinstallablePackages :: DepResolverParams -> DepResolverParams @@ -849,8 +859,8 @@ resolveDependencies platform comp pkgConfigDB params = order verbosity ) = - if asBool (depResolverAllowBootLibInstalls params) - then params + if isJust (compilerInfoWiredInUnitIds comp) || asBool (depResolverAllowBootLibInstalls params) + then dependOnWiredIns comp params else dontInstallNonReinstallablePackages params formatProgress :: Progress SummarizedMessage String a -> Progress String String a diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Store.hs b/cabal-install/tests/UnitTests/Distribution/Client/Store.hs index 976bd97a4cb..5f30ff496f5 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Store.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Store.hs @@ -46,6 +46,7 @@ testListEmpty = , compilerLanguages = [] , compilerExtensions = [] , compilerProperties = mempty + , compilerWiredInUnitIds = Nothing } unitid = mkUnitId "foo-1.0-xyz" @@ -102,6 +103,7 @@ testInstallSerial = , compilerLanguages = [] , compilerExtensions = [] , compilerProperties = mempty + , compilerWiredInUnitIds = Nothing } unitid1 = mkUnitId "foo-1.0-xyz" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index d1d70f59348..20e52b9b139 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -96,6 +96,7 @@ import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverPackage import Distribution.Solver.Types.SourcePackage import Distribution.Solver.Types.Variable +import Distribution.Types.UnitId (UnitId) {------------------------------------------------------------------------------- Example package database DSL @@ -783,6 +784,8 @@ exResolve -> Maybe [Extension] -- List of languages supported by the compiler, or Nothing if unknown. -> Maybe [Language] + -> Maybe [(C.PackageName, UnitId)] + -- ^ List of units that are wired in to the compiler -> Maybe PC.PkgConfigDb -> [ExamplePkgName] -> Maybe Int @@ -806,6 +809,7 @@ exResolve db exts langs + wiredInUnitIds pkgConfigDb targets mbj @@ -831,6 +835,7 @@ exResolve defaultCompiler { C.compilerInfoExtensions = exts , C.compilerInfoLanguages = langs + , C.compilerInfoWiredInUnitIds = wiredInUnitIds } (inst, avai) = partitionEithers db instIdx = exInstIdx inst diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs index afd1419d30c..bfe563947cd 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs @@ -18,6 +18,7 @@ module UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils , preferences , setVerbose , enableAllTests + , wiredInUnitIds , solverSuccess , solverFailure , anySolverFailure @@ -50,6 +51,7 @@ import qualified Distribution.Solver.Types.PackagePath as P import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb (..), pkgConfigDbFromList) import Distribution.Solver.Types.Settings import Distribution.Solver.Types.Variable +import Distribution.Types.UnitId (UnitId, mkUnitId) import UnitTests.Distribution.Solver.Modular.DSL import UnitTests.Options @@ -106,6 +108,16 @@ setVerbose test = test{testVerbosity = verbose} enableAllTests :: SolverTest -> SolverTest enableAllTests test = test{testEnableAllTests = EnableAllTests True} +wiredInUnitIds :: SolverTest -> SolverTest +wiredInUnitIds test = + test + { testWiredInUnitIds = + Just + [ (C.mkPackageName "ghc-internal", mkUnitId "ghc-internal-1") + , (C.mkPackageName "ghc", mkUnitId "ghc-1") + ] + } + {------------------------------------------------------------------------------- Solver tests -------------------------------------------------------------------------------} @@ -130,6 +142,7 @@ data SolverTest = SolverTest , testDb :: ExampleDb , testSupportedExts :: Maybe [Extension] , testSupportedLangs :: Maybe [Language] + , testWiredInUnitIds :: Maybe [(C.PackageName, UnitId)] , testPkgConfigDb :: Maybe PkgConfigDb , testEnableAllTests :: EnableAllTests } @@ -233,6 +246,7 @@ mkTestExtLangPC exts langs mPkgConfigDb db label targets result = , testDb = db , testSupportedExts = exts , testSupportedLangs = langs + , testWiredInUnitIds = Nothing , testPkgConfigDb = pkgConfigDbFromList <$> mPkgConfigDb , testEnableAllTests = EnableAllTests False } @@ -245,6 +259,7 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) -> testDb testSupportedExts testSupportedLangs + testWiredInUnitIds testPkgConfigDb testTargets testMaxBackjumps diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs index 9994acee2e9..2e1f5ba39db 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -242,6 +242,7 @@ solve enableBj fineGrainedConflicts reorder countConflicts indep prefOldest goal (unTestDb (testDb test)) Nothing Nothing + Nothing (Just $ pkgConfigDbFromList []) (map unPN (testTargets test)) -- The backjump limit prevents individual tests from using diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index a1f5eed3c62..691d9b1d39e 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -198,17 +198,39 @@ tests = , runTest $ mkTest db11s2 "baseShim8" ["A"] (solverSuccess [("A", 1)]) ] , testGroup - "Base and non-reinstallable" + "Non-reinstallable base, template-haskell and ghc (GHC without wiredInUnitIds)" [ runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $ solverFailure (isInfixOf "rejecting: base-1.0.0 (constraint from non-reinstallable package requires installed instance)") + , runTest $ + mkTest dbTH "Refuse to install template-haskell without --allow-boot-library-installs" ["template-haskell"] $ + solverFailure (isInfixOf "rejecting: template-haskell-1.0.0 (constraint from non-reinstallable package requires installed instance)") + , runTest $ + mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $ + solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-reinstallable package requires installed instance)") , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $ solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)] + ] + , testGroup + "Reinstallable base, template-haskell, but not ghc{,-internal} (GHC with wiredInUnitIds)" + [ runTest $ + wiredInUnitIds $ + mkTest dbBase "Allows reinstalling base even without --allow-boot-library-installs" ["base"] $ + solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)] , runTest $ - mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $ - solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-reinstallable package requires installed instance)") + wiredInUnitIds $ + mkTest dbTH "Allows reinstalling template-haskell even without --allow-boot-library-installs" ["template-haskell"] $ + solverSuccess [("base", 1), ("ghc-prim", 1), ("pretty", 1), ("template-haskell", 1)] + , runTest $ + wiredInUnitIds $ + mkTest dbGhcInternal "Fails to reinstall ghc-internal as its wired-in" ["ghc-internal"] $ + solverFailure (isInfixOf "ghc-internal-1.0.0 (constraint from non-reinstallable package requires installed instance with unit id ghc-internal-1)") + , runTest $ + wiredInUnitIds $ + mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $ + solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-reinstallable package requires installed instance with unit id ghc-1)") ] , testGroup "reject-unconstrained" @@ -1400,6 +1422,25 @@ dbBase = , Right $ exAv "integer-gmp" 1 [] ] +dbTH :: ExampleDb +dbTH = + [ Right $ + exAv + "template-haskell" + 1 + [ExAny "ghc-prim", ExAny "ghc-internal", ExAny "ghc-boot-th", ExAny "pretty", ExAny "base"] + , Right $ exAv "ghc-prim" 1 [] + , Left $ exInst "ghc-internal" 1 "ghc-internal-1" [] + , Left $ exInst "ghc-boot-th" 1 "ghc-boot-th-1" [] + , Right $ exAv "pretty" 1 [ExAny "base"] + , Right $ exAv "base" 1 [ExAny "ghc-prim", ExAny "ghc-internal"] + ] + +dbGhcInternal :: ExampleDb +dbGhcInternal = + [ Right $ exAv "ghc-internal" 1 [] + ] + dbNonupgrade :: ExampleDb dbNonupgrade = [ Left $ exInst "ghc" 1 "ghc-1" [] diff --git a/cabal-testsuite/Setup.hs b/cabal-testsuite/Setup.hs index 3a4a335b86e..fa07806b9c5 100644 --- a/cabal-testsuite/Setup.hs +++ b/cabal-testsuite/Setup.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE CPP #-} module Main (main) where import Distribution.Backpack @@ -51,7 +52,14 @@ generateScriptEnvModule lbi verbosity = do , "lbiPlatform = " ++ show (hostPlatform lbi) , "" , "lbiCompiler :: Compiler" + -- We added a new field to compiler so we need to be careful + -- to make sure that it is always defined, + -- even if the test suite is being built with an older Cabal +#if MIN_VERSION_Cabal(3,15,0) , "lbiCompiler = " ++ show (compiler lbi) +#else + , "lbiCompiler = " ++ init (show (compiler lbi)) ++ ", compilerWiredInUnitIds = Nothing}" +#endif , "" , "lbiPackages :: [(OpenUnitId, ModuleRenaming)]" , "lbiPackages = read " ++ show (show (cabalTestsPackages lbi)) diff --git a/changelog.d/pr-10982 b/changelog.d/pr-10982 new file mode 100644 index 00000000000..54630d83aaa --- /dev/null +++ b/changelog.d/pr-10982 @@ -0,0 +1,14 @@ +synopsis: Allow reinstalling packages like base and template-haskell for GHC>=9.14 +packages: cabal-install cabal-install-solver +prs: #10982 +issues: #10087 +significance: significant + +description: { + +Historically cabal-install disallowed reinstalling packages like `base` and `template-haskell`. +As of GHC-9.12, the reasons for this have been lifted. +We update cabal-install to become aware of this and allow reinstalling more packages. +Certain packages like `ghc` and `ghc-internal` still cannot be reinstalled. + +}