Fix construction of conflict sets during check for single instance restriction (maybe)

cabal-install/Distribution/Client/Dependency/Modular/Preference.hs

@@ -23,7 +23,6 @@ import qualified Data.Map as M
 import Data.Monoid
 import Control.Applicative
 #endif
-import qualified Data.Set as S
 import Prelude hiding (sequence)
 import Control.Monad.Reader hiding (sequence)
 import Data.Map (Map)
@@ -373,13 +372,13 @@ enforceSingleInstanceRestriction = (`runReader` M.empty) . cata go
 
     -- We just verify package choices.
     go (PChoiceF qpn gr cs) =
-      PChoice qpn gr <$> sequence (P.mapWithKey (goP qpn) cs)
+      PChoice qpn gr <$> sequence (P.mapWithKey (goP qpn gr) cs)
     go _otherwise =
       innM _otherwise
 
     -- The check proper
-    goP :: QPN -> POption -> EnforceSIR (Tree QGoalReasonChain) -> EnforceSIR (Tree QGoalReasonChain)
-    goP qpn@(Q _ pn) (POption i linkedTo) r = do
+    goP :: QPN -> QGoalReasonChain -> POption -> EnforceSIR (Tree QGoalReasonChain) -> EnforceSIR (Tree QGoalReasonChain)
+    goP qpn@(Q _ pn) gr (POption i linkedTo) r = do
       let inst = PI pn i
       env <- ask
       case (linkedTo, M.lookup inst env) of
@@ -389,6 +388,6 @@ enforceSingleInstanceRestriction = (`runReader` M.empty) . cata go
         (Nothing, Nothing) ->
           -- Not linked, not already used
           local (M.insert inst qpn) r
-        (Nothing, Just qpn') -> do
+        (Nothing, Just _) -> do
           -- Not linked, already used. This is an error
-          return $ Fail (S.fromList [P qpn, P qpn']) MultipleInstances
+          return $ Fail (toConflictSet (Goal (P qpn) gr)) MultipleInstances

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs

@@ -119,6 +119,9 @@ tests = [
         , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (Just [("A", 1), ("B", 1), ("C", 1)])
         , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (Just [("A", 1), ("B", 2), ("C", 1)])
         ]
+    , testGroup "Independent goals" [
+          runTest $ indep $ mkTest db16 "indepGoals" ["A", "B"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
+        ]
     ]
   where
     indep test      = test { testIndepGoals = True }
@@ -460,6 +463,38 @@ db14 = [
   , Right $ exAv "E" 1 []
   ]
 
+-- | Check that the solver can backtrack after encountering the SIR
+--
+-- When A and B are installed as independent goals, the single instance
+-- restriction prevents B from depending on C.  This database tests that the
+-- solver can backtrack after encountering the single instance restriction and
+-- choose the only valid flag assignment (-flagA +flagB):
+--
+-- > flagA flagB  B depends on
+-- >  On    _     C-*
+-- >  Off   On    E-*               <-- only valid flag assignment
+-- >  Off   Off   D-2.0, C-*
+--
+-- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D,
+-- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have
+-- C in the transitive closure of B's dependencies, because that would mean we
+-- would need two instances of C: one built against D-1.0 and one built against
+-- D-2.0.
+db16 :: ExampleDb
+db16 = [
+    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
+  , Right $ exAv "B" 1 [ ExFix "D" 2
+                       , exFlag "flagA"
+                             [ExAny "C"]
+                             [exFlag "flagB"
+                                 [ExAny "E"]
+                                 [ExAny "C"]]]
+  , Right $ exAv "C" 1 [ExAny "D"]
+  , Right $ exAv "D" 1 []
+  , Right $ exAv "D" 2 []
+  , Right $ exAv "E" 1 []
+  ]
+
 dbExts1 :: ExampleDb
 dbExts1 = [
     Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)]