1{-# LANGUAGE OverloadedStrings #-}
2-- | This is a set of unit tests for the dependency solver,
3-- which uses the solver DSL ("UnitTests.Distribution.Solver.Modular.DSL")
4-- to more conveniently create package databases to run the solver tests on.
5module UnitTests.Distribution.Solver.Modular.Solver (tests)
6       where
7
8-- base
9import Data.List (isInfixOf)
10
11import qualified Distribution.Version as V
12
13-- test-framework
14import Test.Tasty as TF
15
16-- Cabal
17import Language.Haskell.Extension ( Extension(..)
18                                  , KnownExtension(..), Language(..))
19
20-- cabal-install
21import Distribution.Solver.Types.Flag
22import Distribution.Solver.Types.OptionalStanza
23import Distribution.Solver.Types.PackageConstraint
24import qualified Distribution.Solver.Types.PackagePath as P
25import UnitTests.Distribution.Solver.Modular.DSL
26import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
27
28tests :: [TF.TestTree]
29tests = [
30      testGroup "Simple dependencies" [
31          runTest $         mkTest db1 "alreadyInstalled"   ["A"]      (solverSuccess [])
32        , runTest $         mkTest db1 "installLatest"      ["B"]      (solverSuccess [("B", 2)])
33        , runTest $         mkTest db1 "simpleDep1"         ["C"]      (solverSuccess [("B", 1), ("C", 1)])
34        , runTest $         mkTest db1 "simpleDep2"         ["D"]      (solverSuccess [("B", 2), ("D", 1)])
35        , runTest $         mkTest db1 "failTwoVersions"    ["C", "D"] anySolverFailure
36        , runTest $ indep $ mkTest db1 "indepTwoVersions"   ["C", "D"] (solverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)])
37        , runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (solverSuccess [("B", 1), ("C", 1), ("E", 1)])
38        , runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (solverSuccess [("B", 2), ("D", 1), ("E", 1)])
39        , runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
40        , runTest $         mkTest db1 "buildDepAgainstOld" ["F"]      (solverSuccess [("B", 1), ("E", 1), ("F", 1)])
41        , runTest $         mkTest db1 "buildDepAgainstNew" ["G"]      (solverSuccess [("B", 2), ("E", 1), ("G", 1)])
42        , runTest $ indep $ mkTest db1 "multipleInstances"  ["F", "G"] anySolverFailure
43        , runTest $         mkTest db21 "unknownPackage1"   ["A"]      (solverSuccess [("A", 1), ("B", 1)])
44        , runTest $         mkTest db22 "unknownPackage2"   ["A"]      (solverFailure (isInfixOf "unknown package: C"))
45        , runTest $         mkTest db23 "unknownPackage3"   ["A"]      (solverFailure (isInfixOf "unknown package: B"))
46        , runTest $         mkTest []   "unknown target"    ["A"]      (solverFailure (isInfixOf "unknown package: A"))
47        ]
48    , testGroup "Flagged dependencies" [
49          runTest $         mkTest db3 "forceFlagOn"  ["C"]      (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
50        , runTest $         mkTest db3 "forceFlagOff" ["D"]      (solverSuccess [("A", 2), ("B", 1), ("D", 1)])
51        , runTest $ indep $ mkTest db3 "linkFlags1"   ["C", "D"] anySolverFailure
52        , runTest $ indep $ mkTest db4 "linkFlags2"   ["C", "D"] anySolverFailure
53        , runTest $ indep $ mkTest db18 "linkFlags3"  ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)])
54        ]
55    , testGroup "Lifting dependencies out of conditionals" [
56          runTest $ commonDependencyLogMessage "common dependency log message"
57        , runTest $ twoLevelDeepCommonDependencyLogMessage "two level deep common dependency log message"
58        , runTest $ testBackjumpingWithCommonDependency "backjumping with common dependency"
59        ]
60    , testGroup "Manual flags" [
61          runTest $ mkTest dbManualFlags "Use default value for manual flag" ["pkg"] $
62          solverSuccess [("pkg", 1), ("true-dep", 1)]
63
64        , let checkFullLog =
65                  any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)"
66          in runTest $ setVerbose $
67             constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $
68             mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $
69             -- TODO: We should check the summarized log instead of the full log
70             -- for the manual flags error message, but it currently only
71             -- appears in the full log.
72             SolverResult checkFullLog (Left $ const True)
73
74        , let cs = [ExFlagConstraint (ScopeAnyQualifier "pkg") "flag" False]
75          in runTest $ constraints cs $
76             mkTest dbManualFlags "Toggle manual flag with flag constraint" ["pkg"] $
77             solverSuccess [("false-dep", 1), ("pkg", 1)]
78        ]
79    , testGroup "Qualified manual flag constraints" [
80          let name = "Top-level flag constraint does not constrain setup dep's flag"
81              cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
82          in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
83             solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
84                           , ("b-1-false-dep", 1), ("b-2-true-dep", 1) ]
85
86        , let name = "Solver can toggle setup dep's flag to match top-level constraint"
87              cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False
88                   , ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion ]
89          in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
90             solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
91                           , ("b-1-false-dep", 1), ("b-2-false-dep", 1) ]
92
93        , let name = "User can constrain flags separately with qualified constraints"
94              cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel    "B") "flag" True
95                   , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ]
96          in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $
97             solverSuccess [ ("A", 1), ("B", 1), ("B", 2)
98                           , ("b-1-true-dep", 1), ("b-2-false-dep", 1) ]
99
100          -- Regression test for #4299
101        , let name = "Solver can link deps when only one has constrained manual flag"
102              cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
103          in runTest $ constraints cs $ mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
104             solverSuccess [ ("A", 1), ("B", 1), ("b-1-false-dep", 1) ]
105
106        , let name = "Solver cannot link deps that have conflicting manual flag constraints"
107              cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel    "B") "flag" True
108                   , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ]
109              failureReason = "(constraint from unknown source requires opposite flag selection)"
110              checkFullLog lns =
111                  all (\msg -> any (msg `isInfixOf`) lns)
112                  [ "rejecting: B:-flag "         ++ failureReason
113                  , "rejecting: A:setup.B:+flag " ++ failureReason ]
114          in runTest $ constraints cs $ setVerbose $
115             mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
116             SolverResult checkFullLog (Left $ const True)
117        ]
118    , testGroup "Stanzas" [
119          runTest $         enableAllTests $ mkTest db5 "simpleTest1" ["C"]      (solverSuccess [("A", 2), ("C", 1)])
120        , runTest $         enableAllTests $ mkTest db5 "simpleTest2" ["D"]      anySolverFailure
121        , runTest $         enableAllTests $ mkTest db5 "simpleTest3" ["E"]      (solverSuccess [("A", 1), ("E", 1)])
122        , runTest $         enableAllTests $ mkTest db5 "simpleTest4" ["F"]      anySolverFailure -- TODO
123        , runTest $         enableAllTests $ mkTest db5 "simpleTest5" ["G"]      (solverSuccess [("A", 2), ("G", 1)])
124        , runTest $         enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
125        , runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
126        , runTest $         enableAllTests $ mkTest db6 "depsWithTests1" ["C"]      (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
127        , runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
128        , runTest $ testTestSuiteWithFlag "test suite with flag"
129        ]
130    , testGroup "Setup dependencies" [
131          runTest $         mkTest db7  "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)])
132        , runTest $         mkTest db7  "setupDeps2" ["C"] (solverSuccess [("A", 2), ("C", 1)])
133        , runTest $         mkTest db7  "setupDeps3" ["D"] (solverSuccess [("A", 1), ("D", 1)])
134        , runTest $         mkTest db7  "setupDeps4" ["E"] (solverSuccess [("A", 1), ("A", 2), ("E", 1)])
135        , runTest $         mkTest db7  "setupDeps5" ["F"] (solverSuccess [("A", 1), ("A", 2), ("F", 1)])
136        , runTest $         mkTest db8  "setupDeps6" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
137        , runTest $         mkTest db9  "setupDeps7" ["F", "G"] (solverSuccess [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)])
138        , runTest $         mkTest db10 "setupDeps8" ["C"] (solverSuccess [("C", 1)])
139        , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
140        ]
141    , testGroup "Base shim" [
142          runTest $ mkTest db11 "baseShim1" ["A"] (solverSuccess [("A", 1)])
143        , runTest $ mkTest db12 "baseShim2" ["A"] (solverSuccess [("A", 1)])
144        , runTest $ mkTest db12 "baseShim3" ["B"] (solverSuccess [("B", 1)])
145        , runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
146        , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure
147        , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)])
148        ]
149    , testGroup "Base" [
150          runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $
151                      solverFailure (isInfixOf "only already installed instances can be used")
152        , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $
153                      solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)]
154        ]
155    , testGroup "reject-unconstrained" [
156          runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $
157            solverFailure (isInfixOf "not a user-provided goal")
158        , runTest $ onlyConstrained $ mkTest db12 "all goals" ["E", "syb"] $
159            solverSuccess [("E", 1), ("syb", 2)]
160        , runTest $ onlyConstrained $ mkTest db17 "backtracking" ["A", "B"] $
161            solverSuccess [("A", 2), ("B", 1)]
162        , runTest $ onlyConstrained $ mkTest db17 "failure message" ["A"] $
163            solverFailure $ isInfixOf $
164                  "Could not resolve dependencies:\n"
165               ++ "[__0] trying: A-3.0.0 (user goal)\n"
166               ++ "[__1] next goal: C (dependency of A)\n"
167               ++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, "
168                      ++ "but reject-unconstrained-dependencies was set)\n"
169               ++ "[__1] fail (backjumping, conflict set: A, C)\n"
170               ++ "After searching the rest of the dependency tree exhaustively, "
171                      ++ "these were the goals I've had most trouble fulfilling: A, C, B"
172        ]
173    , testGroup "Cycles" [
174          runTest $ mkTest db14 "simpleCycle1"          ["A"]      anySolverFailure
175        , runTest $ mkTest db14 "simpleCycle2"          ["A", "B"] anySolverFailure
176        , runTest $ mkTest db14 "cycleWithFlagChoice1"  ["C"]      (solverSuccess [("C", 1), ("E", 1)])
177        , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"]      anySolverFailure
178        , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"]      anySolverFailure
179        , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"]      (solverSuccess [("C", 2), ("D", 1)])
180        , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"]      (solverSuccess [("D", 1)])
181        , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"]      (solverSuccess [("C", 2), ("D", 1), ("E", 1)])
182        , runTest $ issue4161 "detect cycle between package and its setup script"
183        , runTest $ testCyclicDependencyErrorMessages "cyclic dependency error messages"
184        ]
185    , testGroup "Extensions" [
186          runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure
187        , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure
188        , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (solverSuccess [("A",1)])
189        , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (solverSuccess [("A",1),("B",1), ("C",1)])
190        , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure
191        , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure
192        , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (solverSuccess [("A",1),("B",1),("C",1),("E",1)])
193        ]
194    , testGroup "Languages" [
195          runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure
196        , runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (solverSuccess [("A",1)])
197        , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure
198        , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A",1),("B",1),("C",1)])
199        ]
200     , testGroup "Qualified Package Constraints" [
201          runTest $ mkTest dbConstraints "install latest versions without constraints" ["A", "B", "C"] $
202          solverSuccess [("A", 7), ("B", 8), ("C", 9), ("D", 7), ("D", 8), ("D", 9)]
203
204        , let cs = [ ExVersionConstraint (ScopeAnyQualifier "D") $ mkVersionRange 1 4 ]
205          in runTest $ constraints cs $
206             mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $
207             solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)]
208
209        , let cs = [ ExVersionConstraint (ScopeQualified P.QualToplevel    "D") $ mkVersionRange 1 4
210                   , ExVersionConstraint (ScopeQualified (P.QualSetup "B") "D") $ mkVersionRange 4 7
211                   ]
212          in runTest $ constraints cs $
213             mkTest dbConstraints "force multiple versions with qualified constraints" ["A", "B", "C"] $
214             solverSuccess [("A", 1), ("B", 5), ("C", 9), ("D", 1), ("D", 5), ("D", 9)]
215
216        , let cs = [ ExVersionConstraint (ScopeAnySetupQualifier "D") $ mkVersionRange 1 4 ]
217          in runTest $ constraints cs $
218             mkTest dbConstraints "constrain package across setup scripts" ["A", "B", "C"] $
219             solverSuccess [("A", 7), ("B", 2), ("C", 3), ("D", 2), ("D", 3), ("D", 7)]
220        ]
221     , testGroup "Package Preferences" [
222          runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1]      $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)])
223        , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)])
224        , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2
225                                , ExPkgPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)])
226        , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 1
227                                , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)])
228        , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
229                                , ExPkgPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)])
230        , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
231                                , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)])
232        ]
233     , testGroup "Stanza Preferences" [
234          runTest $
235          mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $
236          solverSuccess [("pkg", 1)]
237
238        , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
239          mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $
240          solverSuccess [("pkg", 1), ("test-dep", 1)]
241
242        , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
243          mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $
244          solverSuccess [("pkg", 1)]
245
246        , testStanzaPreference "test stanza preference"
247        ]
248     , testGroup "Buildable Field" [
249          testBuildable "avoid building component with unknown dependency" (ExAny "unknown")
250        , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown"))
251        , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown"))
252        , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
253        , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)])
254         ]
255    , testGroup "Pkg-config dependencies" [
256          runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] anySolverFailure
257        , runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] anySolverFailure
258        , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
259        , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (solverSuccess [("A", 1), ("B", 2), ("C", 1)])
260        ]
261    , testGroup "Independent goals" [
262          runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
263        , runTest $ testIndepGoals2 "indepGoals2"
264        , runTest $ testIndepGoals3 "indepGoals3"
265        , runTest $ testIndepGoals4 "indepGoals4"
266        , runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder
267        , runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder
268        , runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder
269        , runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder
270        ]
271      -- Tests designed for the backjumping blog post
272    , testGroup "Backjumping" [
273          runTest $         mkTest dbBJ1a "bj1a" ["A"]      (solverSuccess [("A", 1), ("B",  1)])
274        , runTest $         mkTest dbBJ1b "bj1b" ["A"]      (solverSuccess [("A", 1), ("B",  1)])
275        , runTest $         mkTest dbBJ1c "bj1c" ["A"]      (solverSuccess [("A", 1), ("B",  1)])
276        , runTest $         mkTest dbBJ2  "bj2"  ["A"]      (solverSuccess [("A", 1), ("B",  1), ("C", 1)])
277        , runTest $         mkTest dbBJ3  "bj3"  ["A"]      (solverSuccess [("A", 1), ("Ba", 1), ("C", 1)])
278        , runTest $         mkTest dbBJ4  "bj4"  ["A"]      (solverSuccess [("A", 1), ("B",  1), ("C", 1)])
279        , runTest $         mkTest dbBJ5  "bj5"  ["A"]      (solverSuccess [("A", 1), ("B",  1), ("D", 1)])
280        , runTest $         mkTest dbBJ6  "bj6"  ["A"]      (solverSuccess [("A", 1), ("B",  1)])
281        , runTest $         mkTest dbBJ7  "bj7"  ["A"]      (solverSuccess [("A", 1), ("B",  1), ("C", 1)])
282        , runTest $ indep $ mkTest dbBJ8  "bj8"  ["A", "B"] (solverSuccess [("A", 1), ("B",  1), ("C", 1)])
283        ]
284    , testGroup "library dependencies" [
285          let db = [Right $ exAvNoLibrary "A" 1 `withExe` ExExe "exe" []]
286          in runTest $ mkTest db "install build target without a library" ["A"] $
287             solverSuccess [("A", 1)]
288
289        , let db = [ Right $ exAv "A" 1 [ExAny "B"]
290                   , Right $ exAvNoLibrary "B" 1 `withExe` ExExe "exe" [] ]
291          in runTest $ mkTest db "reject build-depends dependency with no library" ["A"] $
292             solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)")
293
294        , let exe = ExExe "exe" []
295              db = [ Right $ exAv "A" 1 [ExAny "B"]
296                   , Right $ exAvNoLibrary "B" 2 `withExe` exe
297                   , Right $ exAv "B" 1 [] `withExe` exe ]
298          in runTest $ mkTest db "choose version of build-depends dependency that has a library" ["A"] $
299             solverSuccess [("A", 1), ("B", 1)]
300        ]
301    -- build-tool-depends dependencies
302    , testGroup "build-tool-depends" [
303          runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)])
304
305        , runTest $ disableSolveExecutables $
306          mkTest dbBuildTools "don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
307
308        , runTest $ mkTest dbBuildTools "flagged exe dependency" ["B"] (solverSuccess [("B", 1), ("bt-pkg", 2)])
309
310        , runTest $ enableAllTests $
311          mkTest dbBuildTools "test suite exe dependency" ["C"] (solverSuccess [("C", 1), ("bt-pkg", 2)])
312
313        , runTest $ mkTest dbBuildTools "unknown exe" ["D"] $
314          solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by D")
315
316        , runTest $ disableSolveExecutables $
317          mkTest dbBuildTools "don't check for build tool executables in legacy mode" ["D"] $ solverSuccess [("D", 1)]
318
319        , runTest $ mkTest dbBuildTools "unknown build tools package error mentions package, not exe" ["E"] $
320          solverFailure (isInfixOf "unknown package: E:unknown-pkg:exe.unknown-pkg (dependency of E)")
321
322        , runTest $ mkTest dbBuildTools "unknown flagged exe" ["F"] $
323          solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by F +flagF")
324
325        , runTest $ enableAllTests $ mkTest dbBuildTools "unknown test suite exe" ["G"] $
326          solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by G *test")
327
328        , runTest $ mkTest dbBuildTools "wrong exe for build tool package version" ["H"] $
329          solverFailure $ isInfixOf $
330              -- The solver reports the version conflict when a version conflict
331              -- and an executable conflict apply to the same package version.
332              "[__1] rejecting: H:bt-pkg:exe.bt-pkg-4.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)\n"
333           ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-3.0.0 (does not contain executable 'exe1', which is required by H)\n"
334           ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-2.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)"
335
336        , runTest $ chooseExeAfterBuildToolsPackage True "choose exe after choosing its package - success"
337
338        , runTest $ chooseExeAfterBuildToolsPackage False "choose exe after choosing its package - failure"
339
340        , runTest $ rejectInstalledBuildToolPackage "reject installed package for build-tool dependency"
341
342        , runTest $ requireConsistentBuildToolVersions "build tool versions must be consistent within one package"
343    ]
344    -- build-tools dependencies
345    , testGroup "legacy build-tools" [
346          runTest $ mkTest dbLegacyBuildTools1 "bt1" ["A"] (solverSuccess [("A", 1), ("alex", 1)])
347
348        , runTest $ disableSolveExecutables $
349          mkTest dbLegacyBuildTools1 "bt1 - don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
350
351        , runTest $ mkTest dbLegacyBuildTools2 "bt2" ["A"] $
352          solverFailure (isInfixOf "does not contain executable 'alex', which is required by A")
353
354        , runTest $ disableSolveExecutables $
355          mkTest dbLegacyBuildTools2 "bt2 - don't check for build tool executables in legacy mode" ["A"] (solverSuccess [("A", 1)])
356
357        , runTest $ mkTest dbLegacyBuildTools3 "bt3" ["A"] (solverSuccess [("A", 1)])
358
359        , runTest $ mkTest dbLegacyBuildTools4 "bt4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)])
360
361        , runTest $ mkTest dbLegacyBuildTools5 "bt5" ["B"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)])
362
363        , runTest $ mkTest dbLegacyBuildTools6 "bt6" ["A"] (solverSuccess [("A", 1), ("alex", 1), ("happy", 1)])
364        ]
365      -- internal dependencies
366    , testGroup "internal dependencies" [
367          runTest $ mkTest dbIssue3775 "issue #3775" ["B"] (solverSuccess [("A", 2), ("B", 2), ("warp", 1)])
368        ]
369      -- tests for partial fix for issue #5325
370    , testGroup "Components that are unbuildable in the current environment" $
371      let flagConstraint = ExFlagConstraint . ScopeAnyQualifier
372      in [
373          let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ]
374          in runTest $ constraints [flagConstraint "A" "build-lib" False] $
375             mkTest db "install unbuildable library" ["A"] $
376             solverSuccess [("A", 1)]
377
378        , let db = [ Right $ exAvNoLibrary "A" 1
379                       `withExe` ExExe "exe" [ExFlagged "build-exe" (Buildable []) NotBuildable] ]
380          in runTest $ constraints [flagConstraint "A" "build-exe" False] $
381             mkTest db "install unbuildable exe" ["A"] $
382             solverSuccess [("A", 1)]
383
384        , let db = [ Right $ exAv "A" 1 [ExAny "B"]
385                   , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ]
386          in runTest $ constraints [flagConstraint "B" "build-lib" False] $
387             mkTest db "reject library dependency with unbuildable library" ["A"] $
388             solverFailure $ isInfixOf $
389                   "rejecting: B-1.0.0 (library is not buildable in the "
390                ++ "current environment, but it is required by A)"
391
392        , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
393                   , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable]
394                       `withExe` ExExe "bt" [] ]
395          in runTest $ constraints [flagConstraint "B" "build-lib" False] $
396             mkTest db "allow build-tool dependency with unbuildable library" ["A"] $
397             solverSuccess [("A", 1), ("B", 1)]
398
399        , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
400                   , Right $ exAv "B" 1 []
401                       `withExe` ExExe "bt" [ExFlagged "build-exe" (Buildable []) NotBuildable] ]
402          in runTest $ constraints [flagConstraint "B" "build-exe" False] $
403             mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $
404             solverFailure $ isInfixOf $
405                   "rejecting: A:B:exe.B-1.0.0 (executable 'bt' is not "
406                ++ "buildable in the current environment, but it is required by A)"
407        , runTest $
408          chooseUnbuildableExeAfterBuildToolsPackage
409          "choose unbuildable exe after choosing its package"
410        ]
411
412    , testGroup "--fine-grained-conflicts" [
413
414          -- Skipping a version because of a problematic dependency:
415          --
416          -- When the solver explores A-4, it finds that it cannot satisfy B's
417          -- dependencies. This allows the solver to skip the subsequent
418          -- versions of A that also depend on B.
419          runTest $
420              let db = [
421                      Right $ exAv "A" 4 [ExAny "B"]
422                    , Right $ exAv "A" 3 [ExAny "B"]
423                    , Right $ exAv "A" 2 [ExAny "B"]
424                    , Right $ exAv "A" 1 []
425                    , Right $ exAv "B" 2 [ExAny "unknown1"]
426                    , Right $ exAv "B" 1 [ExAny "unknown2"]
427                    ]
428                  msg = [
429                      "[__0] trying: A-4.0.0 (user goal)"
430                    , "[__1] trying: B-2.0.0 (dependency of A)"
431                    , "[__2] unknown package: unknown1 (dependency of B)"
432                    , "[__2] fail (backjumping, conflict set: B, unknown1)"
433                    , "[__1] trying: B-1.0.0"
434                    , "[__2] unknown package: unknown2 (dependency of B)"
435                    , "[__2] fail (backjumping, conflict set: B, unknown2)"
436                    , "[__1] fail (backjumping, conflict set: A, B, unknown1, unknown2)"
437                    , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that "
438                       ++ "caused the previous version to fail: depends on 'B')"
439                    , "[__0] trying: A-1.0.0"
440                    , "[__1] done"
441                    ]
442              in setVerbose $
443                 mkTest db "skip version due to problematic dependency" ["A"] $
444                 SolverResult (isInfixOf msg) $ Right [("A", 1)]
445
446        , -- Skipping a version because of a restrictive constraint on a
447          -- dependency:
448          --
449          -- The solver rejects A-4 because its constraint on B excludes B-1.
450          -- Then the solver is able to skip A-3 and A-2 because they also
451          -- exclude B-1, even though they don't have the exact same constraints
452          -- on B.
453          runTest $
454              let db = [
455                      Right $ exAv "A" 4 [ExFix "B" 14]
456                    , Right $ exAv "A" 3 [ExFix "B" 13]
457                    , Right $ exAv "A" 2 [ExFix "B" 12]
458                    , Right $ exAv "A" 1 [ExFix "B" 11]
459                    , Right $ exAv "B" 11 []
460                    ]
461                  msg = [
462                      "[__0] trying: A-4.0.0 (user goal)"
463                    , "[__1] next goal: B (dependency of A)"
464                    , "[__1] rejecting: B-11.0.0 (conflict: A => B==14.0.0)"
465                    , "[__1] fail (backjumping, conflict set: A, B)"
466                    , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that "
467                       ++ "caused the previous version to fail: depends on 'B' but excludes "
468                       ++ "version 11.0.0)"
469                    , "[__0] trying: A-1.0.0"
470                    , "[__1] next goal: B (dependency of A)"
471                    , "[__1] trying: B-11.0.0"
472                    , "[__2] done"
473                    ]
474              in setVerbose $
475                 mkTest db "skip version due to restrictive constraint on its dependency" ["A"] $
476                 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 11)]
477
478        , -- This test tests the case where the solver chooses a version for one
479          -- package, B, before choosing a version for one of its reverse
480          -- dependencies, C. While the solver is exploring the subtree rooted
481          -- at B-3, it finds that C-2's dependency on B conflicts with B-3.
482          -- Then the solver is able to skip C-1, because it also excludes B-3.
483          --
484          -- --fine-grained-conflicts could have a benefit in this case even
485          -- though the solver would have found the conflict between B-3 and C-1
486          -- immediately after trying C-1 anyway. It prevents C-1 from
487          -- introducing any other conflicts which could increase the size of
488          -- the conflict set.
489          runTest $
490              let db = [
491                      Right $ exAv "A" 1 [ExAny "B", ExAny "C"]
492                    , Right $ exAv "B" 3 []
493                    , Right $ exAv "B" 2 []
494                    , Right $ exAv "B" 1 []
495                    , Right $ exAv "C" 2 [ExFix "B" 2]
496                    , Right $ exAv "C" 1 [ExFix "B" 1]
497                    ]
498                  goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
499                  expectedMsg = [
500                      "[__0] trying: A-1.0.0 (user goal)"
501                    , "[__1] trying: B-3.0.0 (dependency of A)"
502                    , "[__2] next goal: C (dependency of A)"
503                    , "[__2] rejecting: C-2.0.0 (conflict: B==3.0.0, C => B==2.0.0)"
504                    , "[__2] skipping: C-1.0.0 (has the same characteristics that caused the "
505                       ++ "previous version to fail: excludes 'B' version 3.0.0)"
506                    , "[__2] fail (backjumping, conflict set: A, B, C)"
507                    , "[__1] trying: B-2.0.0"
508                    , "[__2] next goal: C (dependency of A)"
509                    , "[__2] trying: C-2.0.0"
510                    , "[__3] done"
511                    ]
512              in setVerbose $ goalOrder goals $
513                 mkTest db "skip version that excludes dependency that was already chosen" ["A"] $
514                 SolverResult (isInfixOf expectedMsg) $ Right [("A", 1), ("B", 2), ("C", 2)]
515
516        , -- This test tests how the solver merges conflicts when it has
517          -- multiple reasons to add a variable to the conflict set. In this
518          -- case, package A conflicts with B and C. The solver should take the
519          -- union of the conflicts and then only skip a version if it does not
520          -- resolve any of the conflicts.
521          --
522          -- The solver rejects A-3 because it can't find consistent versions for
523          -- its two dependencies, B and C. Then it skips A-2 because A-2 also
524          -- depends on B and C. This test ensures that the solver considers
525          -- A-1 even though A-1 only resolves one of the conflicts (A-1 removes
526          -- the dependency on C).
527          runTest $
528              let db = [
529                      Right $ exAv "A" 3 [ExAny "B", ExAny "C"]
530                    , Right $ exAv "A" 2 [ExAny "B", ExAny "C"]
531                    , Right $ exAv "A" 1 [ExAny "B"]
532                    , Right $ exAv "B" 1 [ExFix "D" 1]
533                    , Right $ exAv "C" 1 [ExFix "D" 2]
534                    , Right $ exAv "D" 1 []
535                    , Right $ exAv "D" 2 []
536                    ]
537                  goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
538                  msg = [
539                      "[__0] trying: A-3.0.0 (user goal)"
540                    , "[__1] trying: B-1.0.0 (dependency of A)"
541                    , "[__2] trying: C-1.0.0 (dependency of A)"
542                    , "[__3] next goal: D (dependency of B)"
543                    , "[__3] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
544                    , "[__3] rejecting: D-1.0.0 (conflict: C => D==2.0.0)"
545                    , "[__3] fail (backjumping, conflict set: B, C, D)"
546                    , "[__2] fail (backjumping, conflict set: A, B, C, D)"
547                    , "[__1] fail (backjumping, conflict set: A, B, C, D)"
548                    , "[__0] skipping: A-2.0.0 (has the same characteristics that caused the "
549                       ++ "previous version to fail: depends on 'B'; depends on 'C')"
550                    , "[__0] trying: A-1.0.0"
551                    , "[__1] trying: B-1.0.0 (dependency of A)"
552                    , "[__2] next goal: D (dependency of B)"
553                    , "[__2] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
554                    , "[__2] trying: D-1.0.0"
555                    , "[__3] done"
556                    ]
557              in setVerbose $ goalOrder goals $
558                 mkTest db "only skip a version if it resolves none of the previous conflicts" ["A"] $
559                 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1), ("D", 1)]
560
561        , -- This test ensures that the solver log doesn't show all conflicts
562          -- that the solver encountered in a subtree. The solver should only
563          -- show the conflicts that are contained in the current conflict set.
564          --
565          -- The goal order forces the solver to try A-4, encounter a conflict
566          -- with B-2, try B-1, and then try C. A-4 conflicts with the only
567          -- version of C, so the solver backjumps with a conflict set of
568          -- {A, C}. When the solver skips the next version of A, the log should
569          -- mention the conflict with C but not B.
570          runTest $
571              let db = [
572                      Right $ exAv "A" 4 [ExFix "B" 1, ExFix "C" 1]
573                    , Right $ exAv "A" 3 [ExFix "B" 1, ExFix "C" 1]
574                    , Right $ exAv "A" 2 [ExFix "C" 1]
575                    , Right $ exAv "A" 1 [ExFix "C" 2]
576                    , Right $ exAv "B" 2 []
577                    , Right $ exAv "B" 1 []
578                    , Right $ exAv "C" 2 []
579                    ]
580                  goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
581                  msg = [
582                      "[__0] trying: A-4.0.0 (user goal)"
583                    , "[__1] next goal: B (dependency of A)"
584                    , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
585                    , "[__1] trying: B-1.0.0"
586                    , "[__2] next goal: C (dependency of A)"
587                    , "[__2] rejecting: C-2.0.0 (conflict: A => C==1.0.0)"
588                    , "[__2] fail (backjumping, conflict set: A, C)"
589                    , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that caused the "
590                       ++ "previous version to fail: depends on 'C' but excludes version 2.0.0)"
591                    , "[__0] trying: A-1.0.0"
592                    , "[__1] next goal: C (dependency of A)"
593                    , "[__1] trying: C-2.0.0"
594                    , "[__2] done"
595                    ]
596              in setVerbose $ goalOrder goals $
597                 mkTest db "don't show conflicts that aren't part of the conflict set" ["A"] $
598                 SolverResult (isInfixOf msg) $ Right [("A", 1), ("C", 2)]
599
600        , -- Tests that the conflict set is properly updated when a version is
601          -- skipped due to being excluded by one of its reverse dependencies'
602          -- constraints.
603          runTest $
604              let db = [
605                      Right $ exAv "A" 2 [ExFix "B" 3]
606                    , Right $ exAv "A" 1 [ExFix "B" 1]
607                    , Right $ exAv "B" 2 []
608                    , Right $ exAv "B" 1 []
609                    ]
610                  msg = [
611                      "[__0] trying: A-2.0.0 (user goal)"
612                    , "[__1] next goal: B (dependency of A)"
613
614                      -- During this step, the solver adds A and B to the
615                      -- conflict set, with the details of each package's
616                      -- conflict:
617                      --
618                      -- A: A's constraint rejected B-2.
619                      -- B: B was rejected by A's B==3 constraint
620                    , "[__1] rejecting: B-2.0.0 (conflict: A => B==3.0.0)"
621
622                      -- When the solver skips B-1, it cannot simply reuse the
623                      -- previous conflict set. It also needs to update A's
624                      -- entry to say that A also rejected B-1. Otherwise, the
625                      -- solver wouldn't know that A-1 could resolve one of
626                      -- the conflicts encountered while exploring A-2. The
627                      -- solver would skip A-1, even though it leads to the
628                      -- solution.
629                    , "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
630                       ++ "the previous version to fail: excluded by constraint '==3.0.0' from 'A')"
631
632                    , "[__1] fail (backjumping, conflict set: A, B)"
633                    , "[__0] trying: A-1.0.0"
634                    , "[__1] next goal: B (dependency of A)"
635                    , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
636                    , "[__1] trying: B-1.0.0"
637                    , "[__2] done"
638                    ]
639              in setVerbose $
640                 mkTest db "update conflict set after skipping version - 1" ["A"] $
641                 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)]
642
643        , -- Tests that the conflict set is properly updated when a version is
644          -- skipped due to excluding a version of one of its dependencies.
645          -- This test is similar the previous one, with the goal order reversed.
646          runTest $
647              let db = [
648                      Right $ exAv "A" 2 []
649                    , Right $ exAv "A" 1 []
650                    , Right $ exAv "B" 2 [ExFix "A" 3]
651                    , Right $ exAv "B" 1 [ExFix "A" 1]
652                    ]
653                  goals = [P QualNone pkg | pkg <- ["A", "B"]]
654                  msg = [
655                      "[__0] trying: A-2.0.0 (user goal)"
656                    , "[__1] next goal: B (user goal)"
657                    , "[__1] rejecting: B-2.0.0 (conflict: A==2.0.0, B => A==3.0.0)"
658                    , "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
659                       ++ "the previous version to fail: excludes 'A' version 2.0.0)"
660                    , "[__1] fail (backjumping, conflict set: A, B)"
661                    , "[__0] trying: A-1.0.0"
662                    , "[__1] next goal: B (user goal)"
663                    , "[__1] rejecting: B-2.0.0 (conflict: A==1.0.0, B => A==3.0.0)"
664                    , "[__1] trying: B-1.0.0"
665                    , "[__2] done"
666                    ]
667              in setVerbose $ goalOrder goals $
668                 mkTest db "update conflict set after skipping version - 2" ["A", "B"] $
669                 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)]
670        ]
671      -- Tests for the contents of the solver's log
672    , testGroup "Solver log" [
673          -- See issue #3203. The solver should only choose a version for A once.
674          runTest $
675              let db = [Right $ exAv "A" 1 []]
676
677                  p :: [String] -> Bool
678                  p lg =    elem "targets: A" lg
679                         && length (filter ("trying: A" `isInfixOf`) lg) == 1
680              in setVerbose $ mkTest db "deduplicate targets" ["A", "A"] $
681                 SolverResult p $ Right [("A", 1)]
682        , runTest $
683              let db = [Right $ exAv "A" 1 [ExAny "B"]]
684                  msg = "After searching the rest of the dependency tree exhaustively, "
685                     ++ "these were the goals I've had most trouble fulfilling: A, B"
686              in mkTest db "exhaustive search failure message" ["A"] $
687                 solverFailure (isInfixOf msg)
688        , testSummarizedLog "show conflicts from final conflict set after exhaustive search" Nothing $
689                "Could not resolve dependencies:\n"
690             ++ "[__0] trying: A-1.0.0 (user goal)\n"
691             ++ "[__1] unknown package: F (dependency of A)\n"
692             ++ "[__1] fail (backjumping, conflict set: A, F)\n"
693             ++ "After searching the rest of the dependency tree exhaustively, "
694             ++ "these were the goals I've had most trouble fulfilling: A, F"
695        , testSummarizedLog "show first conflicts after inexhaustive search" (Just 3) $
696                "Could not resolve dependencies:\n"
697             ++ "[__0] trying: A-1.0.0 (user goal)\n"
698             ++ "[__1] trying: B-3.0.0 (dependency of A)\n"
699             ++ "[__2] unknown package: C (dependency of B)\n"
700             ++ "[__2] fail (backjumping, conflict set: B, C)\n"
701             ++ "Backjump limit reached (currently 3, change with --max-backjumps "
702             ++ "or try to run with --reorder-goals).\n"
703        , testSummarizedLog "don't show summarized log when backjump limit is too low" (Just 1) $
704                "Backjump limit reached (currently 1, change with --max-backjumps "
705             ++ "or try to run with --reorder-goals).\n"
706             ++ "Failed to generate a summarized dependency solver log due to low backjump limit."
707        , testMinimizeConflictSet
708              "minimize conflict set with --minimize-conflict-set"
709        , testNoMinimizeConflictSet
710              "show original conflict set with --no-minimize-conflict-set"
711        , runTest $
712              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
713                       , Left $ exInst "other-package" 2 "other-package-2.0.0" []]
714                  msg = "rejecting: other-package-2.0.0/installed-2.0.0"
715              in mkTest db "show full installed package version (issue #5892)" ["my-package"] $
716                 solverFailure (isInfixOf msg)
717        , runTest $
718              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
719                       , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] ]
720                  msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789"
721              in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $
722                 solverFailure (isInfixOf msg)
723        ]
724    ]
725  where
726    indep           = independentGoals
727    mkvrThis        = V.thisVersion . makeV
728    mkvrOrEarlier   = V.orEarlierVersion . makeV
729    makeV v         = V.mkVersion [v,0,0]
730
731data GoalOrder = FixedGoalOrder | DefaultGoalOrder
732
733{-------------------------------------------------------------------------------
734  Specific example database for the tests
735-------------------------------------------------------------------------------}
736
737db1 :: ExampleDb
738db1 =
739    let a = exInst "A" 1 "A-1" []
740    in [ Left a
741       , Right $ exAv "B" 1 [ExAny "A"]
742       , Right $ exAv "B" 2 [ExAny "A"]
743       , Right $ exAv "C" 1 [ExFix "B" 1]
744       , Right $ exAv "D" 1 [ExFix "B" 2]
745       , Right $ exAv "E" 1 [ExAny "B"]
746       , Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"]
747       , Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"]
748       , Right $ exAv "Z" 1 []
749       ]
750
751-- In this example, we _can_ install C and D as independent goals, but we have
752-- to pick two different versions for B (arbitrarily)
753db2 :: ExampleDb
754db2 = [
755    Right $ exAv "A" 1 []
756  , Right $ exAv "A" 2 []
757  , Right $ exAv "B" 1 [ExAny "A"]
758  , Right $ exAv "B" 2 [ExAny "A"]
759  , Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1]
760  , Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2]
761  ]
762
763db3 :: ExampleDb
764db3 = [
765     Right $ exAv "A" 1 []
766   , Right $ exAv "A" 2 []
767   , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "A" 1] [ExFix "A" 2]]
768   , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
769   , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"]
770   ]
771
772-- | Like db3, but the flag picks a different package rather than a
773-- different package version
774--
775-- In db3 we cannot install C and D as independent goals because:
776--
777-- * The multiple instance restriction says C and D _must_ share B
778-- * Since C relies on A-1, C needs B to be compiled with flagB on
779-- * Since D relies on A-2, D needs B to be compiled with flagB off
780-- * Hence C and D have incompatible requirements on B's flags.
781--
782-- However, _even_ if we don't check explicitly that we pick the same flag
783-- assignment for 0.B and 1.B, we will still detect the problem because
784-- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to
785-- 1.A and therefore we cannot link 0.B to 1.B.
786--
787-- In db4 the situation however is trickier. We again cannot install
788-- packages C and D as independent goals because:
789--
790-- * As above, the multiple instance restriction says that C and D _must_ share B
791-- * Since C relies on Ax-2, it requires B to be compiled with flagB off
792-- * Since D relies on Ay-2, it requires B to be compiled with flagB on
793-- * Hence C and D have incompatible requirements on B's flags.
794--
795-- But now this requirement is more indirect. If we only check dependencies
796-- we don't see the problem:
797--
798-- * We link 0.B to 1.B
799-- * 0.B relies on Ay-1
800-- * 1.B relies on Ax-1
801--
802-- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since
803-- we only ever assign to one of these, these constraints are never broken.
804db4 :: ExampleDb
805db4 = [
806     Right $ exAv "Ax" 1 []
807   , Right $ exAv "Ax" 2 []
808   , Right $ exAv "Ay" 1 []
809   , Right $ exAv "Ay" 2 []
810   , Right $ exAv "B"  1 [exFlagged "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]]
811   , Right $ exAv "C"  1 [ExFix "Ax" 2, ExAny "B"]
812   , Right $ exAv "D"  1 [ExFix "Ay" 2, ExAny "B"]
813   ]
814
815-- | Simple database containing one package with a manual flag.
816dbManualFlags :: ExampleDb
817dbManualFlags = [
818    Right $ declareFlags [ExFlag "flag" True Manual] $
819        exAv "pkg" 1 [exFlagged "flag" [ExAny "true-dep"] [ExAny "false-dep"]]
820  , Right $ exAv "true-dep"  1 []
821  , Right $ exAv "false-dep" 1 []
822  ]
823
824-- | Database containing a setup dependency with a manual flag. A's library and
825-- setup script depend on two different versions of B. B's manual flag can be
826-- set to different values in the two places where it is used.
827dbSetupDepWithManualFlag :: ExampleDb
828dbSetupDepWithManualFlag =
829  let bFlags = [ExFlag "flag" True Manual]
830  in [
831      Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 2]
832    , Right $ declareFlags bFlags $
833          exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"]
834                                       [ExAny "b-1-false-dep"]]
835    , Right $ declareFlags bFlags $
836          exAv "B" 2 [exFlagged "flag" [ExAny "b-2-true-dep"]
837                                       [ExAny "b-2-false-dep"]]
838    , Right $ exAv "b-1-true-dep"  1 []
839    , Right $ exAv "b-1-false-dep" 1 []
840    , Right $ exAv "b-2-true-dep"  1 []
841    , Right $ exAv "b-2-false-dep" 1 []
842    ]
843
844-- | A database similar to 'dbSetupDepWithManualFlag', except that the library
845-- and setup script both depend on B-1. B must be linked because of the Single
846-- Instance Restriction, and its flag can only have one value.
847dbLinkedSetupDepWithManualFlag :: ExampleDb
848dbLinkedSetupDepWithManualFlag = [
849    Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 1]
850  , Right $ declareFlags [ExFlag "flag" True Manual] $
851        exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"]
852                                     [ExAny "b-1-false-dep"]]
853  , Right $ exAv "b-1-true-dep"  1 []
854  , Right $ exAv "b-1-false-dep" 1 []
855  ]
856
857-- | Some tests involving testsuites
858--
859-- Note that in this test framework test suites are always enabled; if you
860-- want to test without test suites just set up a test database without
861-- test suites.
862--
863-- * C depends on A (through its test suite)
864-- * D depends on B-2 (through its test suite), but B-2 is unavailable
865-- * E depends on A-1 directly and on A through its test suite. We prefer
866--     to use A-1 for the test suite in this case.
867-- * F depends on A-1 directly and on A-2 through its test suite. In this
868--     case we currently fail to install F, although strictly speaking
869--     test suites should be considered independent goals.
870-- * G is like E, but for version A-2. This means that if we cannot install
871--     E and G together, unless we regard them as independent goals.
872db5 :: ExampleDb
873db5 = [
874    Right $ exAv "A" 1 []
875  , Right $ exAv "A" 2 []
876  , Right $ exAv "B" 1 []
877  , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"]
878  , Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2]
879  , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"]
880  , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2]
881  , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"]
882  ]
883
884-- Now the _dependencies_ have test suites
885--
886-- * Installing C is a simple example. C wants version 1 of A, but depends on
887--   B, and B's testsuite depends on an any version of A. In this case we prefer
888--   to link (if we don't regard test suites as independent goals then of course
889--   linking here doesn't even come into it).
890-- * Installing [C, D] means that we prefer to link B -- depending on how we
891--   set things up, this means that we should also link their test suites.
892db6 :: ExampleDb
893db6 = [
894    Right $ exAv "A" 1 []
895  , Right $ exAv "A" 2 []
896  , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"]
897  , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
898  , Right $ exAv "D" 1 [ExAny "B"]
899  ]
900
901-- | This test checks that the solver can backjump to disable a flag, even if
902-- the problematic dependency is also under a test suite. (issue #4390)
903--
904-- The goal order forces the solver to choose the flag before enabling testing.
905-- Previously, the solver couldn't handle this case, because it only tried to
906-- disable testing, and when that failed, it backjumped past the flag choice.
907-- The solver should also try to set the flag to false, because that avoids the
908-- dependency on B.
909testTestSuiteWithFlag :: String -> SolverTest
910testTestSuiteWithFlag name =
911    goalOrder goals $ enableAllTests $ mkTest db name ["A", "B"] $
912    solverSuccess [("A", 1), ("B", 1)]
913  where
914    db :: ExampleDb
915    db = [
916        Right $ exAv "A" 1 []
917          `withTest`
918            ExTest "test" [exFlagged "flag" [ExFix "B" 2] []]
919      , Right $ exAv "B" 1 []
920      ]
921
922    goals :: [ExampleVar]
923    goals = [
924        P QualNone "B"
925      , P QualNone "A"
926      , F QualNone "A" "flag"
927      , S QualNone "A" TestStanzas
928      ]
929
930-- Packages with setup dependencies
931--
932-- Install..
933-- * B: Simple example, just make sure setup deps are taken into account at all
934-- * C: Both the package and the setup script depend on any version of A.
935--      In this case we prefer to link
936-- * D: Variation on C.1 where the package requires a specific (not latest)
937--      version but the setup dependency is not fixed. Again, we prefer to
938--      link (picking the older version)
939-- * E: Variation on C.2 with the setup dependency the more inflexible.
940--      Currently, in this case we do not see the opportunity to link because
941--      we consider setup dependencies after normal dependencies; we will
942--      pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick
943--      A.1 instead. This isn't so easy to fix (if we want to fix it at all);
944--      in particular, considering setup dependencies _before_ other deps is
945--      not an improvement, because in general we would prefer to link setup
946--      setups to package deps, rather than the other way around. (For example,
947--      if we change this ordering then the test for D would start to install
948--      two versions of A).
949-- * F: The package and the setup script depend on different versions of A.
950--      This will only work if setup dependencies are considered independent.
951db7 :: ExampleDb
952db7 = [
953    Right $ exAv "A" 1 []
954  , Right $ exAv "A" 2 []
955  , Right $ exAv "B" 1 []            `withSetupDeps` [ExAny "A"]
956  , Right $ exAv "C" 1 [ExAny "A"  ] `withSetupDeps` [ExAny "A"  ]
957  , Right $ exAv "D" 1 [ExFix "A" 1] `withSetupDeps` [ExAny "A"  ]
958  , Right $ exAv "E" 1 [ExAny "A"  ] `withSetupDeps` [ExFix "A" 1]
959  , Right $ exAv "F" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
960  ]
961
962-- If we install C and D together (not as independent goals), we need to build
963-- both B.1 and B.2, both of which depend on A.
964db8 :: ExampleDb
965db8 = [
966    Right $ exAv "A" 1 []
967  , Right $ exAv "B" 1 [ExAny "A"]
968  , Right $ exAv "B" 2 [ExAny "A"]
969  , Right $ exAv "C" 1 [] `withSetupDeps` [ExFix "B" 1]
970  , Right $ exAv "D" 1 [] `withSetupDeps` [ExFix "B" 2]
971  ]
972
973-- Extended version of `db8` so that we have nested setup dependencies
974db9 :: ExampleDb
975db9 = db8 ++ [
976    Right $ exAv "E" 1 [ExAny "C"]
977  , Right $ exAv "E" 2 [ExAny "D"]
978  , Right $ exAv "F" 1 [] `withSetupDeps` [ExFix "E" 1]
979  , Right $ exAv "G" 1 [] `withSetupDeps` [ExFix "E" 2]
980  ]
981
982-- Multiple already-installed packages with inter-dependencies, and one package
983-- (C) that depends on package A-1 for its setup script and package A-2 as a
984-- library dependency.
985db10 :: ExampleDb
986db10 =
987  let rts         = exInst "rts"         1 "rts-inst"         []
988      ghc_prim    = exInst "ghc-prim"    1 "ghc-prim-inst"    [rts]
989      base        = exInst "base"        1 "base-inst"        [rts, ghc_prim]
990      a1          = exInst "A"           1 "A1-inst"          [base]
991      a2          = exInst "A"           2 "A2-inst"          [base]
992  in [
993      Left rts
994    , Left ghc_prim
995    , Left base
996    , Left a1
997    , Left a2
998    , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
999    ]
1000
1001-- | This database tests that a package's setup dependencies are correctly
1002-- linked when the package is linked. See pull request #3268.
1003--
1004-- When A and B are installed as independent goals, their dependencies on C must
1005-- be linked, due to the single instance restriction. Since C depends on D, 0.D
1006-- and 1.D must be linked. C also has a setup dependency on D, so 0.C-setup.D
1007-- and 1.C-setup.D must be linked. However, D's two link groups must remain
1008-- independent. The solver should be able to choose D-1 for C's library and D-2
1009-- for C's setup script.
1010dbSetupDeps :: ExampleDb
1011dbSetupDeps = [
1012    Right $ exAv "A" 1 [ExAny "C"]
1013  , Right $ exAv "B" 1 [ExAny "C"]
1014  , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2]
1015  , Right $ exAv "D" 1 []
1016  , Right $ exAv "D" 2 []
1017  ]
1018
1019-- | Tests for dealing with base shims
1020db11 :: ExampleDb
1021db11 =
1022  let base3 = exInst "base" 3 "base-3-inst" [base4]
1023      base4 = exInst "base" 4 "base-4-inst" []
1024  in [
1025      Left base3
1026    , Left base4
1027    , Right $ exAv "A" 1 [ExFix "base" 3]
1028    ]
1029
1030-- | Slightly more realistic version of db11 where base-3 depends on syb
1031-- This means that if a package depends on base-3 and on syb, then they MUST
1032-- share the version of syb
1033--
1034-- * Package A relies on base-3 (which relies on base-4)
1035-- * Package B relies on base-4
1036-- * Package C relies on both A and B
1037-- * Package D relies on base-3 and on syb-2, which is not possible because
1038--     base-3 has a dependency on syb-1 (non-inheritance of the Base qualifier)
1039-- * Package E relies on base-4 and on syb-2, which is fine.
1040db12 :: ExampleDb
1041db12 =
1042  let base3 = exInst "base" 3 "base-3-inst" [base4, syb1]
1043      base4 = exInst "base" 4 "base-4-inst" []
1044      syb1  = exInst "syb" 1 "syb-1-inst" [base4]
1045  in [
1046      Left base3
1047    , Left base4
1048    , Left syb1
1049    , Right $ exAv "syb" 2 [ExFix "base" 4]
1050    , Right $ exAv "A" 1 [ExFix "base" 3, ExAny "syb"]
1051    , Right $ exAv "B" 1 [ExFix "base" 4, ExAny "syb"]
1052    , Right $ exAv "C" 1 [ExAny "A", ExAny "B"]
1053    , Right $ exAv "D" 1 [ExFix "base" 3, ExFix "syb" 2]
1054    , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2]
1055    ]
1056
1057dbBase :: ExampleDb
1058dbBase = [
1059      Right $ exAv "base" 1
1060              [ExAny "ghc-prim", ExAny "integer-simple", ExAny "integer-gmp"]
1061    , Right $ exAv "ghc-prim" 1 []
1062    , Right $ exAv "integer-simple" 1 []
1063    , Right $ exAv "integer-gmp" 1 []
1064    ]
1065
1066db13 :: ExampleDb
1067db13 = [
1068    Right $ exAv "A" 1 []
1069  , Right $ exAv "A" 2 []
1070  , Right $ exAv "A" 3 []
1071  ]
1072
1073-- | A, B, and C have three different dependencies on D that can be set to
1074-- different versions with qualified constraints. Each version of D can only
1075-- be depended upon by one version of A, B, or C, so that the versions of A, B,
1076-- and C in the install plan indicate which version of D was chosen for each
1077-- dependency. The one-to-one correspondence between versions of A, B, and C and
1078-- versions of D also prevents linking, which would complicate the solver's
1079-- behavior.
1080dbConstraints :: ExampleDb
1081dbConstraints =
1082    [Right $ exAv "A" v [ExFix "D" v] | v <- [1, 4, 7]]
1083 ++ [Right $ exAv "B" v [] `withSetupDeps` [ExFix "D" v] | v <- [2, 5, 8]]
1084 ++ [Right $ exAv "C" v [] `withSetupDeps` [ExFix "D" v] | v <- [3, 6, 9]]
1085 ++ [Right $ exAv "D" v [] | v <- [1..9]]
1086
1087dbStanzaPreferences1 :: ExampleDb
1088dbStanzaPreferences1 = [
1089    Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "test-dep"]
1090  , Right $ exAv "test-dep" 1 []
1091  ]
1092
1093dbStanzaPreferences2 :: ExampleDb
1094dbStanzaPreferences2 = [
1095    Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "unknown"]
1096  ]
1097
1098-- | This is a test case for a bug in stanza preferences (#3930). The solver
1099-- should be able to install 'A' by enabling 'flag' and disabling testing. When
1100-- it tries goals in the specified order and prefers testing, it encounters
1101-- 'unknown-pkg2'. 'unknown-pkg2' is only introduced by testing and 'flag', so
1102-- the conflict set should contain both of those variables. Before the fix, it
1103-- only contained 'flag'. The solver backjumped past the choice to disable
1104-- testing and failed to find the solution.
1105testStanzaPreference :: String -> TestTree
1106testStanzaPreference name =
1107  let pkg = exAv "A" 1    [exFlagged "flag"
1108                              []
1109                              [ExAny "unknown-pkg1"]]
1110             `withTest`
1111            ExTest "test" [exFlagged "flag"
1112                              [ExAny "unknown-pkg2"]
1113                              []]
1114      goals = [
1115          P QualNone "A"
1116        , F QualNone "A" "flag"
1117        , S QualNone "A" TestStanzas
1118        ]
1119  in runTest $ goalOrder goals $
1120     preferences [ ExStanzaPref "A" [TestStanzas]] $
1121     mkTest [Right pkg] name ["A"] $
1122     solverSuccess [("A", 1)]
1123
1124-- | Database with some cycles
1125--
1126-- * Simplest non-trivial cycle: A -> B and B -> A
1127-- * There is a cycle C -> D -> C, but it can be broken by picking the
1128--   right flag assignment.
1129db14 :: ExampleDb
1130db14 = [
1131    Right $ exAv "A" 1 [ExAny "B"]
1132  , Right $ exAv "B" 1 [ExAny "A"]
1133  , Right $ exAv "C" 1 [exFlagged "flagC" [ExAny "D"] [ExAny "E"]]
1134  , Right $ exAv "D" 1 [ExAny "C"]
1135  , Right $ exAv "E" 1 []
1136  ]
1137
1138-- | Cycles through setup dependencies
1139--
1140-- The first cycle is unsolvable: package A has a setup dependency on B,
1141-- B has a regular dependency on A, and we only have a single version available
1142-- for both.
1143--
1144-- The second cycle can be broken by picking different versions: package C-2.0
1145-- has a setup dependency on D, and D has a regular dependency on C-*. However,
1146-- version C-1.0 is already available (perhaps it didn't have this setup dep).
1147-- Thus, we should be able to break this cycle even if we are installing package
1148-- E, which explicitly depends on C-2.0.
1149db15 :: ExampleDb
1150db15 = [
1151    -- First example (real cycle, no solution)
1152    Right $ exAv   "A" 1            []            `withSetupDeps` [ExAny "B"]
1153  , Right $ exAv   "B" 1            [ExAny "A"]
1154    -- Second example (cycle can be broken by picking versions carefully)
1155  , Left  $ exInst "C" 1 "C-1-inst" []
1156  , Right $ exAv   "C" 2            []            `withSetupDeps` [ExAny "D"]
1157  , Right $ exAv   "D" 1            [ExAny "C"  ]
1158  , Right $ exAv   "E" 1            [ExFix "C" 2]
1159  ]
1160
1161-- | Detect a cycle between a package and its setup script.
1162--
1163-- This type of cycle can easily occur when v2-build adds default setup
1164-- dependencies to packages without custom-setup stanzas. For example, cabal
1165-- adds 'time' as a setup dependency for 'time'. The solver should detect the
1166-- cycle when it attempts to link the setup and non-setup instances of the
1167-- package and then choose a different version for the setup dependency.
1168issue4161 :: String -> SolverTest
1169issue4161 name =
1170    setVerbose $ mkTest db name ["target"] $
1171    SolverResult checkFullLog $ Right [("target", 1), ("time", 1), ("time", 2)]
1172  where
1173    db :: ExampleDb
1174    db = [
1175        Right $ exAv "target" 1 [ExFix "time" 2]
1176      , Right $ exAv "time"   2 []               `withSetupDeps` [ExAny "time"]
1177      , Right $ exAv "time"   1 []
1178      ]
1179
1180    checkFullLog :: [String] -> Bool
1181    checkFullLog = any $ isInfixOf $
1182        "rejecting: time:setup.time~>time-2.0.0 (cyclic dependencies; "
1183                ++ "conflict set: time:setup.time)"
1184
1185-- | Packages pkg-A, pkg-B, and pkg-C form a cycle. The solver should backtrack
1186-- as soon as it chooses the last package in the cycle, to avoid searching parts
1187-- of the tree that have no solution. Since there is no way to break the cycle,
1188-- it should fail with an error message describing the cycle.
1189testCyclicDependencyErrorMessages :: String -> SolverTest
1190testCyclicDependencyErrorMessages name =
1191    goalOrder goals $
1192    mkTest db name ["pkg-A"] $
1193    SolverResult checkFullLog $ Left checkSummarizedLog
1194  where
1195    db :: ExampleDb
1196    db = [
1197        Right $ exAv "pkg-A" 1 [ExAny "pkg-B"]
1198      , Right $ exAv "pkg-B" 1 [ExAny "pkg-C"]
1199      , Right $ exAv "pkg-C" 1 [ExAny "pkg-A", ExAny "pkg-D"]
1200      , Right $ exAv "pkg-D" 1 [ExAny "pkg-E"]
1201      , Right $ exAv "pkg-E" 1 []
1202      ]
1203
1204    -- The solver should backtrack as soon as pkg-A, pkg-B, and pkg-C form a
1205    -- cycle. It shouldn't try pkg-D or pkg-E.
1206    checkFullLog :: [String] -> Bool
1207    checkFullLog =
1208        not . any (\l -> "pkg-D" `isInfixOf` l || "pkg-E" `isInfixOf` l)
1209
1210    checkSummarizedLog :: String -> Bool
1211    checkSummarizedLog =
1212        isInfixOf "rejecting: pkg-C-1.0.0 (cyclic dependencies; conflict set: pkg-A, pkg-B, pkg-C)"
1213
1214    -- Solve for pkg-D and pkg-E last.
1215    goals :: [ExampleVar]
1216    goals = [P QualNone ("pkg-" ++ [c]) | c <- ['A'..'E']]
1217
1218-- | Check that the solver can backtrack after encountering the SIR (issue #2843)
1219--
1220-- When A and B are installed as independent goals, the single instance
1221-- restriction prevents B from depending on C.  This database tests that the
1222-- solver can backtrack after encountering the single instance restriction and
1223-- choose the only valid flag assignment (-flagA +flagB):
1224--
1225-- > flagA flagB  B depends on
1226-- >  On    _     C-*
1227-- >  Off   On    E-*               <-- only valid flag assignment
1228-- >  Off   Off   D-2.0, C-*
1229--
1230-- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D,
1231-- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have
1232-- C in the transitive closure of B's dependencies, because that would mean we
1233-- would need two instances of C: one built against D-1.0 and one built against
1234-- D-2.0.
1235db16 :: ExampleDb
1236db16 = [
1237    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
1238  , Right $ exAv "B" 1 [ ExFix "D" 2
1239                       , exFlagged "flagA"
1240                             [ExAny "C"]
1241                             [exFlagged "flagB"
1242                                 [ExAny "E"]
1243                                 [ExAny "C"]]]
1244  , Right $ exAv "C" 1 [ExAny "D"]
1245  , Right $ exAv "D" 1 []
1246  , Right $ exAv "D" 2 []
1247  , Right $ exAv "E" 1 []
1248  ]
1249
1250
1251-- Try to get the solver to backtrack while satisfying
1252-- reject-unconstrained-dependencies: both the first and last versions of A
1253-- require packages outside the closed set, so it will have to try the
1254-- middle one.
1255db17 :: ExampleDb
1256db17 = [
1257    Right $ exAv "A" 1 [ExAny "C"]
1258  , Right $ exAv "A" 2 [ExAny "B"]
1259  , Right $ exAv "A" 3 [ExAny "C"]
1260  , Right $ exAv "B" 1 []
1261  , Right $ exAv "C" 1 [ExAny "B"]
1262  ]
1263
1264-- | This test checks that when the solver discovers a constraint on a
1265-- package's version after choosing to link that package, it can backtrack to
1266-- try alternative versions for the linked-to package. See pull request #3327.
1267--
1268-- When A and B are installed as independent goals, their dependencies on C
1269-- must be linked. Since C depends on D, A and B's dependencies on D must also
1270-- be linked. This test fixes the goal order so that the solver chooses D-2 for
1271-- both 0.D and 1.D before it encounters the test suites' constraints. The
1272-- solver must backtrack to try D-1 for both 0.D and 1.D.
1273testIndepGoals2 :: String -> SolverTest
1274testIndepGoals2 name =
1275    goalOrder goals $ independentGoals $
1276    enableAllTests $ mkTest db name ["A", "B"] $
1277    solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]
1278  where
1279    db :: ExampleDb
1280    db = [
1281        Right $ exAv "A" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
1282      , Right $ exAv "B" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
1283      , Right $ exAv "C" 1 [ExAny "D"]
1284      , Right $ exAv "D" 1 []
1285      , Right $ exAv "D" 2 []
1286      ]
1287
1288    goals :: [ExampleVar]
1289    goals = [
1290        P (QualIndep "A") "A"
1291      , P (QualIndep "A") "C"
1292      , P (QualIndep "A") "D"
1293      , P (QualIndep "B") "B"
1294      , P (QualIndep "B") "C"
1295      , P (QualIndep "B") "D"
1296      , S (QualIndep "B") "B" TestStanzas
1297      , S (QualIndep "A") "A" TestStanzas
1298      ]
1299
1300-- | Issue #2834
1301-- When both A and B are installed as independent goals, their dependencies on
1302-- C must be linked. The only combination of C's flags that is consistent with
1303-- A and B's dependencies on D is -flagA +flagB. This database tests that the
1304-- solver can backtrack to find the right combination of flags (requiring F, but
1305-- not E or G) and apply it to both 0.C and 1.C.
1306--
1307-- > flagA flagB  C depends on
1308-- >  On    _     D-1, E-*
1309-- >  Off   On    F-*        <-- Only valid choice
1310-- >  Off   Off   D-2, G-*
1311--
1312-- The single instance restriction means we cannot have one instance of C
1313-- built against D-1 and one instance built against D-2; since A depends on
1314-- D-1, and B depends on C-2, it is therefore important that C cannot depend
1315-- on any version of D.
1316db18 :: ExampleDb
1317db18 = [
1318    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
1319  , Right $ exAv "B" 1 [ExAny "C", ExFix "D" 2]
1320  , Right $ exAv "C" 1 [exFlagged "flagA"
1321                           [ExFix "D" 1, ExAny "E"]
1322                           [exFlagged "flagB"
1323                               [ExAny "F"]
1324                               [ExFix "D" 2, ExAny "G"]]]
1325  , Right $ exAv "D" 1 []
1326  , Right $ exAv "D" 2 []
1327  , Right $ exAv "E" 1 []
1328  , Right $ exAv "F" 1 []
1329  , Right $ exAv "G" 1 []
1330  ]
1331
1332-- | When both values for flagA introduce package B, the solver should be able
1333-- to choose B before choosing a value for flagA. It should try to choose a
1334-- version for B that is in the union of the version ranges required by +flagA
1335-- and -flagA.
1336commonDependencyLogMessage :: String -> SolverTest
1337commonDependencyLogMessage name =
1338    mkTest db name ["A"] $ solverFailure $ isInfixOf $
1339        "[__0] trying: A-1.0.0 (user goal)\n"
1340     ++ "[__1] next goal: B (dependency of A +/-flagA)\n"
1341     ++ "[__1] rejecting: B-2.0.0 (conflict: A +/-flagA => B==1.0.0 || ==3.0.0)"
1342  where
1343    db :: ExampleDb
1344    db = [
1345        Right $ exAv "A" 1 [exFlagged "flagA"
1346                               [ExFix "B" 1]
1347                               [ExFix "B" 3]]
1348      , Right $ exAv "B" 2 []
1349      ]
1350
1351-- | Test lifting dependencies out of multiple levels of conditionals.
1352twoLevelDeepCommonDependencyLogMessage :: String -> SolverTest
1353twoLevelDeepCommonDependencyLogMessage name =
1354    mkTest db name ["A"] $ solverFailure $ isInfixOf $
1355        "unknown package: B (dependency of A +/-flagA +/-flagB)"
1356  where
1357    db :: ExampleDb
1358    db = [
1359        Right $ exAv "A" 1 [exFlagged "flagA"
1360                               [exFlagged "flagB"
1361                                   [ExAny "B"]
1362                                   [ExAny "B"]]
1363                               [exFlagged "flagB"
1364                                   [ExAny "B"]
1365                                   [ExAny "B"]]]
1366      ]
1367
1368-- | Test handling nested conditionals that are controlled by the same flag.
1369-- The solver should treat flagA as introducing 'unknown' with value true, not
1370-- both true and false. That means that when +flagA causes a conflict, the
1371-- solver should try flipping flagA to false to resolve the conflict, rather
1372-- than backjumping past flagA.
1373testBackjumpingWithCommonDependency :: String -> SolverTest
1374testBackjumpingWithCommonDependency name =
1375    mkTest db name ["A"] $ solverSuccess [("A", 1), ("B", 1)]
1376  where
1377    db :: ExampleDb
1378    db = [
1379        Right $ exAv "A" 1 [exFlagged "flagA"
1380                               [exFlagged "flagA"
1381                                   [ExAny "unknown"]
1382                                   [ExAny "unknown"]]
1383                               [ExAny "B"]]
1384      , Right $ exAv "B" 1 []
1385      ]
1386
1387-- | Tricky test case with independent goals (issue #2842)
1388--
1389-- Suppose we are installing D, E, and F as independent goals:
1390--
1391-- * D depends on A-* and C-1, requiring A-1 to be built against C-1
1392-- * E depends on B-* and C-2, requiring B-1 to be built against C-2
1393-- * F depends on A-* and B-*; this means we need A-1 and B-1 both to be built
1394--     against the same version of C, violating the single instance restriction.
1395--
1396-- We can visualize this DB as:
1397--
1398-- >    C-1   C-2
1399-- >    /|\   /|\
1400-- >   / | \ / | \
1401-- >  /  |  X  |  \
1402-- > |   | / \ |   |
1403-- > |   |/   \|   |
1404-- > |   +     +   |
1405-- > |   |     |   |
1406-- > |   A     B   |
1407-- >  \  |\   /|  /
1408-- >   \ | \ / | /
1409-- >    \|  V  |/
1410-- >     D  F  E
1411testIndepGoals3 :: String -> SolverTest
1412testIndepGoals3 name =
1413    goalOrder goals $ independentGoals $
1414    mkTest db name ["D", "E", "F"] anySolverFailure
1415  where
1416    db :: ExampleDb
1417    db = [
1418        Right $ exAv "A" 1 [ExAny "C"]
1419      , Right $ exAv "B" 1 [ExAny "C"]
1420      , Right $ exAv "C" 1 []
1421      , Right $ exAv "C" 2 []
1422      , Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1]
1423      , Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2]
1424      , Right $ exAv "F" 1 [ExAny "A", ExAny "B"]
1425      ]
1426
1427    goals :: [ExampleVar]
1428    goals = [
1429        P (QualIndep "D") "D"
1430      , P (QualIndep "D") "C"
1431      , P (QualIndep "D") "A"
1432      , P (QualIndep "E") "E"
1433      , P (QualIndep "E") "C"
1434      , P (QualIndep "E") "B"
1435      , P (QualIndep "F") "F"
1436      , P (QualIndep "F") "B"
1437      , P (QualIndep "F") "C"
1438      , P (QualIndep "F") "A"
1439      ]
1440
1441-- | This test checks that the solver correctly backjumps when dependencies
1442-- of linked packages are not linked. It is an example where the conflict set
1443-- from enforcing the single instance restriction is not sufficient. See pull
1444-- request #3327.
1445--
1446-- When A, B, and C are installed as independent goals with the specified goal
1447-- order, the first choice that the solver makes for E is 0.E-2. Then, when it
1448-- chooses dependencies for B and C, it links both 1.E and 2.E to 0.E. Finally,
1449-- the solver discovers C's test's constraint on E. It must backtrack to try
1450-- 1.E-1 and then link 2.E to 1.E. Backjumping all the way to 0.E does not lead
1451-- to a solution, because 0.E's version is constrained by A and cannot be
1452-- changed.
1453testIndepGoals4 :: String -> SolverTest
1454testIndepGoals4 name =
1455    goalOrder goals $ independentGoals $
1456    enableAllTests $ mkTest db name ["A", "B", "C"] $
1457    solverSuccess [("A",1), ("B",1), ("C",1), ("D",1), ("E",1), ("E",2)]
1458  where
1459    db :: ExampleDb
1460    db = [
1461        Right $ exAv "A" 1 [ExFix "E" 2]
1462      , Right $ exAv "B" 1 [ExAny "D"]
1463      , Right $ exAv "C" 1 [ExAny "D"] `withTest` ExTest "test" [ExFix "E" 1]
1464      , Right $ exAv "D" 1 [ExAny "E"]
1465      , Right $ exAv "E" 1 []
1466      , Right $ exAv "E" 2 []
1467      ]
1468
1469    goals :: [ExampleVar]
1470    goals = [
1471        P (QualIndep "A") "A"
1472      , P (QualIndep "A") "E"
1473      , P (QualIndep "B") "B"
1474      , P (QualIndep "B") "D"
1475      , P (QualIndep "B") "E"
1476      , P (QualIndep "C") "C"
1477      , P (QualIndep "C") "D"
1478      , P (QualIndep "C") "E"
1479      , S (QualIndep "C") "C" TestStanzas
1480      ]
1481
1482-- | Test the trace messages that we get when a package refers to an unknown pkg
1483--
1484-- TODO: Currently we don't actually test the trace messages, and this particular
1485-- test still succeeds. The trace can only be verified by hand.
1486db21 :: ExampleDb
1487db21 = [
1488    Right $ exAv "A" 1 [ExAny "B"]
1489  , Right $ exAv "A" 2 [ExAny "C"] -- A-2.0 will be tried first, but C unknown
1490  , Right $ exAv "B" 1 []
1491  ]
1492
1493-- | A variant of 'db21', which actually fails.
1494db22 :: ExampleDb
1495db22 = [
1496    Right $ exAv "A" 1 [ExAny "B"]
1497  , Right $ exAv "A" 2 [ExAny "C"]
1498  ]
1499
1500-- | Another test for the unknown package message.  This database tests that
1501-- filtering out redundant conflict set messages in the solver log doesn't
1502-- interfere with generating a message about a missing package (part of issue
1503-- #3617). The conflict set for the missing package is {A, B}. That conflict set
1504-- is propagated up the tree to the level of A. Since the conflict set is the
1505-- same at both levels, the solver only keeps one of the backjumping messages.
1506db23 :: ExampleDb
1507db23 = [
1508    Right $ exAv "A" 1 [ExAny "B"]
1509  ]
1510
1511-- | Database for (unsuccessfully) trying to expose a bug in the handling
1512-- of implied linking constraints. The question is whether an implied linking
1513-- constraint should only have the introducing package in its conflict set,
1514-- or also its link target.
1515--
1516-- It turns out that as long as the Single Instance Restriction is in place,
1517-- it does not matter, because there will aways be an option that is failing
1518-- due to the SIR, which contains the link target in its conflict set.
1519--
1520-- Even if the SIR is not in place, if there is a solution, one will always
1521-- be found, because without the SIR, linking is always optional, but never
1522-- necessary.
1523--
1524testIndepGoals5 :: String -> GoalOrder -> SolverTest
1525testIndepGoals5 name fixGoalOrder =
1526    case fixGoalOrder of
1527      FixedGoalOrder   -> goalOrder goals test
1528      DefaultGoalOrder -> test
1529  where
1530    test :: SolverTest
1531    test = independentGoals $ mkTest db name ["X", "Y"] $
1532           solverSuccess
1533           [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)]
1534
1535    db :: ExampleDb
1536    db = [
1537        Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"]
1538      , Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2]
1539      , Right $ exAv "A" 1 []
1540      , Right $ exAv "A" 2 [ExAny "B"]
1541      , Right $ exAv "B" 1 [ExAny "C"]
1542      , Right $ exAv "C" 1 []
1543      , Right $ exAv "C" 2 []
1544      ]
1545
1546    goals :: [ExampleVar]
1547    goals = [
1548        P (QualIndep "X") "X"
1549      , P (QualIndep "X") "A"
1550      , P (QualIndep "X") "B"
1551      , P (QualIndep "X") "C"
1552      , P (QualIndep "Y") "Y"
1553      , P (QualIndep "Y") "A"
1554      , P (QualIndep "Y") "B"
1555      , P (QualIndep "Y") "C"
1556      ]
1557
1558-- | A simplified version of 'testIndepGoals5'.
1559testIndepGoals6 :: String -> GoalOrder -> SolverTest
1560testIndepGoals6 name fixGoalOrder =
1561    case fixGoalOrder of
1562      FixedGoalOrder   -> goalOrder goals test
1563      DefaultGoalOrder -> test
1564  where
1565    test :: SolverTest
1566    test = independentGoals $ mkTest db name ["X", "Y"] $
1567           solverSuccess
1568           [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)]
1569
1570    db :: ExampleDb
1571    db = [
1572        Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"]
1573      , Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2]
1574      , Right $ exAv "A" 1 []
1575      , Right $ exAv "A" 2 [ExAny "B"]
1576      , Right $ exAv "B" 1 []
1577      , Right $ exAv "B" 2 []
1578      ]
1579
1580    goals :: [ExampleVar]
1581    goals = [
1582        P (QualIndep "X") "X"
1583      , P (QualIndep "X") "A"
1584      , P (QualIndep "X") "B"
1585      , P (QualIndep "Y") "Y"
1586      , P (QualIndep "Y") "A"
1587      , P (QualIndep "Y") "B"
1588      ]
1589
1590dbExts1 :: ExampleDb
1591dbExts1 = [
1592    Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)]
1593  , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"]
1594  , Right $ exAv "C" 1 [ExAny "B"]
1595  , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"]
1596  , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"]
1597  ]
1598
1599dbLangs1 :: ExampleDb
1600dbLangs1 = [
1601    Right $ exAv "A" 1 [ExLang Haskell2010]
1602  , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"]
1603  , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"]
1604  ]
1605
1606-- | cabal must set enable-exe to false in order to avoid the unavailable
1607-- dependency. Flags are true by default. The flag choice causes "pkg" to
1608-- depend on "false-dep".
1609testBuildable :: String -> ExampleDependency -> TestTree
1610testBuildable testName unavailableDep =
1611    runTest $
1612    mkTestExtLangPC (Just []) (Just [Haskell98]) [] db testName ["pkg"] expected
1613  where
1614    expected = solverSuccess [("false-dep", 1), ("pkg", 1)]
1615    db = [
1616        Right $ exAv "pkg" 1 [exFlagged "enable-exe"
1617                                 [ExAny "true-dep"]
1618                                 [ExAny "false-dep"]]
1619         `withExe`
1620            ExExe "exe" [ unavailableDep
1621                        , ExFlagged "enable-exe" (Buildable []) NotBuildable ]
1622      , Right $ exAv "true-dep" 1 []
1623      , Right $ exAv "false-dep" 1 []
1624      ]
1625
1626-- | cabal must choose -flag1 +flag2 for "pkg", which requires packages
1627-- "flag1-false" and "flag2-true".
1628dbBuildable1 :: ExampleDb
1629dbBuildable1 = [
1630    Right $ exAv "pkg" 1
1631        [ exFlagged "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"]
1632        , exFlagged "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]]
1633     `withExes`
1634        [ ExExe "exe1"
1635            [ ExAny "unknown"
1636            , ExFlagged "flag1" (Buildable []) NotBuildable
1637            , ExFlagged "flag2" (Buildable []) NotBuildable]
1638        , ExExe "exe2"
1639            [ ExAny "unknown"
1640            , ExFlagged "flag1"
1641                  (Buildable [])
1642                  (Buildable [ExFlagged "flag2" NotBuildable (Buildable [])])]
1643         ]
1644  , Right $ exAv "flag1-true" 1 []
1645  , Right $ exAv "flag1-false" 1 []
1646  , Right $ exAv "flag2-true" 1 []
1647  , Right $ exAv "flag2-false" 1 []
1648  ]
1649
1650-- | cabal must pick B-2 to avoid the unknown dependency.
1651dbBuildable2 :: ExampleDb
1652dbBuildable2 = [
1653    Right $ exAv "A" 1 [ExAny "B"]
1654  , Right $ exAv "B" 1 [ExAny "unknown"]
1655  , Right $ exAv "B" 2 []
1656     `withExe`
1657        ExExe "exe"
1658        [ ExAny "unknown"
1659        , ExFlagged "disable-exe" NotBuildable (Buildable [])
1660        ]
1661  , Right $ exAv "B" 3 [ExAny "unknown"]
1662  ]
1663
1664-- | Package databases for testing @pkg-config@ dependencies.
1665dbPC1 :: ExampleDb
1666dbPC1 = [
1667    Right $ exAv "A" 1 [ExPkg ("pkgA", 1)]
1668  , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"]
1669  , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"]
1670  , Right $ exAv "C" 1 [ExAny "B"]
1671  ]
1672
1673-- | Test for the solver's summarized log. The final conflict set is {A, F},
1674-- though the goal order forces the solver to find the (avoidable) conflict
1675-- between B and C first. When the solver reaches the backjump limit, it should
1676-- only show the log to the first conflict. When the backjump limit is high
1677-- enough to allow an exhaustive search, the solver should make use of the final
1678-- conflict set to only show the conflict between A and F in the summarized log.
1679testSummarizedLog :: String -> Maybe Int -> String -> TestTree
1680testSummarizedLog testName mbj expectedMsg =
1681    runTest $ maxBackjumps mbj $ goalOrder goals $ mkTest db testName ["A"] $
1682    solverFailure (== expectedMsg)
1683  where
1684    db = [
1685        Right $ exAv "A" 1 [ExAny "B", ExAny "F"]
1686      , Right $ exAv "B" 3 [ExAny "C"]
1687      , Right $ exAv "B" 2 [ExAny "D"]
1688      , Right $ exAv "B" 1 [ExAny "E"]
1689      , Right $ exAv "E" 1 []
1690      ]
1691
1692    goals :: [ExampleVar]
1693    goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D", "E", "F"]]
1694
1695dbMinimizeConflictSet :: ExampleDb
1696dbMinimizeConflictSet = [
1697    Right $ exAv "A" 3 [ExFix "B" 2, ExFix "C" 1, ExFix "D" 2]
1698  , Right $ exAv "A" 2 [ExFix "B" 1, ExFix "C" 2, ExFix "D" 2]
1699  , Right $ exAv "A" 1 [ExFix "B" 1, ExFix "C" 1, ExFix "D" 2]
1700  , Right $ exAv "B" 1 []
1701  , Right $ exAv "C" 1 []
1702  , Right $ exAv "D" 1 []
1703  ]
1704
1705-- | Test that the solver can find a minimal conflict set with
1706-- --minimize-conflict-set. In the first run, the goal order causes the solver
1707-- to find that A-3 conflicts with B, A-2 conflicts with C, and A-1 conflicts
1708-- with D. The full log should show that the original final conflict set is
1709-- {A, B, C, D}. Then the solver should be able to reduce the conflict set to
1710-- {A, D}, since all versions of A conflict with D. The summarized log should
1711-- only mention A and D.
1712testMinimizeConflictSet :: String -> TestTree
1713testMinimizeConflictSet testName =
1714    runTest $ minimizeConflictSet $ goalOrder goals $ setVerbose $
1715    mkTest dbMinimizeConflictSet testName ["A"] $
1716    SolverResult checkFullLog (Left (== expectedMsg))
1717  where
1718    checkFullLog :: [String] -> Bool
1719    checkFullLog = containsInOrder [
1720        "[__0] fail (backjumping, conflict set: A, B, C, D)"
1721      , "Found no solution after exhaustively searching the dependency tree. "
1722         ++ "Rerunning the dependency solver to minimize the conflict set ({A, B, C, D})."
1723      , "Trying to remove variable \"A\" from the conflict set."
1724      , "Failed to remove \"A\" from the conflict set. Continuing with {A, B, C, D}."
1725      , "Trying to remove variable \"B\" from the conflict set."
1726      , "Successfully removed \"B\" from the conflict set. Continuing with {A, D}."
1727      , "Trying to remove variable \"D\" from the conflict set."
1728      , "Failed to remove \"D\" from the conflict set. Continuing with {A, D}."
1729      ]
1730
1731    expectedMsg =
1732        "Could not resolve dependencies:\n"
1733     ++ "[__0] trying: A-3.0.0 (user goal)\n"
1734     ++ "[__1] next goal: D (dependency of A)\n"
1735     ++ "[__1] rejecting: D-1.0.0 (conflict: A => D==2.0.0)\n"
1736     ++ "[__1] fail (backjumping, conflict set: A, D)\n"
1737     ++ "After searching the rest of the dependency tree exhaustively, these "
1738          ++ "were the goals I've had most trouble fulfilling: A (5), D (4)"
1739
1740    goals :: [ExampleVar]
1741    goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
1742
1743-- | This test uses the same packages and goal order as testMinimizeConflictSet,
1744-- but it doesn't set --minimize-conflict-set. The solver should print the
1745-- original final conflict set and the conflict between A and B. It should also
1746-- suggest rerunning with --minimize-conflict-set.
1747testNoMinimizeConflictSet :: String -> TestTree
1748testNoMinimizeConflictSet testName =
1749    runTest $ goalOrder goals $ setVerbose $
1750    mkTest dbMinimizeConflictSet testName ["A"] $
1751    solverFailure (== expectedMsg)
1752  where
1753    expectedMsg =
1754        "Could not resolve dependencies:\n"
1755     ++ "[__0] trying: A-3.0.0 (user goal)\n"
1756     ++ "[__1] next goal: B (dependency of A)\n"
1757     ++ "[__1] rejecting: B-1.0.0 (conflict: A => B==2.0.0)\n"
1758     ++ "[__1] fail (backjumping, conflict set: A, B)\n"
1759     ++ "After searching the rest of the dependency tree exhaustively, "
1760          ++ "these were the goals I've had most trouble fulfilling: "
1761          ++ "A (7), B (2), C (2), D (2)\n"
1762     ++ "Try running with --minimize-conflict-set to improve the error message."
1763
1764    goals :: [ExampleVar]
1765    goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
1766
1767{-------------------------------------------------------------------------------
1768  Simple databases for the illustrations for the backjumping blog post
1769-------------------------------------------------------------------------------}
1770
1771-- | Motivate conflict sets
1772dbBJ1a :: ExampleDb
1773dbBJ1a = [
1774    Right $ exAv "A" 1 [ExFix "B" 1]
1775  , Right $ exAv "A" 2 [ExFix "B" 2]
1776  , Right $ exAv "B" 1 []
1777  ]
1778
1779-- | Show that we can skip some decisions
1780dbBJ1b :: ExampleDb
1781dbBJ1b = [
1782    Right $ exAv "A" 1 [ExFix "B" 1]
1783  , Right $ exAv "A" 2 [ExFix "B" 2, ExAny "C"]
1784  , Right $ exAv "B" 1 []
1785  , Right $ exAv "C" 1 []
1786  , Right $ exAv "C" 2 []
1787  ]
1788
1789-- | Motivate why both A and B need to be in the conflict set
1790dbBJ1c :: ExampleDb
1791dbBJ1c = [
1792    Right $ exAv "A" 1 [ExFix "B" 1]
1793  , Right $ exAv "B" 1 []
1794  , Right $ exAv "B" 2 []
1795  ]
1796
1797-- | Motivate the need for accumulating conflict sets while we walk the tree
1798dbBJ2 :: ExampleDb
1799dbBJ2 = [
1800    Right $ exAv "A"  1 [ExFix "B" 1]
1801  , Right $ exAv "A"  2 [ExFix "B" 2]
1802  , Right $ exAv "B"  1 [ExFix "C" 1]
1803  , Right $ exAv "B"  2 [ExFix "C" 2]
1804  , Right $ exAv "C"  1 []
1805  ]
1806
1807-- | Motivate the need for `QGoalReason`
1808dbBJ3 :: ExampleDb
1809dbBJ3 = [
1810    Right $ exAv "A"  1 [ExAny "Ba"]
1811  , Right $ exAv "A"  2 [ExAny "Bb"]
1812  , Right $ exAv "Ba" 1 [ExFix "C" 1]
1813  , Right $ exAv "Bb" 1 [ExFix "C" 2]
1814  , Right $ exAv "C"  1 []
1815  ]
1816
1817-- | `QGOalReason` not unique
1818dbBJ4 :: ExampleDb
1819dbBJ4 = [
1820    Right $ exAv "A" 1 [ExAny "B", ExAny "C"]
1821  , Right $ exAv "B" 1 [ExAny "C"]
1822  , Right $ exAv "C" 1 []
1823  ]
1824
1825-- | Flags are represented somewhat strangely in the tree
1826--
1827-- This example probably won't be in the blog post itself but as a separate
1828-- bug report (#3409)
1829dbBJ5 :: ExampleDb
1830dbBJ5 = [
1831    Right $ exAv "A" 1 [exFlagged "flagA" [ExFix "B" 1] [ExFix "C" 1]]
1832  , Right $ exAv "B" 1 [ExFix "D" 1]
1833  , Right $ exAv "C" 1 [ExFix "D" 2]
1834  , Right $ exAv "D" 1 []
1835  ]
1836
1837-- | Conflict sets for cycles
1838dbBJ6 :: ExampleDb
1839dbBJ6 = [
1840    Right $ exAv "A" 1 [ExAny "B"]
1841  , Right $ exAv "B" 1 []
1842  , Right $ exAv "B" 2 [ExAny "C"]
1843  , Right $ exAv "C" 1 [ExAny "A"]
1844  ]
1845
1846-- | Conflicts not unique
1847dbBJ7 :: ExampleDb
1848dbBJ7 = [
1849    Right $ exAv "A" 1 [ExAny "B", ExFix "C" 1]
1850  , Right $ exAv "B" 1 [ExFix "C" 1]
1851  , Right $ exAv "C" 1 []
1852  , Right $ exAv "C" 2 []
1853  ]
1854
1855-- | Conflict sets for SIR (C shared subgoal of independent goals A, B)
1856dbBJ8 :: ExampleDb
1857dbBJ8 = [
1858    Right $ exAv "A" 1 [ExAny "C"]
1859  , Right $ exAv "B" 1 [ExAny "C"]
1860  , Right $ exAv "C" 1 []
1861  ]
1862
1863{-------------------------------------------------------------------------------
1864  Databases for build-tool-depends
1865-------------------------------------------------------------------------------}
1866
1867-- | Multiple packages depending on exes from 'bt-pkg'.
1868dbBuildTools :: ExampleDb
1869dbBuildTools = [
1870    Right $ exAv "A" 1 [ExBuildToolAny "bt-pkg" "exe1"]
1871  , Right $ exAv "B" 1 [exFlagged "flagB" [ExAny "unknown"]
1872                                          [ExBuildToolAny "bt-pkg" "exe1"]]
1873  , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExBuildToolAny "bt-pkg" "exe1"]
1874  , Right $ exAv "D" 1 [ExBuildToolAny "bt-pkg" "unknown-exe"]
1875  , Right $ exAv "E" 1 [ExBuildToolAny "unknown-pkg" "exe1"]
1876  , Right $ exAv "F" 1 [exFlagged "flagF" [ExBuildToolAny "bt-pkg" "unknown-exe"]
1877                                          [ExAny "unknown"]]
1878  , Right $ exAv "G" 1 [] `withTest` ExTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"]
1879  , Right $ exAv "H" 1 [ExBuildToolFix "bt-pkg" "exe1" 3]
1880
1881  , Right $ exAv "bt-pkg" 4 []
1882  , Right $ exAv "bt-pkg" 3 [] `withExe` ExExe "exe2" []
1883  , Right $ exAv "bt-pkg" 2 [] `withExe` ExExe "exe1" []
1884  , Right $ exAv "bt-pkg" 1 []
1885  ]
1886
1887-- The solver should never choose an installed package for a build tool
1888-- dependency.
1889rejectInstalledBuildToolPackage :: String -> SolverTest
1890rejectInstalledBuildToolPackage name =
1891    mkTest db name ["A"] $ solverFailure $ isInfixOf $
1892    "rejecting: A:B:exe.B-1.0.0/installed-1 "
1893     ++ "(does not contain executable 'exe', which is required by A)"
1894  where
1895    db :: ExampleDb
1896    db = [
1897        Right $ exAv "A" 1 [ExBuildToolAny "B" "exe"]
1898      , Left $ exInst "B" 1 "B-1" []
1899      ]
1900
1901-- | This test forces the solver to choose B as a build-tool dependency before
1902-- it sees the dependency on executable exe2 from B. The solver needs to check
1903-- that the version that it already chose for B contains the necessary
1904-- executable. This order causes a different "missing executable" error message
1905-- than when the solver checks for the executable in the same step that it
1906-- chooses the build-tool package.
1907--
1908-- This case may become impossible if we ever add the executable name to the
1909-- build-tool goal qualifier. Then this test would involve two qualified goals
1910-- for B, one for exe1 and another for exe2.
1911chooseExeAfterBuildToolsPackage :: Bool -> String -> SolverTest
1912chooseExeAfterBuildToolsPackage shouldSucceed name =
1913    goalOrder goals $ mkTest db name ["A"] $
1914      if shouldSucceed
1915      then solverSuccess [("A", 1), ("B", 1)]
1916      else solverFailure $ isInfixOf $
1917           "rejecting: A:+flagA (requires executable 'exe2' from A:B:exe.B, "
1918            ++ "but the component does not exist)"
1919  where
1920    db :: ExampleDb
1921    db = [
1922        Right $ exAv "A" 1 [ ExBuildToolAny "B" "exe1"
1923                           , exFlagged "flagA" [ExBuildToolAny "B" "exe2"]
1924                                               [ExAny "unknown"]]
1925      , Right $ exAv "B" 1 []
1926         `withExes`
1927           [ExExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]]
1928      ]
1929
1930    goals :: [ExampleVar]
1931    goals = [
1932        P QualNone "A"
1933      , P (QualExe "A" "B") "B"
1934      , F QualNone "A" "flagA"
1935      ]
1936
1937-- | Test that when one package depends on two executables from another package,
1938-- both executables must come from the same instance of that package. We could
1939-- lift this restriction in the future by adding the executable name to the goal
1940-- qualifier.
1941requireConsistentBuildToolVersions :: String -> SolverTest
1942requireConsistentBuildToolVersions name =
1943    mkTest db name ["A"] $ solverFailure $ isInfixOf $
1944        "[__1] rejecting: A:B:exe.B-2.0.0 (conflict: A => A:B:exe.B (exe exe1)==1.0.0)\n"
1945     ++ "[__1] rejecting: A:B:exe.B-1.0.0 (conflict: A => A:B:exe.B (exe exe2)==2.0.0)"
1946  where
1947    db :: ExampleDb
1948    db = [
1949        Right $ exAv "A" 1 [ ExBuildToolFix "B" "exe1" 1
1950                           , ExBuildToolFix "B" "exe2" 2 ]
1951      , Right $ exAv "B" 2 [] `withExes` exes
1952      , Right $ exAv "B" 1 [] `withExes` exes
1953      ]
1954
1955    exes = [ExExe "exe1" [], ExExe "exe2" []]
1956
1957-- | This test is similar to the failure case for
1958-- chooseExeAfterBuildToolsPackage, except that the build tool is unbuildable
1959-- instead of missing.
1960chooseUnbuildableExeAfterBuildToolsPackage :: String -> SolverTest
1961chooseUnbuildableExeAfterBuildToolsPackage name =
1962    constraints [ExFlagConstraint (ScopeAnyQualifier "B") "build-bt2" False] $
1963    goalOrder goals $
1964    mkTest db name ["A"] $ solverFailure $ isInfixOf $
1965         "rejecting: A:+use-bt2 (requires executable 'bt2' from A:B:exe.B, but "
1966          ++ "the component is not buildable in the current environment)"
1967  where
1968    db :: ExampleDb
1969    db = [
1970        Right $ exAv "A" 1 [ ExBuildToolAny "B" "bt1"
1971                           , exFlagged "use-bt2" [ExBuildToolAny "B" "bt2"]
1972                                                 [ExAny "unknown"]]
1973      , Right $ exAvNoLibrary "B" 1
1974         `withExes`
1975           [ ExExe "bt1" []
1976           , ExExe "bt2" [ExFlagged "build-bt2" (Buildable []) NotBuildable]
1977           ]
1978      ]
1979
1980    goals :: [ExampleVar]
1981    goals = [
1982        P QualNone "A"
1983      , P (QualExe "A" "B") "B"
1984      , F QualNone "A" "use-bt2"
1985      ]
1986
1987{-------------------------------------------------------------------------------
1988  Databases for legacy build-tools
1989-------------------------------------------------------------------------------}
1990dbLegacyBuildTools1 :: ExampleDb
1991dbLegacyBuildTools1 = [
1992    Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [],
1993    Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"]
1994  ]
1995
1996-- Test that a recognized build tool dependency specifies the name of both the
1997-- package and the executable. This db has no solution.
1998dbLegacyBuildTools2 :: ExampleDb
1999dbLegacyBuildTools2 = [
2000    Right $ exAv "alex" 1 [] `withExe` ExExe "other-exe" [],
2001    Right $ exAv "other-package" 1 [] `withExe` ExExe "alex" [],
2002    Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"]
2003  ]
2004
2005-- Test that build-tools on a random thing doesn't matter (only
2006-- the ones we recognize need to be in db)
2007dbLegacyBuildTools3 :: ExampleDb
2008dbLegacyBuildTools3 = [
2009    Right $ exAv "A" 1 [ExLegacyBuildToolAny "otherdude"]
2010  ]
2011
2012-- Test that we can solve for different versions of executables
2013dbLegacyBuildTools4 :: ExampleDb
2014dbLegacyBuildTools4 = [
2015    Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [],
2016    Right $ exAv "alex" 2 [] `withExe` ExExe "alex" [],
2017    Right $ exAv "A" 1 [ExLegacyBuildToolFix "alex" 1],
2018    Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 2],
2019    Right $ exAv "C" 1 [ExAny "A", ExAny "B"]
2020  ]
2021
2022-- Test that exe is not related to library choices
2023dbLegacyBuildTools5 :: ExampleDb
2024dbLegacyBuildTools5 = [
2025    Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` ExExe "alex" [],
2026    Right $ exAv "A" 1 [],
2027    Right $ exAv "A" 2 [],
2028    Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 1, ExFix "A" 2]
2029  ]
2030
2031-- Test that build-tools on build-tools works
2032dbLegacyBuildTools6 :: ExampleDb
2033dbLegacyBuildTools6 = [
2034    Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [],
2035    Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` ExExe "happy" [],
2036    Right $ exAv "A" 1 [ExLegacyBuildToolAny "happy"]
2037  ]
2038
2039-- Test that build-depends on library/executable package works.
2040-- Extracted from https://github.com/haskell/cabal/issues/3775
2041dbIssue3775 :: ExampleDb
2042dbIssue3775 = [
2043    Right $ exAv "warp" 1 [],
2044    -- NB: the warp build-depends refers to the package, not the internal
2045    -- executable!
2046    Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` ExExe "warp" [ExAny "A"],
2047    Right $ exAv "B" 2 [ExAny "A", ExAny "warp"]
2048  ]
2049
2050-- | Returns true if the second list contains all elements of the first list, in
2051-- order.
2052containsInOrder :: Eq a => [a] -> [a] -> Bool
2053containsInOrder []     _  = True
2054containsInOrder _      [] = False
2055containsInOrder (x:xs) (y:ys)
2056  | x == y = containsInOrder xs ys
2057  | otherwise = containsInOrder (x:xs) ys
2058