From 3851043a15eecf9d327d61ffdd7a98e72e4b093e Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Fri, 24 Nov 2023 12:30:00 +0000
Subject: [PATCH] testsuite: Add tests for #9467 (base shim, setup qualifier
 interaction)

This adds two tests for issue #9467
---
 cabal-install/cabal-install.cabal                  |  1 +
 .../Distribution/Solver/Modular/Solver.hs          | 59 ++++++++++++++++++++++
 2 files changed, 60 insertions(+)

diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 2e06aa991..1d24399ea 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -355,6 +355,7 @@ test-suite unit-tests
           tasty >= 1.2.3 && <1.6,
           tasty-golden >=2.3.1.1 && <2.4,
           tasty-quickcheck,
+          tasty-expected-failure,
           tasty-hunit >= 0.10,
           tree-diff,
           QuickCheck >= 2.14.3 && <2.15
diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
index 3d5b965ba..1a0186686 100644
--- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
@@ -13,6 +13,7 @@ import qualified Distribution.Version as V
 
 -- test-framework
 import Test.Tasty as TF
+import Test.Tasty.ExpectedFailure
 
 -- Cabal
 import Language.Haskell.Extension
@@ -190,6 +191,9 @@ tests =
       , runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
       , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure
       , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)])
+      , expectFailBecause "#9467" $ runTest $ mkTest db12s "baseShim7" ["A"] (solverSuccess [("A", 1)])
+      , expectFailBecause "#9467" $ runTest $ mkTest db11s "baseShim7-simple" ["A"] (solverSuccess [("A", 1)])
+      , runTest $ mkTest db11s2 "baseShim8" ["A"] (solverSuccess [("A", 1)])
       ]
   , testGroup
       "Base and non-reinstallable"
@@ -1325,6 +1329,61 @@ db12 =
       , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2]
       ]
 
+-- | A version of db12 where the dependency on base happens via a setup dependency
+--
+-- * The setup dependency is solved in it's own qualified scope, so should be solved
+-- independently of the rest of the build plan.
+--
+-- * The setup dependency depends on `base-3` and hence `syb1`
+--
+-- * A depends on `base-4` and `syb-2`, should be fine as the setup stanza should
+-- be solved independently.
+db12s :: ExampleDb
+db12s =
+  let base3 = exInst "base" 3 "base-3-inst" [base4, syb1]
+      base4 = exInst "base" 4 "base-4-inst" []
+      syb1 = exInst "syb" 1 "syb-1-inst" [base4]
+   in [ Left base3
+      , Left base4
+      , Left syb1
+      , Right $ exAv "syb" 2 [ExFix "base" 4]
+      , Right $
+          exAv "A" 1 [ExFix "base" 4, ExFix "syb" 2]
+            `withSetupDeps` [ExFix "base" 3]
+      ]
+
+-- | A version of db11 where the dependency on base happens via a setup dependency
+--
+-- * The setup dependency is solved in it's own qualified scope, so should be solved
+-- independently of the rest of the build plan.
+--
+-- * The setup dependency depends on `base-3`
+--
+-- * A depends on `base-4`, should be fine as the setup stanza should
+-- be solved independently.
+db11s :: ExampleDb
+db11s =
+  let base3 = exInst "base" 3 "base-3-inst" [base4]
+      base4 = exInst "base" 4 "base-4-inst" []
+   in [ Left base3
+      , Left base4
+      , Right $
+          exAv "A" 1 [ExFix "base" 4]
+            `withSetupDeps` [ExFix "base" 3]
+      ]
+
+-- Works without the base-shimness, choosing different versions of base
+db11s2 :: ExampleDb
+db11s2 =
+  let base3 = exInst "base" 3 "base-3-inst" []
+      base4 = exInst "base" 4 "base-4-inst" []
+   in [ Left base3
+      , Left base4
+      , Right $
+          exAv "A" 1 [ExFix "base" 4]
+            `withSetupDeps` [ExFix "base" 3]
+      ]
+
 dbBase :: ExampleDb
 dbBase =
   [ Right $
-- 
2.11.4.GIT