validate dependabot configuration
[cabal.git] / cabal-install / tests / UnitTests / Distribution / Solver / Modular / Solver.hs
bloba1f5eed3c6208c03df954198b51676d11ee1c598
1 {-# LANGUAGE OverloadedStrings #-}
3 -- | This is a set of unit tests for the dependency solver,
4 -- which uses the solver DSL ("UnitTests.Distribution.Solver.Modular.DSL")
5 -- to more conveniently create package databases to run the solver tests on.
6 module UnitTests.Distribution.Solver.Modular.Solver (tests)
7 where
9 -- base
10 import Data.List (isInfixOf)
12 import qualified Distribution.Version as V
14 -- test-framework
15 import Test.Tasty as TF
16 import Test.Tasty.ExpectedFailure
18 -- Cabal
19 import Language.Haskell.Extension
20 ( Extension (..)
21 , KnownExtension (..)
22 , Language (..)
25 -- cabal-install
26 import Distribution.Solver.Types.Flag
27 import Distribution.Solver.Types.OptionalStanza
28 import Distribution.Solver.Types.PackageConstraint
29 import qualified Distribution.Solver.Types.PackagePath as P
30 import UnitTests.Distribution.Solver.Modular.DSL
31 import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
33 tests :: [TF.TestTree]
34 tests =
35 [ testGroup
36 "Simple dependencies"
37 [ runTest $ mkTest db1 "alreadyInstalled" ["A"] (solverSuccess [])
38 , runTest $ mkTest db1 "installLatest" ["B"] (solverSuccess [("B", 2)])
39 , runTest $
40 preferOldest $
41 mkTest db1 "installOldest" ["B"] (solverSuccess [("B", 1)])
42 , runTest $ mkTest db1 "simpleDep1" ["C"] (solverSuccess [("B", 1), ("C", 1)])
43 , runTest $ mkTest db1 "simpleDep2" ["D"] (solverSuccess [("B", 2), ("D", 1)])
44 , runTest $ mkTest db1 "failTwoVersions" ["C", "D"] anySolverFailure
45 , runTest $ indep $ mkTest db1 "indepTwoVersions" ["C", "D"] (solverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)])
46 , runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (solverSuccess [("B", 1), ("C", 1), ("E", 1)])
47 , runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (solverSuccess [("B", 2), ("D", 1), ("E", 1)])
48 , runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
49 , runTest $ mkTest db1 "buildDepAgainstOld" ["F"] (solverSuccess [("B", 1), ("E", 1), ("F", 1)])
50 , runTest $ mkTest db1 "buildDepAgainstNew" ["G"] (solverSuccess [("B", 2), ("E", 1), ("G", 1)])
51 , runTest $ indep $ mkTest db1 "multipleInstances" ["F", "G"] anySolverFailure
52 , runTest $ mkTest db21 "unknownPackage1" ["A"] (solverSuccess [("A", 1), ("B", 1)])
53 , runTest $ mkTest db22 "unknownPackage2" ["A"] (solverFailure (isInfixOf "unknown package: C"))
54 , runTest $ mkTest db23 "unknownPackage3" ["A"] (solverFailure (isInfixOf "unknown package: B"))
55 , runTest $ mkTest [] "unknown target" ["A"] (solverFailure (isInfixOf "unknown package: A"))
57 , testGroup
58 "Flagged dependencies"
59 [ runTest $ mkTest db3 "forceFlagOn" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
60 , runTest $ mkTest db3 "forceFlagOff" ["D"] (solverSuccess [("A", 2), ("B", 1), ("D", 1)])
61 , runTest $ indep $ mkTest db3 "linkFlags1" ["C", "D"] anySolverFailure
62 , runTest $ indep $ mkTest db4 "linkFlags2" ["C", "D"] anySolverFailure
63 , runTest $ indep $ mkTest db18 "linkFlags3" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)])
65 , testGroup
66 "Lifting dependencies out of conditionals"
67 [ runTest $ commonDependencyLogMessage "common dependency log message"
68 , runTest $ twoLevelDeepCommonDependencyLogMessage "two level deep common dependency log message"
69 , runTest $ testBackjumpingWithCommonDependency "backjumping with common dependency"
71 , testGroup
72 "Manual flags"
73 [ runTest $
74 mkTest dbManualFlags "Use default value for manual flag" ["pkg"] $
75 solverSuccess [("pkg", 1), ("true-dep", 1)]
76 , let checkFullLog =
77 any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)"
78 in runTest $
79 setVerbose $
80 constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $
81 mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $
82 -- TODO: We should check the summarized log instead of the full log
83 -- for the manual flags error message, but it currently only
84 -- appears in the full log.
85 SolverResult checkFullLog (Left $ const True)
86 , let cs = [ExFlagConstraint (ScopeAnyQualifier "pkg") "flag" False]
87 in runTest $
88 constraints cs $
89 mkTest dbManualFlags "Toggle manual flag with flag constraint" ["pkg"] $
90 solverSuccess [("false-dep", 1), ("pkg", 1)]
92 , testGroup
93 "Qualified manual flag constraints"
94 [ let name = "Top-level flag constraint does not constrain setup dep's flag"
95 cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
96 in runTest $
97 constraints cs $
98 mkTest dbSetupDepWithManualFlag name ["A"] $
99 solverSuccess
100 [ ("A", 1)
101 , ("B", 1)
102 , ("B", 2)
103 , ("b-1-false-dep", 1)
104 , ("b-2-true-dep", 1)
106 , let name = "Solver can toggle setup dep's flag to match top-level constraint"
107 cs =
108 [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False
109 , ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion
111 in runTest $
112 constraints cs $
113 mkTest dbSetupDepWithManualFlag name ["A"] $
114 solverSuccess
115 [ ("A", 1)
116 , ("B", 1)
117 , ("B", 2)
118 , ("b-1-false-dep", 1)
119 , ("b-2-false-dep", 1)
121 , let name = "User can constrain flags separately with qualified constraints"
122 cs =
123 [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True
124 , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False
126 in runTest $
127 constraints cs $
128 mkTest dbSetupDepWithManualFlag name ["A"] $
129 solverSuccess
130 [ ("A", 1)
131 , ("B", 1)
132 , ("B", 2)
133 , ("b-1-true-dep", 1)
134 , ("b-2-false-dep", 1)
136 , -- Regression test for #4299
137 let name = "Solver can link deps when only one has constrained manual flag"
138 cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False]
139 in runTest $
140 constraints cs $
141 mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
142 solverSuccess [("A", 1), ("B", 1), ("b-1-false-dep", 1)]
143 , let name = "Solver cannot link deps that have conflicting manual flag constraints"
144 cs =
145 [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True
146 , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False
148 failureReason = "(constraint from unknown source requires opposite flag selection)"
149 checkFullLog lns =
151 (\msg -> any (msg `isInfixOf`) lns)
152 [ "rejecting: B:-flag " ++ failureReason
153 , "rejecting: A:setup.B:+flag " ++ failureReason
155 in runTest $
156 constraints cs $
157 setVerbose $
158 mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
159 SolverResult checkFullLog (Left $ const True)
161 , testGroup
162 "Stanzas"
163 [ runTest $ enableAllTests $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)])
164 , runTest $ enableAllTests $ mkTest db5 "simpleTest2" ["D"] anySolverFailure
165 , runTest $ enableAllTests $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)])
166 , runTest $ enableAllTests $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO
167 , runTest $ enableAllTests $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)])
168 , runTest $ enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
169 , runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
170 , runTest $ enableAllTests $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
171 , runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
172 , runTest $ testTestSuiteWithFlag "test suite with flag"
174 , testGroup
175 "Setup dependencies"
176 [ runTest $ mkTest db7 "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)])
177 , runTest $ mkTest db7 "setupDeps2" ["C"] (solverSuccess [("A", 2), ("C", 1)])
178 , runTest $ mkTest db7 "setupDeps3" ["D"] (solverSuccess [("A", 1), ("D", 1)])
179 , runTest $ mkTest db7 "setupDeps4" ["E"] (solverSuccess [("A", 1), ("A", 2), ("E", 1)])
180 , runTest $ mkTest db7 "setupDeps5" ["F"] (solverSuccess [("A", 1), ("A", 2), ("F", 1)])
181 , runTest $ mkTest db8 "setupDeps6" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
182 , 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)])
183 , runTest $ mkTest db10 "setupDeps8" ["C"] (solverSuccess [("C", 1)])
184 , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
185 , runTest $ setupStanzaTest1
186 , runTest $ setupStanzaTest2
188 , testGroup
189 "Base shim"
190 [ runTest $ mkTest db11 "baseShim1" ["A"] (solverSuccess [("A", 1)])
191 , runTest $ mkTest db12 "baseShim2" ["A"] (solverSuccess [("A", 1)])
192 , runTest $ mkTest db12 "baseShim3" ["B"] (solverSuccess [("B", 1)])
193 , runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
194 , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure
195 , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)])
196 , expectFailBecause "#9467" $ runTest $ mkTest db12s "baseShim7" ["A"] (solverSuccess [("A", 1)])
197 , expectFailBecause "#9467" $ runTest $ mkTest db11s "baseShim7-simple" ["A"] (solverSuccess [("A", 1)])
198 , runTest $ mkTest db11s2 "baseShim8" ["A"] (solverSuccess [("A", 1)])
200 , testGroup
201 "Base and non-reinstallable"
202 [ runTest $
203 mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $
204 solverFailure (isInfixOf "rejecting: base-1.0.0 (constraint from non-reinstallable package requires installed instance)")
205 , runTest $
206 allowBootLibInstalls $
207 mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $
208 solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)]
209 , runTest $
210 mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $
211 solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-reinstallable package requires installed instance)")
213 , testGroup
214 "reject-unconstrained"
215 [ runTest $
216 onlyConstrained $
217 mkTest db12 "missing syb" ["E"] $
218 solverFailure (isInfixOf "not a user-provided goal")
219 , runTest $
220 onlyConstrained $
221 mkTest db12 "all goals" ["E", "syb"] $
222 solverSuccess [("E", 1), ("syb", 2)]
223 , runTest $
224 onlyConstrained $
225 mkTest db17 "backtracking" ["A", "B"] $
226 solverSuccess [("A", 2), ("B", 1)]
227 , runTest $
228 onlyConstrained $
229 mkTest db17 "failure message" ["A"] $
230 solverFailure $
231 isInfixOf $
232 "Could not resolve dependencies:\n"
233 ++ "[__0] trying: A-3.0.0 (user goal)\n"
234 ++ "[__1] next goal: C (dependency of A)\n"
235 ++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, "
236 ++ "but reject-unconstrained-dependencies was set)\n"
237 ++ "[__1] fail (backjumping, conflict set: A, C)\n"
238 ++ "After searching the rest of the dependency tree exhaustively, "
239 ++ "these were the goals I've had most trouble fulfilling: A, C, B"
241 , testGroup
242 "Cycles"
243 [ runTest $ mkTest db14 "simpleCycle1" ["A"] anySolverFailure
244 , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] anySolverFailure
245 , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (solverSuccess [("C", 1), ("E", 1)])
246 , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] anySolverFailure
247 , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] anySolverFailure
248 , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (solverSuccess [("C", 2), ("D", 1)])
249 , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (solverSuccess [("D", 1)])
250 , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (solverSuccess [("C", 2), ("D", 1), ("E", 1)])
251 , runTest $ issue4161 "detect cycle between package and its setup script"
252 , runTest $ testCyclicDependencyErrorMessages "cyclic dependency error messages"
254 , testGroup
255 "Extensions"
256 [ runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure
257 , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure
258 , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (solverSuccess [("A", 1)])
259 , runTest $ mkTestExts (map EnableExtension [CPP, RankNTypes]) dbExts1 "supportedIndirect" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
260 , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure
261 , runTest $ mkTestExts (map EnableExtension [CPP, RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure
262 , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP, RankNTypes]) dbExts1 "supportedUnknown" ["E"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("E", 1)])
264 , testGroup
265 "Languages"
266 [ runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure
267 , runTest $ mkTestLangs [Haskell98, Haskell2010] dbLangs1 "supported" ["A"] (solverSuccess [("A", 1)])
268 , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure
269 , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
271 , testGroup
272 "Qualified Package Constraints"
273 [ runTest $
274 mkTest dbConstraints "install latest versions without constraints" ["A", "B", "C"] $
275 solverSuccess [("A", 7), ("B", 8), ("C", 9), ("D", 7), ("D", 8), ("D", 9)]
276 , let cs = [ExVersionConstraint (ScopeAnyQualifier "D") $ mkVersionRange 1 4]
277 in runTest $
278 constraints cs $
279 mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $
280 solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)]
281 , let cs =
282 [ ExVersionConstraint (ScopeQualified P.QualToplevel "D") $ mkVersionRange 1 4
283 , ExVersionConstraint (ScopeQualified (P.QualSetup "B") "D") $ mkVersionRange 4 7
285 in runTest $
286 constraints cs $
287 mkTest dbConstraints "force multiple versions with qualified constraints" ["A", "B", "C"] $
288 solverSuccess [("A", 1), ("B", 5), ("C", 9), ("D", 1), ("D", 5), ("D", 9)]
289 , let cs = [ExVersionConstraint (ScopeAnySetupQualifier "D") $ mkVersionRange 1 4]
290 in runTest $
291 constraints cs $
292 mkTest dbConstraints "constrain package across setup scripts" ["A", "B", "C"] $
293 solverSuccess [("A", 7), ("B", 2), ("C", 3), ("D", 2), ("D", 3), ("D", 7)]
295 , testGroup
296 "Package Preferences"
297 [ runTest $ preferences [ExPkgPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)])
298 , runTest $ preferences [ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)])
299 , runTest
300 $ preferences
301 [ ExPkgPref "A" $ mkvrOrEarlier 2
302 , ExPkgPref "A" $ mkvrOrEarlier 1
304 $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)])
305 , runTest
306 $ preferences
307 [ ExPkgPref "A" $ mkvrOrEarlier 1
308 , ExPkgPref "A" $ mkvrOrEarlier 2
310 $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)])
311 , runTest
312 $ preferences
313 [ ExPkgPref "A" $ mkvrThis 1
314 , ExPkgPref "A" $ mkvrThis 2
316 $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)])
317 , runTest
318 $ preferences
319 [ ExPkgPref "A" $ mkvrThis 1
320 , ExPkgPref "A" $ mkvrOrEarlier 2
322 $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)])
324 , testGroup
325 "Stanza Preferences"
326 [ runTest $
327 mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $
328 solverSuccess [("pkg", 1)]
329 , runTest $
330 preferences [ExStanzaPref "pkg" [TestStanzas]] $
331 mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $
332 solverSuccess [("pkg", 1), ("test-dep", 1)]
333 , runTest $
334 preferences [ExStanzaPref "pkg" [TestStanzas]] $
335 mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $
336 solverSuccess [("pkg", 1)]
337 , testStanzaPreference "test stanza preference"
339 , testGroup
340 "Buildable Field"
341 [ testBuildable "avoid building component with unknown dependency" (ExAny "unknown")
342 , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown"))
343 , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown"))
344 , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
345 , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)])
347 , testGroup
348 "Pkg-config dependencies"
349 [ runTest $ mkTestPCDepends (Just []) dbPC1 "noPkgs" ["A"] anySolverFailure
350 , runTest $ mkTestPCDepends (Just [("pkgA", "0")]) dbPC1 "tooOld" ["A"] anySolverFailure
351 , runTest $ mkTestPCDepends (Just [("pkgA", "1.0.0"), ("pkgB", "1.0.0")]) dbPC1 "pruneNotFound" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
352 , runTest $ mkTestPCDepends (Just [("pkgA", "1.0.0"), ("pkgB", "2.0.0")]) dbPC1 "chooseNewest" ["C"] (solverSuccess [("A", 1), ("B", 2), ("C", 1)])
353 , runTest $ mkTestPCDepends Nothing dbPC1 "noPkgConfigFailure" ["A"] anySolverFailure
354 , runTest $ mkTestPCDepends Nothing dbPC1 "noPkgConfigSuccess" ["D"] (solverSuccess [("D", 1)])
356 , testGroup
357 "Independent goals"
358 [ runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
359 , runTest $ testIndepGoals2 "indepGoals2"
360 , runTest $ testIndepGoals3 "indepGoals3"
361 , runTest $ testIndepGoals4 "indepGoals4"
362 , runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder
363 , runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder
364 , runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder
365 , runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder
366 , expectFailBecause "#9466" $ runTest $ testIndepGoals7 "indepGoals7"
367 , runTest $ testIndepGoals8 "indepGoals8"
369 , -- Tests designed for the backjumping blog post
370 testGroup
371 "Backjumping"
372 [ runTest $ mkTest dbBJ1a "bj1a" ["A"] (solverSuccess [("A", 1), ("B", 1)])
373 , runTest $ mkTest dbBJ1b "bj1b" ["A"] (solverSuccess [("A", 1), ("B", 1)])
374 , runTest $ mkTest dbBJ1c "bj1c" ["A"] (solverSuccess [("A", 1), ("B", 1)])
375 , runTest $ mkTest dbBJ2 "bj2" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
376 , runTest $ mkTest dbBJ3 "bj3" ["A"] (solverSuccess [("A", 1), ("Ba", 1), ("C", 1)])
377 , runTest $ mkTest dbBJ4 "bj4" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
378 , runTest $ mkTest dbBJ5 "bj5" ["A"] (solverSuccess [("A", 1), ("B", 1), ("D", 1)])
379 , runTest $ mkTest dbBJ6 "bj6" ["A"] (solverSuccess [("A", 1), ("B", 1)])
380 , runTest $ mkTest dbBJ7 "bj7" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
381 , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
383 , testGroup
384 "main library dependencies"
385 [ let db = [Right $ exAvNoLibrary "A" 1 `withExe` exExe "exe" []]
386 in runTest $
387 mkTest db "install build target without a library" ["A"] $
388 solverSuccess [("A", 1)]
389 , let db =
390 [ Right $ exAv "A" 1 [ExAny "B"]
391 , Right $ exAvNoLibrary "B" 1 `withExe` exExe "exe" []
393 in runTest $
394 mkTest db "reject build-depends dependency with no library" ["A"] $
395 solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)")
396 , let exe = exExe "exe" []
397 db =
398 [ Right $ exAv "A" 1 [ExAny "B"]
399 , Right $ exAvNoLibrary "B" 2 `withExe` exe
400 , Right $ exAv "B" 1 [] `withExe` exe
402 in runTest $
403 mkTest db "choose version of build-depends dependency that has a library" ["A"] $
404 solverSuccess [("A", 1), ("B", 1)]
406 , testGroup
407 "sub-library dependencies"
408 [ let db =
409 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
410 , Right $ exAv "B" 1 []
412 in runTest $
413 mkTest db "reject package that is missing required sub-library" ["A"] $
414 solverFailure $
415 isInfixOf $
416 "rejecting: B-1.0.0 (does not contain library 'sub-lib', which is required by A)"
417 , let db =
418 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
419 , Right $ exAvNoLibrary "B" 1 `withSubLibrary` exSubLib "sub-lib" []
421 in runTest $
422 mkTest db "reject package with private but required sub-library" ["A"] $
423 solverFailure $
424 isInfixOf $
425 "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)"
426 , let db =
427 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
428 , Right $
429 exAvNoLibrary "B" 1
430 `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies]
432 in runTest $
433 constraints [ExFlagConstraint (ScopeAnyQualifier "B") "make-lib-private" True] $
434 mkTest db "reject package with sub-library made private by flag constraint" ["A"] $
435 solverFailure $
436 isInfixOf $
437 "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)"
438 , let db =
439 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
440 , Right $
441 exAvNoLibrary "B" 1
442 `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies]
444 in runTest $
445 mkTest db "treat sub-library as visible even though flag choice could make it private" ["A"] $
446 solverSuccess [("A", 1), ("B", 1)]
447 , let db =
448 [ Right $ exAv "A" 1 [ExAny "B"]
449 , Right $ exAv "B" 1 [] `withSubLibrary` exSubLib "sub-lib" []
450 , Right $ exAv "C" 1 [ExSubLibAny "B" "sub-lib"]
452 goals :: [ExampleVar]
453 goals =
454 [ P QualNone "A"
455 , P QualNone "B"
456 , P QualNone "C"
458 in runTest $
459 goalOrder goals $
460 mkTest db "reject package that requires a private sub-library" ["A", "C"] $
461 solverFailure $
462 isInfixOf $
463 "rejecting: C-1.0.0 (requires library 'sub-lib' from B, but the component is private)"
464 , let db =
465 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib-v1"]
466 , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib-v2" publicDependencies
467 , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib-v1" publicDependencies
469 in runTest $
470 mkTest db "choose version of package containing correct sub-library" ["A"] $
471 solverSuccess [("A", 1), ("B", 1)]
472 , let db =
473 [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"]
474 , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib" (dependencies [])
475 , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib" publicDependencies
477 in runTest $
478 mkTest db "choose version of package with public sub-library" ["A"] $
479 solverSuccess [("A", 1), ("B", 1)]
481 , -- build-tool-depends dependencies
482 testGroup
483 "build-tool-depends"
484 [ runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)])
485 , runTest $
486 disableSolveExecutables $
487 mkTest dbBuildTools "don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
488 , runTest $ mkTest dbBuildTools "flagged exe dependency" ["B"] (solverSuccess [("B", 1), ("bt-pkg", 2)])
489 , runTest $
490 enableAllTests $
491 mkTest dbBuildTools "test suite exe dependency" ["C"] (solverSuccess [("C", 1), ("bt-pkg", 2)])
492 , runTest $
493 mkTest dbBuildTools "unknown exe" ["D"] $
494 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by D")
495 , runTest $
496 disableSolveExecutables $
497 mkTest dbBuildTools "don't check for build tool executables in legacy mode" ["D"] $
498 solverSuccess [("D", 1)]
499 , runTest $
500 mkTest dbBuildTools "unknown build tools package error mentions package, not exe" ["E"] $
501 solverFailure (isInfixOf "unknown package: E:unknown-pkg:exe.unknown-pkg (dependency of E)")
502 , runTest $
503 mkTest dbBuildTools "unknown flagged exe" ["F"] $
504 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by F +flagF")
505 , runTest $
506 enableAllTests $
507 mkTest dbBuildTools "unknown test suite exe" ["G"] $
508 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by G *test")
509 , runTest $
510 mkTest dbBuildTools "wrong exe for build tool package version" ["H"] $
511 solverFailure $
512 isInfixOf $
513 -- The solver reports the version conflict when a version conflict
514 -- and an executable conflict apply to the same package version.
515 "[__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"
516 ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-3.0.0 (does not contain executable 'exe1', which is required by H)\n"
517 ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-2.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)"
518 , runTest $ chooseExeAfterBuildToolsPackage True "choose exe after choosing its package - success"
519 , runTest $ chooseExeAfterBuildToolsPackage False "choose exe after choosing its package - failure"
520 , runTest $ rejectInstalledBuildToolPackage "reject installed package for build-tool dependency"
521 , runTest $ requireConsistentBuildToolVersions "build tool versions must be consistent within one package"
523 , -- build-tools dependencies
524 testGroup
525 "legacy build-tools"
526 [ runTest $ mkTest dbLegacyBuildTools1 "bt1" ["A"] (solverSuccess [("A", 1), ("alex", 1)])
527 , runTest $
528 disableSolveExecutables $
529 mkTest dbLegacyBuildTools1 "bt1 - don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)])
530 , runTest $
531 mkTest dbLegacyBuildTools2 "bt2" ["A"] $
532 solverFailure (isInfixOf "does not contain executable 'alex', which is required by A")
533 , runTest $
534 disableSolveExecutables $
535 mkTest dbLegacyBuildTools2 "bt2 - don't check for build tool executables in legacy mode" ["A"] (solverSuccess [("A", 1)])
536 , runTest $ mkTest dbLegacyBuildTools3 "bt3" ["A"] (solverSuccess [("A", 1)])
537 , runTest $ mkTest dbLegacyBuildTools4 "bt4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)])
538 , runTest $ mkTest dbLegacyBuildTools5 "bt5" ["B"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)])
539 , runTest $ mkTest dbLegacyBuildTools6 "bt6" ["A"] (solverSuccess [("A", 1), ("alex", 1), ("happy", 1)])
541 , -- internal dependencies
542 testGroup
543 "internal dependencies"
544 [ runTest $ mkTest dbIssue3775 "issue #3775" ["B"] (solverSuccess [("A", 2), ("B", 2), ("warp", 1)])
546 , -- tests for partial fix for issue #5325
547 testGroup "Components that are unbuildable in the current environment" $
548 let flagConstraint = ExFlagConstraint . ScopeAnyQualifier
549 in [ let db = [Right $ exAv "A" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies]]
550 in runTest $
551 constraints [flagConstraint "A" "build-lib" False] $
552 mkTest db "install unbuildable library" ["A"] $
553 solverSuccess [("A", 1)]
554 , let db =
555 [ Right $
556 exAvNoLibrary "A" 1
557 `withExe` exExe "exe" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies]
559 in runTest $
560 constraints [flagConstraint "A" "build-exe" False] $
561 mkTest db "install unbuildable exe" ["A"] $
562 solverSuccess [("A", 1)]
563 , let db =
564 [ Right $ exAv "A" 1 [ExAny "B"]
565 , Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies]
567 in runTest $
568 constraints [flagConstraint "B" "build-lib" False] $
569 mkTest db "reject library dependency with unbuildable library" ["A"] $
570 solverFailure $
571 isInfixOf $
572 "rejecting: B-1.0.0 (library is not buildable in the "
573 ++ "current environment, but it is required by A)"
574 , let db =
575 [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
576 , Right $
577 exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies]
578 `withExe` exExe "bt" []
580 in runTest $
581 constraints [flagConstraint "B" "build-lib" False] $
582 mkTest db "allow build-tool dependency with unbuildable library" ["A"] $
583 solverSuccess [("A", 1), ("B", 1)]
584 , let db =
585 [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"]
586 , Right $
587 exAv "B" 1 []
588 `withExe` exExe "bt" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies]
590 in runTest $
591 constraints [flagConstraint "B" "build-exe" False] $
592 mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $
593 solverFailure $
594 isInfixOf $
595 "rejecting: A:B:exe.B-1.0.0 (executable 'bt' is not "
596 ++ "buildable in the current environment, but it is required by A)"
597 , runTest $
598 chooseUnbuildableExeAfterBuildToolsPackage
599 "choose unbuildable exe after choosing its package"
601 , testGroup
602 "--fine-grained-conflicts"
603 [ -- Skipping a version because of a problematic dependency:
605 -- When the solver explores A-4, it finds that it cannot satisfy B's
606 -- dependencies. This allows the solver to skip the subsequent
607 -- versions of A that also depend on B.
608 runTest $
609 let db =
610 [ Right $ exAv "A" 4 [ExAny "B"]
611 , Right $ exAv "A" 3 [ExAny "B"]
612 , Right $ exAv "A" 2 [ExAny "B"]
613 , Right $ exAv "A" 1 []
614 , Right $ exAv "B" 2 [ExAny "unknown1"]
615 , Right $ exAv "B" 1 [ExAny "unknown2"]
617 msg =
618 [ "[__0] trying: A-4.0.0 (user goal)"
619 , "[__1] trying: B-2.0.0 (dependency of A)"
620 , "[__2] unknown package: unknown1 (dependency of B)"
621 , "[__2] fail (backjumping, conflict set: B, unknown1)"
622 , "[__1] trying: B-1.0.0"
623 , "[__2] unknown package: unknown2 (dependency of B)"
624 , "[__2] fail (backjumping, conflict set: B, unknown2)"
625 , "[__1] fail (backjumping, conflict set: A, B, unknown1, unknown2)"
626 , "[__0] skipping: A; 3.0.0, 2.0.0 (has the same characteristics that "
627 ++ "caused the previous version to fail: depends on 'B')"
628 , "[__0] trying: A-1.0.0"
629 , "[__1] done"
631 in setVerbose $
632 mkTest db "skip version due to problematic dependency" ["A"] $
633 SolverResult (isInfixOf msg) $
634 Right [("A", 1)]
635 , -- Skipping a version because of a restrictive constraint on a
636 -- dependency:
638 -- The solver rejects A-4 because its constraint on B excludes B-1.
639 -- Then the solver is able to skip A-3 and A-2 because they also
640 -- exclude B-1, even though they don't have the exact same constraints
641 -- on B.
642 runTest $
643 let db =
644 [ Right $ exAv "A" 4 [ExFix "B" 14]
645 , Right $ exAv "A" 3 [ExFix "B" 13]
646 , Right $ exAv "A" 2 [ExFix "B" 12]
647 , Right $ exAv "A" 1 [ExFix "B" 11]
648 , Right $ exAv "B" 11 []
650 msg =
651 [ "[__0] trying: A-4.0.0 (user goal)"
652 , "[__1] next goal: B (dependency of A)"
653 , "[__1] rejecting: B-11.0.0 (conflict: A => B==14.0.0)"
654 , "[__1] fail (backjumping, conflict set: A, B)"
655 , "[__0] skipping: A; 3.0.0, 2.0.0 (has the same characteristics that "
656 ++ "caused the previous version to fail: depends on 'B' but excludes "
657 ++ "version 11.0.0)"
658 , "[__0] trying: A-1.0.0"
659 , "[__1] next goal: B (dependency of A)"
660 , "[__1] trying: B-11.0.0"
661 , "[__2] done"
663 in setVerbose $
664 mkTest db "skip version due to restrictive constraint on its dependency" ["A"] $
665 SolverResult (isInfixOf msg) $
666 Right [("A", 1), ("B", 11)]
667 , -- This test tests the case where the solver chooses a version for one
668 -- package, B, before choosing a version for one of its reverse
669 -- dependencies, C. While the solver is exploring the subtree rooted
670 -- at B-3, it finds that C-2's dependency on B conflicts with B-3.
671 -- Then the solver is able to skip C-1, because it also excludes B-3.
673 -- --fine-grained-conflicts could have a benefit in this case even
674 -- though the solver would have found the conflict between B-3 and C-1
675 -- immediately after trying C-1 anyway. It prevents C-1 from
676 -- introducing any other conflicts which could increase the size of
677 -- the conflict set.
678 runTest $
679 let db =
680 [ Right $ exAv "A" 1 [ExAny "B", ExAny "C"]
681 , Right $ exAv "B" 3 []
682 , Right $ exAv "B" 2 []
683 , Right $ exAv "B" 1 []
684 , Right $ exAv "C" 2 [ExFix "B" 2]
685 , Right $ exAv "C" 1 [ExFix "B" 1]
687 goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
688 expectedMsg =
689 [ "[__0] trying: A-1.0.0 (user goal)"
690 , "[__1] trying: B-3.0.0 (dependency of A)"
691 , "[__2] next goal: C (dependency of A)"
692 , "[__2] rejecting: C-2.0.0 (conflict: B==3.0.0, C => B==2.0.0)"
693 , "[__2] skipping: C-1.0.0 (has the same characteristics that caused the "
694 ++ "previous version to fail: excludes 'B' version 3.0.0)"
695 , "[__2] fail (backjumping, conflict set: A, B, C)"
696 , "[__1] trying: B-2.0.0"
697 , "[__2] next goal: C (dependency of A)"
698 , "[__2] trying: C-2.0.0"
699 , "[__3] done"
701 in setVerbose $
702 goalOrder goals $
703 mkTest db "skip version that excludes dependency that was already chosen" ["A"] $
704 SolverResult (isInfixOf expectedMsg) $
705 Right [("A", 1), ("B", 2), ("C", 2)]
706 , -- This test tests how the solver merges conflicts when it has
707 -- multiple reasons to add a variable to the conflict set. In this
708 -- case, package A conflicts with B and C. The solver should take the
709 -- union of the conflicts and then only skip a version if it does not
710 -- resolve any of the conflicts.
712 -- The solver rejects A-3 because it can't find consistent versions for
713 -- its two dependencies, B and C. Then it skips A-2 because A-2 also
714 -- depends on B and C. This test ensures that the solver considers
715 -- A-1 even though A-1 only resolves one of the conflicts (A-1 removes
716 -- the dependency on C).
717 runTest $
718 let db =
719 [ Right $ exAv "A" 3 [ExAny "B", ExAny "C"]
720 , Right $ exAv "A" 2 [ExAny "B", ExAny "C"]
721 , Right $ exAv "A" 1 [ExAny "B"]
722 , Right $ exAv "B" 1 [ExFix "D" 1]
723 , Right $ exAv "C" 1 [ExFix "D" 2]
724 , Right $ exAv "D" 1 []
725 , Right $ exAv "D" 2 []
727 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
728 msg =
729 [ "[__0] trying: A-3.0.0 (user goal)"
730 , "[__1] trying: B-1.0.0 (dependency of A)"
731 , "[__2] trying: C-1.0.0 (dependency of A)"
732 , "[__3] next goal: D (dependency of B)"
733 , "[__3] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
734 , "[__3] rejecting: D-1.0.0 (conflict: C => D==2.0.0)"
735 , "[__3] fail (backjumping, conflict set: B, C, D)"
736 , "[__2] fail (backjumping, conflict set: A, B, C, D)"
737 , "[__1] fail (backjumping, conflict set: A, B, C, D)"
738 , "[__0] skipping: A-2.0.0 (has the same characteristics that caused the "
739 ++ "previous version to fail: depends on 'B'; depends on 'C')"
740 , "[__0] trying: A-1.0.0"
741 , "[__1] trying: B-1.0.0 (dependency of A)"
742 , "[__2] next goal: D (dependency of B)"
743 , "[__2] rejecting: D-2.0.0 (conflict: B => D==1.0.0)"
744 , "[__2] trying: D-1.0.0"
745 , "[__3] done"
747 in setVerbose $
748 goalOrder goals $
749 mkTest db "only skip a version if it resolves none of the previous conflicts" ["A"] $
750 SolverResult (isInfixOf msg) $
751 Right [("A", 1), ("B", 1), ("D", 1)]
752 , -- This test ensures that the solver log doesn't show all conflicts
753 -- that the solver encountered in a subtree. The solver should only
754 -- show the conflicts that are contained in the current conflict set.
756 -- The goal order forces the solver to try A-4, encounter a conflict
757 -- with B-2, try B-1, and then try C. A-4 conflicts with the only
758 -- version of C, so the solver backjumps with a conflict set of
759 -- {A, C}. When the solver skips the next version of A, the log should
760 -- mention the conflict with C but not B.
761 runTest $
762 let db =
763 [ Right $ exAv "A" 4 [ExFix "B" 1, ExFix "C" 1]
764 , Right $ exAv "A" 3 [ExFix "B" 1, ExFix "C" 1]
765 , Right $ exAv "A" 2 [ExFix "C" 1]
766 , Right $ exAv "A" 1 [ExFix "C" 2]
767 , Right $ exAv "B" 2 []
768 , Right $ exAv "B" 1 []
769 , Right $ exAv "C" 2 []
771 goals = [P QualNone pkg | pkg <- ["A", "B", "C"]]
772 msg =
773 [ "[__0] trying: A-4.0.0 (user goal)"
774 , "[__1] next goal: B (dependency of A)"
775 , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
776 , "[__1] trying: B-1.0.0"
777 , "[__2] next goal: C (dependency of A)"
778 , "[__2] rejecting: C-2.0.0 (conflict: A => C==1.0.0)"
779 , "[__2] fail (backjumping, conflict set: A, C)"
780 , "[__0] skipping: A; 3.0.0, 2.0.0 (has the same characteristics that caused the "
781 ++ "previous version to fail: depends on 'C' but excludes version 2.0.0)"
782 , "[__0] trying: A-1.0.0"
783 , "[__1] next goal: C (dependency of A)"
784 , "[__1] trying: C-2.0.0"
785 , "[__2] done"
787 in setVerbose $
788 goalOrder goals $
789 mkTest db "don't show conflicts that aren't part of the conflict set" ["A"] $
790 SolverResult (isInfixOf msg) $
791 Right [("A", 1), ("C", 2)]
792 , -- Tests that the conflict set is properly updated when a version is
793 -- skipped due to being excluded by one of its reverse dependencies'
794 -- constraints.
795 runTest $
796 let db =
797 [ Right $ exAv "A" 2 [ExFix "B" 3]
798 , Right $ exAv "A" 1 [ExFix "B" 1]
799 , Right $ exAv "B" 2 []
800 , Right $ exAv "B" 1 []
802 msg =
803 [ "[__0] trying: A-2.0.0 (user goal)"
804 , "[__1] next goal: B (dependency of A)"
805 , -- During this step, the solver adds A and B to the
806 -- conflict set, with the details of each package's
807 -- conflict:
809 -- A: A's constraint rejected B-2.
810 -- B: B was rejected by A's B==3 constraint
811 "[__1] rejecting: B-2.0.0 (conflict: A => B==3.0.0)"
812 , -- When the solver skips B-1, it cannot simply reuse the
813 -- previous conflict set. It also needs to update A's
814 -- entry to say that A also rejected B-1. Otherwise, the
815 -- solver wouldn't know that A-1 could resolve one of
816 -- the conflicts encountered while exploring A-2. The
817 -- solver would skip A-1, even though it leads to the
818 -- solution.
819 "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
820 ++ "the previous version to fail: excluded by constraint '==3.0.0' from 'A')"
821 , "[__1] fail (backjumping, conflict set: A, B)"
822 , "[__0] trying: A-1.0.0"
823 , "[__1] next goal: B (dependency of A)"
824 , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)"
825 , "[__1] trying: B-1.0.0"
826 , "[__2] done"
828 in setVerbose $
829 mkTest db "update conflict set after skipping version - 1" ["A"] $
830 SolverResult (isInfixOf msg) $
831 Right [("A", 1), ("B", 1)]
832 , -- Tests that the conflict set is properly updated when a version is
833 -- skipped due to excluding a version of one of its dependencies.
834 -- This test is similar the previous one, with the goal order reversed.
835 runTest $
836 let db =
837 [ Right $ exAv "A" 2 []
838 , Right $ exAv "A" 1 []
839 , Right $ exAv "B" 2 [ExFix "A" 3]
840 , Right $ exAv "B" 1 [ExFix "A" 1]
842 goals = [P QualNone pkg | pkg <- ["A", "B"]]
843 msg =
844 [ "[__0] trying: A-2.0.0 (user goal)"
845 , "[__1] next goal: B (user goal)"
846 , "[__1] rejecting: B-2.0.0 (conflict: A==2.0.0, B => A==3.0.0)"
847 , "[__1] skipping: B-1.0.0 (has the same characteristics that caused "
848 ++ "the previous version to fail: excludes 'A' version 2.0.0)"
849 , "[__1] fail (backjumping, conflict set: A, B)"
850 , "[__0] trying: A-1.0.0"
851 , "[__1] next goal: B (user goal)"
852 , "[__1] rejecting: B-2.0.0 (conflict: A==1.0.0, B => A==3.0.0)"
853 , "[__1] trying: B-1.0.0"
854 , "[__2] done"
856 in setVerbose $
857 goalOrder goals $
858 mkTest db "update conflict set after skipping version - 2" ["A", "B"] $
859 SolverResult (isInfixOf msg) $
860 Right [("A", 1), ("B", 1)]
862 , -- Tests for the contents of the solver's log
863 testGroup
864 "Solver log"
865 [ -- See issue #3203. The solver should only choose a version for A once.
866 runTest $
867 let db = [Right $ exAv "A" 1 []]
869 p :: [String] -> Bool
870 p lg =
871 elem "targets: A" lg
872 && length (filter ("trying: A" `isInfixOf`) lg) == 1
873 in setVerbose $
874 mkTest db "deduplicate targets" ["A", "A"] $
875 SolverResult p $
876 Right [("A", 1)]
877 , runTest $
878 let db = [Right $ exAv "A" 1 [ExAny "B"]]
879 msg =
880 "After searching the rest of the dependency tree exhaustively, "
881 ++ "these were the goals I've had most trouble fulfilling: A, B"
882 in mkTest db "exhaustive search failure message" ["A"] $
883 solverFailure (isInfixOf msg)
884 , testSummarizedLog "show conflicts from final conflict set after exhaustive search" Nothing $
885 "Could not resolve dependencies:\n"
886 ++ "[__0] trying: A-1.0.0 (user goal)\n"
887 ++ "[__1] unknown package: F (dependency of A)\n"
888 ++ "[__1] fail (backjumping, conflict set: A, F)\n"
889 ++ "After searching the rest of the dependency tree exhaustively, "
890 ++ "these were the goals I've had most trouble fulfilling: A, F"
891 , testSummarizedLog "show first conflicts after inexhaustive search" (Just 3) $
892 "Could not resolve dependencies:\n"
893 ++ "[__0] trying: A-1.0.0 (user goal)\n"
894 ++ "[__1] trying: B-3.0.0 (dependency of A)\n"
895 ++ "[__2] unknown package: C (dependency of B)\n"
896 ++ "[__2] fail (backjumping, conflict set: B, C)\n"
897 ++ "Backjump limit reached (currently 3, change with --max-backjumps "
898 ++ "or try to run with --reorder-goals).\n"
899 , testSummarizedLog "don't show summarized log when backjump limit is too low" (Just 1) $
900 "Backjump limit reached (currently 1, change with --max-backjumps "
901 ++ "or try to run with --reorder-goals).\n"
902 ++ "Failed to generate a summarized dependency solver log due to low backjump limit."
903 , testMinimizeConflictSet
904 "minimize conflict set with --minimize-conflict-set"
905 , testNoMinimizeConflictSet
906 "show original conflict set with --no-minimize-conflict-set"
907 , runTest $
908 let db =
909 [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
910 , Left $ exInst "other-package" 2 "other-package-2.0.0" []
912 msg = "rejecting: other-package-2.0.0/installed-2.0.0"
913 in mkTest db "show full installed package version (issue #5892)" ["my-package"] $
914 solverFailure (isInfixOf msg)
915 , runTest $
916 let db =
917 [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
918 , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" []
920 msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789"
921 in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $
922 solverFailure (isInfixOf msg)
923 , testGroup
924 "package versions abbreviation (issue #9559.)"
925 [ runTest $
926 let db =
927 [ Right $ exAv "A" 1 []
928 , Right $ exAv "A" 2 []
929 , Right $ exAv "B" 1 [ExFix "A" 3]
931 rejecting = "rejecting: A-2.0.0"
932 skipping = "skipping: A-1.0.0"
933 in mkTest db "show skipping singleton" ["B"] $
934 solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg)
935 , runTest $
936 let db =
937 [ Left $ exInst "A" 1 "A-1.0.0" []
938 , Left $ exInst "A" 2 "A-2.0.0" []
939 , Right $ exAv "B" 1 [ExFix "A" 3]
941 rejecting = "rejecting: A-2.0.0/installed-2.0.0"
942 skipping = "skipping: A-1.0.0/installed-1.0.0"
943 in mkTest db "show skipping singleton, installed" ["B"] $
944 solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg)
945 , runTest $
946 let db =
947 [ Right $ exAv "A" 1 []
948 , Right $ exAv "A" 2 []
949 , Right $ exAv "A" 3 []
950 , Right $ exAv "B" 1 [ExFix "A" 4]
952 rejecting = "rejecting: A-3.0.0"
953 skipping = "skipping: A; 2.0.0, 1.0.0"
954 in mkTest db "show skipping versions list" ["B"] $
955 solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg)
956 , runTest $
957 let db =
958 [ Left $ exInst "A" 1 "A-1.0.0" []
959 , Left $ exInst "A" 2 "A-2.0.0" []
960 , Left $ exInst "A" 3 "A-3.0.0" []
961 , Right $ exAv "B" 1 [ExFix "A" 4]
963 rejecting = "rejecting: A-3.0.0/installed-3.0.0"
964 skipping = "skipping: A; 2.0.0/installed-2.0.0, 1.0.0/installed-1.0.0"
965 in mkTest db "show skipping versions list, installed" ["B"] $
966 solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg)
970 where
971 indep = independentGoals
972 mkvrThis = V.thisVersion . makeV
973 mkvrOrEarlier = V.orEarlierVersion . makeV
974 makeV v = V.mkVersion [v, 0, 0]
976 data GoalOrder = FixedGoalOrder | DefaultGoalOrder
978 {-------------------------------------------------------------------------------
979 Specific example database for the tests
980 -------------------------------------------------------------------------------}
982 db1 :: ExampleDb
983 db1 =
984 let a = exInst "A" 1 "A-1" []
985 in [ Left a
986 , Right $ exAv "B" 1 [ExAny "A"]
987 , Right $ exAv "B" 2 [ExAny "A"]
988 , Right $ exAv "C" 1 [ExFix "B" 1]
989 , Right $ exAv "D" 1 [ExFix "B" 2]
990 , Right $ exAv "E" 1 [ExAny "B"]
991 , Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"]
992 , Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"]
993 , Right $ exAv "Z" 1 []
996 -- In this example, we _can_ install C and D as independent goals, but we have
997 -- to pick two different versions for B (arbitrarily)
998 db2 :: ExampleDb
999 db2 =
1000 [ Right $ exAv "A" 1 []
1001 , Right $ exAv "A" 2 []
1002 , Right $ exAv "B" 1 [ExAny "A"]
1003 , Right $ exAv "B" 2 [ExAny "A"]
1004 , Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1]
1005 , Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2]
1008 db3 :: ExampleDb
1009 db3 =
1010 [ Right $ exAv "A" 1 []
1011 , Right $ exAv "A" 2 []
1012 , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "A" 1] [ExFix "A" 2]]
1013 , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
1014 , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"]
1017 -- | Like db3, but the flag picks a different package rather than a
1018 -- different package version
1020 -- In db3 we cannot install C and D as independent goals because:
1022 -- * The multiple instance restriction says C and D _must_ share B
1023 -- * Since C relies on A-1, C needs B to be compiled with flagB on
1024 -- * Since D relies on A-2, D needs B to be compiled with flagB off
1025 -- * Hence C and D have incompatible requirements on B's flags.
1027 -- However, _even_ if we don't check explicitly that we pick the same flag
1028 -- assignment for 0.B and 1.B, we will still detect the problem because
1029 -- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to
1030 -- 1.A and therefore we cannot link 0.B to 1.B.
1032 -- In db4 the situation however is trickier. We again cannot install
1033 -- packages C and D as independent goals because:
1035 -- * As above, the multiple instance restriction says that C and D _must_ share B
1036 -- * Since C relies on Ax-2, it requires B to be compiled with flagB off
1037 -- * Since D relies on Ay-2, it requires B to be compiled with flagB on
1038 -- * Hence C and D have incompatible requirements on B's flags.
1040 -- But now this requirement is more indirect. If we only check dependencies
1041 -- we don't see the problem:
1043 -- * We link 0.B to 1.B
1044 -- * 0.B relies on Ay-1
1045 -- * 1.B relies on Ax-1
1047 -- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since
1048 -- we only ever assign to one of these, these constraints are never broken.
1049 db4 :: ExampleDb
1050 db4 =
1051 [ Right $ exAv "Ax" 1 []
1052 , Right $ exAv "Ax" 2 []
1053 , Right $ exAv "Ay" 1 []
1054 , Right $ exAv "Ay" 2 []
1055 , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]]
1056 , Right $ exAv "C" 1 [ExFix "Ax" 2, ExAny "B"]
1057 , Right $ exAv "D" 1 [ExFix "Ay" 2, ExAny "B"]
1060 -- | Simple database containing one package with a manual flag.
1061 dbManualFlags :: ExampleDb
1062 dbManualFlags =
1063 [ Right $
1064 declareFlags [ExFlag "flag" True Manual] $
1065 exAv "pkg" 1 [exFlagged "flag" [ExAny "true-dep"] [ExAny "false-dep"]]
1066 , Right $ exAv "true-dep" 1 []
1067 , Right $ exAv "false-dep" 1 []
1070 -- | Database containing a setup dependency with a manual flag. A's library and
1071 -- setup script depend on two different versions of B. B's manual flag can be
1072 -- set to different values in the two places where it is used.
1073 dbSetupDepWithManualFlag :: ExampleDb
1074 dbSetupDepWithManualFlag =
1075 let bFlags = [ExFlag "flag" True Manual]
1076 in [ Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 2]
1077 , Right $
1078 declareFlags bFlags $
1079 exAv
1082 [ exFlagged
1083 "flag"
1084 [ExAny "b-1-true-dep"]
1085 [ExAny "b-1-false-dep"]
1087 , Right $
1088 declareFlags bFlags $
1089 exAv
1092 [ exFlagged
1093 "flag"
1094 [ExAny "b-2-true-dep"]
1095 [ExAny "b-2-false-dep"]
1097 , Right $ exAv "b-1-true-dep" 1 []
1098 , Right $ exAv "b-1-false-dep" 1 []
1099 , Right $ exAv "b-2-true-dep" 1 []
1100 , Right $ exAv "b-2-false-dep" 1 []
1103 -- | A database similar to 'dbSetupDepWithManualFlag', except that the library
1104 -- and setup script both depend on B-1. B must be linked because of the Single
1105 -- Instance Restriction, and its flag can only have one value.
1106 dbLinkedSetupDepWithManualFlag :: ExampleDb
1107 dbLinkedSetupDepWithManualFlag =
1108 [ Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 1]
1109 , Right $
1110 declareFlags [ExFlag "flag" True Manual] $
1111 exAv
1114 [ exFlagged
1115 "flag"
1116 [ExAny "b-1-true-dep"]
1117 [ExAny "b-1-false-dep"]
1119 , Right $ exAv "b-1-true-dep" 1 []
1120 , Right $ exAv "b-1-false-dep" 1 []
1123 -- | Some tests involving testsuites
1125 -- Note that in this test framework test suites are always enabled; if you
1126 -- want to test without test suites just set up a test database without
1127 -- test suites.
1129 -- * C depends on A (through its test suite)
1130 -- * D depends on B-2 (through its test suite), but B-2 is unavailable
1131 -- * E depends on A-1 directly and on A through its test suite. We prefer
1132 -- to use A-1 for the test suite in this case.
1133 -- * F depends on A-1 directly and on A-2 through its test suite. In this
1134 -- case we currently fail to install F, although strictly speaking
1135 -- test suites should be considered independent goals.
1136 -- * G is like E, but for version A-2. This means that if we cannot install
1137 -- E and G together, unless we regard them as independent goals.
1138 db5 :: ExampleDb
1139 db5 =
1140 [ Right $ exAv "A" 1 []
1141 , Right $ exAv "A" 2 []
1142 , Right $ exAv "B" 1 []
1143 , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExAny "A"]
1144 , Right $ exAv "D" 1 [] `withTest` exTest "testD" [ExFix "B" 2]
1145 , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` exTest "testE" [ExAny "A"]
1146 , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` exTest "testF" [ExFix "A" 2]
1147 , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` exTest "testG" [ExAny "A"]
1150 -- Now the _dependencies_ have test suites
1153 -- * Installing C is a simple example. C wants version 1 of A, but depends on
1155 -- B, and B's testsuite depends on an any version of A. In this case we prefer
1156 -- to link (if we don't regard test suites as independent goals then of course
1157 -- linking here doesn't even come into it).
1159 -- * Installing [C, D] means that we prefer to link B -- depending on how we
1161 -- set things up, this means that we should also link their test suites.
1162 db6 :: ExampleDb
1163 db6 =
1164 [ Right $ exAv "A" 1 []
1165 , Right $ exAv "A" 2 []
1166 , Right $ exAv "B" 1 [] `withTest` exTest "testA" [ExAny "A"]
1167 , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
1168 , Right $ exAv "D" 1 [ExAny "B"]
1171 -- | This test checks that the solver can backjump to disable a flag, even if
1172 -- the problematic dependency is also under a test suite. (issue #4390)
1174 -- The goal order forces the solver to choose the flag before enabling testing.
1175 -- Previously, the solver couldn't handle this case, because it only tried to
1176 -- disable testing, and when that failed, it backjumped past the flag choice.
1177 -- The solver should also try to set the flag to false, because that avoids the
1178 -- dependency on B.
1179 testTestSuiteWithFlag :: String -> SolverTest
1180 testTestSuiteWithFlag name =
1181 goalOrder goals $
1182 enableAllTests $
1183 mkTest db name ["A", "B"] $
1184 solverSuccess [("A", 1), ("B", 1)]
1185 where
1186 db :: ExampleDb
1187 db =
1188 [ Right $
1189 exAv "A" 1 []
1190 `withTest` exTest "test" [exFlagged "flag" [ExFix "B" 2] []]
1191 , Right $ exAv "B" 1 []
1194 goals :: [ExampleVar]
1195 goals =
1196 [ P QualNone "B"
1197 , P QualNone "A"
1198 , F QualNone "A" "flag"
1199 , S QualNone "A" TestStanzas
1202 -- Packages with setup dependencies
1204 -- Install..
1206 -- * B: Simple example, just make sure setup deps are taken into account at all
1208 -- * C: Both the package and the setup script depend on any version of A.
1210 -- In this case we prefer to link
1212 -- * D: Variation on C.1 where the package requires a specific (not latest)
1214 -- version but the setup dependency is not fixed. Again, we prefer to
1215 -- link (picking the older version)
1217 -- * E: Variation on C.2 with the setup dependency the more inflexible.
1219 -- Currently, in this case we do not see the opportunity to link because
1220 -- we consider setup dependencies after normal dependencies; we will
1221 -- pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick
1222 -- A.1 instead. This isn't so easy to fix (if we want to fix it at all);
1223 -- in particular, considering setup dependencies _before_ other deps is
1224 -- not an improvement, because in general we would prefer to link setup
1225 -- setups to package deps, rather than the other way around. (For example,
1226 -- if we change this ordering then the test for D would start to install
1227 -- two versions of A).
1229 -- * F: The package and the setup script depend on different versions of A.
1231 -- This will only work if setup dependencies are considered independent.
1232 db7 :: ExampleDb
1233 db7 =
1234 [ Right $ exAv "A" 1 []
1235 , Right $ exAv "A" 2 []
1236 , Right $ exAv "B" 1 [] `withSetupDeps` [ExAny "A"]
1237 , Right $ exAv "C" 1 [ExAny "A"] `withSetupDeps` [ExAny "A"]
1238 , Right $ exAv "D" 1 [ExFix "A" 1] `withSetupDeps` [ExAny "A"]
1239 , Right $ exAv "E" 1 [ExAny "A"] `withSetupDeps` [ExFix "A" 1]
1240 , Right $ exAv "F" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
1243 -- If we install C and D together (not as independent goals), we need to build
1244 -- both B.1 and B.2, both of which depend on A.
1245 db8 :: ExampleDb
1246 db8 =
1247 [ Right $ exAv "A" 1 []
1248 , Right $ exAv "B" 1 [ExAny "A"]
1249 , Right $ exAv "B" 2 [ExAny "A"]
1250 , Right $ exAv "C" 1 [] `withSetupDeps` [ExFix "B" 1]
1251 , Right $ exAv "D" 1 [] `withSetupDeps` [ExFix "B" 2]
1254 -- Extended version of `db8` so that we have nested setup dependencies
1255 db9 :: ExampleDb
1256 db9 =
1258 ++ [ Right $ exAv "E" 1 [ExAny "C"]
1259 , Right $ exAv "E" 2 [ExAny "D"]
1260 , Right $ exAv "F" 1 [] `withSetupDeps` [ExFix "E" 1]
1261 , Right $ exAv "G" 1 [] `withSetupDeps` [ExFix "E" 2]
1264 -- Multiple already-installed packages with inter-dependencies, and one package
1265 -- (C) that depends on package A-1 for its setup script and package A-2 as a
1266 -- library dependency.
1267 db10 :: ExampleDb
1268 db10 =
1269 let rts = exInst "rts" 1 "rts-inst" []
1270 ghc_prim = exInst "ghc-prim" 1 "ghc-prim-inst" [rts]
1271 base = exInst "base" 1 "base-inst" [rts, ghc_prim]
1272 a1 = exInst "A" 1 "A1-inst" [base]
1273 a2 = exInst "A" 2 "A2-inst" [base]
1274 in [ Left rts
1275 , Left ghc_prim
1276 , Left base
1277 , Left a1
1278 , Left a2
1279 , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
1282 -- | This database tests that a package's setup dependencies are correctly
1283 -- linked when the package is linked. See pull request #3268.
1285 -- When A and B are installed as independent goals, their dependencies on C must
1286 -- be linked, due to the single instance restriction. Since C depends on D, 0.D
1287 -- and 1.D must be linked. C also has a setup dependency on D, so 0.C-setup.D
1288 -- and 1.C-setup.D must be linked. However, D's two link groups must remain
1289 -- independent. The solver should be able to choose D-1 for C's library and D-2
1290 -- for C's setup script.
1291 dbSetupDeps :: ExampleDb
1292 dbSetupDeps =
1293 [ Right $ exAv "A" 1 [ExAny "C"]
1294 , Right $ exAv "B" 1 [ExAny "C"]
1295 , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2]
1296 , Right $ exAv "D" 1 []
1297 , Right $ exAv "D" 2 []
1300 -- | Tests for dealing with base shims
1301 db11 :: ExampleDb
1302 db11 =
1303 let base3 = exInst "base" 3 "base-3-inst" [base4]
1304 base4 = exInst "base" 4 "base-4-inst" []
1305 in [ Left base3
1306 , Left base4
1307 , Right $ exAv "A" 1 [ExFix "base" 3]
1310 -- | Slightly more realistic version of db11 where base-3 depends on syb
1311 -- This means that if a package depends on base-3 and on syb, then they MUST
1312 -- share the version of syb
1314 -- * Package A relies on base-3 (which relies on base-4)
1315 -- * Package B relies on base-4
1316 -- * Package C relies on both A and B
1317 -- * Package D relies on base-3 and on syb-2, which is not possible because
1318 -- base-3 has a dependency on syb-1 (non-inheritance of the Base qualifier)
1319 -- * Package E relies on base-4 and on syb-2, which is fine.
1320 db12 :: ExampleDb
1321 db12 =
1322 let base3 = exInst "base" 3 "base-3-inst" [base4, syb1]
1323 base4 = exInst "base" 4 "base-4-inst" []
1324 syb1 = exInst "syb" 1 "syb-1-inst" [base4]
1325 in [ Left base3
1326 , Left base4
1327 , Left syb1
1328 , Right $ exAv "syb" 2 [ExFix "base" 4]
1329 , Right $ exAv "A" 1 [ExFix "base" 3, ExAny "syb"]
1330 , Right $ exAv "B" 1 [ExFix "base" 4, ExAny "syb"]
1331 , Right $ exAv "C" 1 [ExAny "A", ExAny "B"]
1332 , Right $ exAv "D" 1 [ExFix "base" 3, ExFix "syb" 2]
1333 , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2]
1336 -- | A version of db12 where the dependency on base happens via a setup dependency
1338 -- * The setup dependency is solved in it's own qualified scope, so should be solved
1339 -- independently of the rest of the build plan.
1341 -- * The setup dependency depends on `base-3` and hence `syb1`
1343 -- * A depends on `base-4` and `syb-2`, should be fine as the setup stanza should
1344 -- be solved independently.
1345 db12s :: ExampleDb
1346 db12s =
1347 let base3 = exInst "base" 3 "base-3-inst" [base4, syb1]
1348 base4 = exInst "base" 4 "base-4-inst" []
1349 syb1 = exInst "syb" 1 "syb-1-inst" [base4]
1350 in [ Left base3
1351 , Left base4
1352 , Left syb1
1353 , Right $ exAv "syb" 2 [ExFix "base" 4]
1354 , Right $
1355 exAv "A" 1 [ExFix "base" 4, ExFix "syb" 2]
1356 `withSetupDeps` [ExFix "base" 3]
1359 -- | A version of db11 where the dependency on base happens via a setup dependency
1361 -- * The setup dependency is solved in it's own qualified scope, so should be solved
1362 -- independently of the rest of the build plan.
1364 -- * The setup dependency depends on `base-3`
1366 -- * A depends on `base-4`, should be fine as the setup stanza should
1367 -- be solved independently.
1368 db11s :: ExampleDb
1369 db11s =
1370 let base3 = exInst "base" 3 "base-3-inst" [base4]
1371 base4 = exInst "base" 4 "base-4-inst" []
1372 in [ Left base3
1373 , Left base4
1374 , Right $
1375 exAv "A" 1 [ExFix "base" 4]
1376 `withSetupDeps` [ExFix "base" 3]
1379 -- Works without the base-shimness, choosing different versions of base
1380 db11s2 :: ExampleDb
1381 db11s2 =
1382 let base3 = exInst "base" 3 "base-3-inst" []
1383 base4 = exInst "base" 4 "base-4-inst" []
1384 in [ Left base3
1385 , Left base4
1386 , Right $
1387 exAv "A" 1 [ExFix "base" 4]
1388 `withSetupDeps` [ExFix "base" 3]
1391 dbBase :: ExampleDb
1392 dbBase =
1393 [ Right $
1394 exAv
1395 "base"
1397 [ExAny "ghc-prim", ExAny "integer-simple", ExAny "integer-gmp"]
1398 , Right $ exAv "ghc-prim" 1 []
1399 , Right $ exAv "integer-simple" 1 []
1400 , Right $ exAv "integer-gmp" 1 []
1403 dbNonupgrade :: ExampleDb
1404 dbNonupgrade =
1405 [ Left $ exInst "ghc" 1 "ghc-1" []
1406 , Right $ exAv "ghc" 2 []
1407 , Right $ exAv "ghci" 2 []
1408 , Right $ exAv "ghc-boot" 2 []
1409 , Right $ exAv "A" 1 [ExFix "ghc" 2]
1410 , Right $ exAv "B" 1 [ExFix "ghci" 2]
1411 , Right $ exAv "C" 1 [ExFix "ghc-boot" 2]
1414 db13 :: ExampleDb
1415 db13 =
1416 [ Right $ exAv "A" 1 []
1417 , Right $ exAv "A" 2 []
1418 , Right $ exAv "A" 3 []
1421 -- | A, B, and C have three different dependencies on D that can be set to
1422 -- different versions with qualified constraints. Each version of D can only
1423 -- be depended upon by one version of A, B, or C, so that the versions of A, B,
1424 -- and C in the install plan indicate which version of D was chosen for each
1425 -- dependency. The one-to-one correspondence between versions of A, B, and C and
1426 -- versions of D also prevents linking, which would complicate the solver's
1427 -- behavior.
1428 dbConstraints :: ExampleDb
1429 dbConstraints =
1430 [Right $ exAv "A" v [ExFix "D" v] | v <- [1, 4, 7]]
1431 ++ [Right $ exAv "B" v [] `withSetupDeps` [ExFix "D" v] | v <- [2, 5, 8]]
1432 ++ [Right $ exAv "C" v [] `withSetupDeps` [ExFix "D" v] | v <- [3, 6, 9]]
1433 ++ [Right $ exAv "D" v [] | v <- [1 .. 9]]
1435 dbStanzaPreferences1 :: ExampleDb
1436 dbStanzaPreferences1 =
1437 [ Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "test-dep"]
1438 , Right $ exAv "test-dep" 1 []
1441 dbStanzaPreferences2 :: ExampleDb
1442 dbStanzaPreferences2 =
1443 [ Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "unknown"]
1446 -- | This is a test case for a bug in stanza preferences (#3930). The solver
1447 -- should be able to install 'A' by enabling 'flag' and disabling testing. When
1448 -- it tries goals in the specified order and prefers testing, it encounters
1449 -- 'unknown-pkg2'. 'unknown-pkg2' is only introduced by testing and 'flag', so
1450 -- the conflict set should contain both of those variables. Before the fix, it
1451 -- only contained 'flag'. The solver backjumped past the choice to disable
1452 -- testing and failed to find the solution.
1453 testStanzaPreference :: String -> TestTree
1454 testStanzaPreference name =
1455 let pkg =
1456 exAv
1459 [ exFlagged
1460 "flag"
1462 [ExAny "unknown-pkg1"]
1464 `withTest` exTest
1465 "test"
1466 [ exFlagged
1467 "flag"
1468 [ExAny "unknown-pkg2"]
1471 goals =
1472 [ P QualNone "A"
1473 , F QualNone "A" "flag"
1474 , S QualNone "A" TestStanzas
1476 in runTest $
1477 goalOrder goals $
1478 preferences [ExStanzaPref "A" [TestStanzas]] $
1479 mkTest [Right pkg] name ["A"] $
1480 solverSuccess [("A", 1)]
1482 -- | Database with some cycles
1484 -- * Simplest non-trivial cycle: A -> B and B -> A
1485 -- * There is a cycle C -> D -> C, but it can be broken by picking the
1486 -- right flag assignment.
1487 db14 :: ExampleDb
1488 db14 =
1489 [ Right $ exAv "A" 1 [ExAny "B"]
1490 , Right $ exAv "B" 1 [ExAny "A"]
1491 , Right $ exAv "C" 1 [exFlagged "flagC" [ExAny "D"] [ExAny "E"]]
1492 , Right $ exAv "D" 1 [ExAny "C"]
1493 , Right $ exAv "E" 1 []
1496 -- | Cycles through setup dependencies
1498 -- The first cycle is unsolvable: package A has a setup dependency on B,
1499 -- B has a regular dependency on A, and we only have a single version available
1500 -- for both.
1502 -- The second cycle can be broken by picking different versions: package C-2.0
1503 -- has a setup dependency on D, and D has a regular dependency on C-*. However,
1504 -- version C-1.0 is already available (perhaps it didn't have this setup dep).
1505 -- Thus, we should be able to break this cycle even if we are installing package
1506 -- E, which explicitly depends on C-2.0.
1507 db15 :: ExampleDb
1508 db15 =
1509 [ -- First example (real cycle, no solution)
1510 Right $ exAv "A" 1 [] `withSetupDeps` [ExAny "B"]
1511 , Right $ exAv "B" 1 [ExAny "A"]
1512 , -- Second example (cycle can be broken by picking versions carefully)
1513 Left $ exInst "C" 1 "C-1-inst" []
1514 , Right $ exAv "C" 2 [] `withSetupDeps` [ExAny "D"]
1515 , Right $ exAv "D" 1 [ExAny "C"]
1516 , Right $ exAv "E" 1 [ExFix "C" 2]
1519 -- | Detect a cycle between a package and its setup script.
1521 -- This type of cycle can easily occur when v2-build adds default setup
1522 -- dependencies to packages without custom-setup stanzas. For example, cabal
1523 -- adds 'time' as a setup dependency for 'time'. The solver should detect the
1524 -- cycle when it attempts to link the setup and non-setup instances of the
1525 -- package and then choose a different version for the setup dependency.
1526 issue4161 :: String -> SolverTest
1527 issue4161 name =
1528 setVerbose $
1529 mkTest db name ["target"] $
1530 SolverResult checkFullLog $
1531 Right [("target", 1), ("time", 1), ("time", 2)]
1532 where
1533 db :: ExampleDb
1534 db =
1535 [ Right $ exAv "target" 1 [ExFix "time" 2]
1536 , Right $ exAv "time" 2 [] `withSetupDeps` [ExAny "time"]
1537 , Right $ exAv "time" 1 []
1540 checkFullLog :: [String] -> Bool
1541 checkFullLog =
1542 any $
1543 isInfixOf $
1544 "rejecting: time:setup.time~>time-2.0.0 (cyclic dependencies; "
1545 ++ "conflict set: time:setup.time)"
1547 -- | Packages pkg-A, pkg-B, and pkg-C form a cycle. The solver should backtrack
1548 -- as soon as it chooses the last package in the cycle, to avoid searching parts
1549 -- of the tree that have no solution. Since there is no way to break the cycle,
1550 -- it should fail with an error message describing the cycle.
1551 testCyclicDependencyErrorMessages :: String -> SolverTest
1552 testCyclicDependencyErrorMessages name =
1553 goalOrder goals $
1554 mkTest db name ["pkg-A"] $
1555 SolverResult checkFullLog $
1556 Left checkSummarizedLog
1557 where
1558 db :: ExampleDb
1559 db =
1560 [ Right $ exAv "pkg-A" 1 [ExAny "pkg-B"]
1561 , Right $ exAv "pkg-B" 1 [ExAny "pkg-C"]
1562 , Right $ exAv "pkg-C" 1 [ExAny "pkg-A", ExAny "pkg-D"]
1563 , Right $ exAv "pkg-D" 1 [ExAny "pkg-E"]
1564 , Right $ exAv "pkg-E" 1 []
1567 -- The solver should backtrack as soon as pkg-A, pkg-B, and pkg-C form a
1568 -- cycle. It shouldn't try pkg-D or pkg-E.
1569 checkFullLog :: [String] -> Bool
1570 checkFullLog =
1571 not . any (\l -> "pkg-D" `isInfixOf` l || "pkg-E" `isInfixOf` l)
1573 checkSummarizedLog :: String -> Bool
1574 checkSummarizedLog =
1575 isInfixOf "rejecting: pkg-C-1.0.0 (cyclic dependencies; conflict set: pkg-A, pkg-B, pkg-C)"
1577 -- Solve for pkg-D and pkg-E last.
1578 goals :: [ExampleVar]
1579 goals = [P QualNone ("pkg-" ++ [c]) | c <- ['A' .. 'E']]
1581 -- | Check that the solver can backtrack after encountering the SIR (issue #2843)
1583 -- When A and B are installed as independent goals, the single instance
1584 -- restriction prevents B from depending on C. This database tests that the
1585 -- solver can backtrack after encountering the single instance restriction and
1586 -- choose the only valid flag assignment (-flagA +flagB):
1588 -- > flagA flagB B depends on
1589 -- > On _ C-*
1590 -- > Off On E-* <-- only valid flag assignment
1591 -- > Off Off D-2.0, C-*
1593 -- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D,
1594 -- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have
1595 -- C in the transitive closure of B's dependencies, because that would mean we
1596 -- would need two instances of C: one built against D-1.0 and one built against
1597 -- D-2.0.
1598 db16 :: ExampleDb
1599 db16 =
1600 [ Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
1601 , Right $
1602 exAv
1605 [ ExFix "D" 2
1606 , exFlagged
1607 "flagA"
1608 [ExAny "C"]
1609 [ exFlagged
1610 "flagB"
1611 [ExAny "E"]
1612 [ExAny "C"]
1615 , Right $ exAv "C" 1 [ExAny "D"]
1616 , Right $ exAv "D" 1 []
1617 , Right $ exAv "D" 2 []
1618 , Right $ exAv "E" 1 []
1621 -- Try to get the solver to backtrack while satisfying
1622 -- reject-unconstrained-dependencies: both the first and last versions of A
1623 -- require packages outside the closed set, so it will have to try the
1624 -- middle one.
1625 db17 :: ExampleDb
1626 db17 =
1627 [ Right $ exAv "A" 1 [ExAny "C"]
1628 , Right $ exAv "A" 2 [ExAny "B"]
1629 , Right $ exAv "A" 3 [ExAny "C"]
1630 , Right $ exAv "B" 1 []
1631 , Right $ exAv "C" 1 [ExAny "B"]
1634 -- | This test checks that when the solver discovers a constraint on a
1635 -- package's version after choosing to link that package, it can backtrack to
1636 -- try alternative versions for the linked-to package. See pull request #3327.
1638 -- When A and B are installed as independent goals, their dependencies on C
1639 -- must be linked. Since C depends on D, A and B's dependencies on D must also
1640 -- be linked. This test fixes the goal order so that the solver chooses D-2 for
1641 -- both 0.D and 1.D before it encounters the test suites' constraints. The
1642 -- solver must backtrack to try D-1 for both 0.D and 1.D.
1643 testIndepGoals2 :: String -> SolverTest
1644 testIndepGoals2 name =
1645 goalOrder goals $
1646 independentGoals $
1647 enableAllTests $
1648 mkTest db name ["A", "B"] $
1649 solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]
1650 where
1651 db :: ExampleDb
1652 db =
1653 [ Right $ exAv "A" 1 [ExAny "C"] `withTest` exTest "test" [ExFix "D" 1]
1654 , Right $ exAv "B" 1 [ExAny "C"] `withTest` exTest "test" [ExFix "D" 1]
1655 , Right $ exAv "C" 1 [ExAny "D"]
1656 , Right $ exAv "D" 1 []
1657 , Right $ exAv "D" 2 []
1660 goals :: [ExampleVar]
1661 goals =
1662 [ P (QualIndep "A") "A"
1663 , P (QualIndep "A") "C"
1664 , P (QualIndep "A") "D"
1665 , P (QualIndep "B") "B"
1666 , P (QualIndep "B") "C"
1667 , P (QualIndep "B") "D"
1668 , S (QualIndep "B") "B" TestStanzas
1669 , S (QualIndep "A") "A" TestStanzas
1672 -- | Issue #2834
1673 -- When both A and B are installed as independent goals, their dependencies on
1674 -- C must be linked. The only combination of C's flags that is consistent with
1675 -- A and B's dependencies on D is -flagA +flagB. This database tests that the
1676 -- solver can backtrack to find the right combination of flags (requiring F, but
1677 -- not E or G) and apply it to both 0.C and 1.C.
1679 -- > flagA flagB C depends on
1680 -- > On _ D-1, E-*
1681 -- > Off On F-* <-- Only valid choice
1682 -- > Off Off D-2, G-*
1684 -- The single instance restriction means we cannot have one instance of C
1685 -- built against D-1 and one instance built against D-2; since A depends on
1686 -- D-1, and B depends on C-2, it is therefore important that C cannot depend
1687 -- on any version of D.
1688 db18 :: ExampleDb
1689 db18 =
1690 [ Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
1691 , Right $ exAv "B" 1 [ExAny "C", ExFix "D" 2]
1692 , Right $
1693 exAv
1696 [ exFlagged
1697 "flagA"
1698 [ExFix "D" 1, ExAny "E"]
1699 [ exFlagged
1700 "flagB"
1701 [ExAny "F"]
1702 [ExFix "D" 2, ExAny "G"]
1705 , Right $ exAv "D" 1 []
1706 , Right $ exAv "D" 2 []
1707 , Right $ exAv "E" 1 []
1708 , Right $ exAv "F" 1 []
1709 , Right $ exAv "G" 1 []
1712 -- | When both values for flagA introduce package B, the solver should be able
1713 -- to choose B before choosing a value for flagA. It should try to choose a
1714 -- version for B that is in the union of the version ranges required by +flagA
1715 -- and -flagA.
1716 commonDependencyLogMessage :: String -> SolverTest
1717 commonDependencyLogMessage name =
1718 mkTest db name ["A"] $
1719 solverFailure $
1720 isInfixOf $
1721 "[__0] trying: A-1.0.0 (user goal)\n"
1722 ++ "[__1] next goal: B (dependency of A +/-flagA)\n"
1723 ++ "[__1] rejecting: B-2.0.0 (conflict: A +/-flagA => B==1.0.0 || ==3.0.0)"
1724 where
1725 db :: ExampleDb
1726 db =
1727 [ Right $
1728 exAv
1731 [ exFlagged
1732 "flagA"
1733 [ExFix "B" 1]
1734 [ExFix "B" 3]
1736 , Right $ exAv "B" 2 []
1739 -- | Test lifting dependencies out of multiple levels of conditionals.
1740 twoLevelDeepCommonDependencyLogMessage :: String -> SolverTest
1741 twoLevelDeepCommonDependencyLogMessage name =
1742 mkTest db name ["A"] $
1743 solverFailure $
1744 isInfixOf $
1745 "unknown package: B (dependency of A +/-flagA +/-flagB)"
1746 where
1747 db :: ExampleDb
1748 db =
1749 [ Right $
1750 exAv
1753 [ exFlagged
1754 "flagA"
1755 [ exFlagged
1756 "flagB"
1757 [ExAny "B"]
1758 [ExAny "B"]
1760 [ exFlagged
1761 "flagB"
1762 [ExAny "B"]
1763 [ExAny "B"]
1768 -- | Test handling nested conditionals that are controlled by the same flag.
1769 -- The solver should treat flagA as introducing 'unknown' with value true, not
1770 -- both true and false. That means that when +flagA causes a conflict, the
1771 -- solver should try flipping flagA to false to resolve the conflict, rather
1772 -- than backjumping past flagA.
1773 testBackjumpingWithCommonDependency :: String -> SolverTest
1774 testBackjumpingWithCommonDependency name =
1775 mkTest db name ["A"] $ solverSuccess [("A", 1), ("B", 1)]
1776 where
1777 db :: ExampleDb
1778 db =
1779 [ Right $
1780 exAv
1783 [ exFlagged
1784 "flagA"
1785 [ exFlagged
1786 "flagA"
1787 [ExAny "unknown"]
1788 [ExAny "unknown"]
1790 [ExAny "B"]
1792 , Right $ exAv "B" 1 []
1795 -- | Tricky test case with independent goals (issue #2842)
1797 -- Suppose we are installing D, E, and F as independent goals:
1799 -- * D depends on A-* and C-1, requiring A-1 to be built against C-1
1800 -- * E depends on B-* and C-2, requiring B-1 to be built against C-2
1801 -- * F depends on A-* and B-*; this means we need A-1 and B-1 both to be built
1802 -- against the same version of C, violating the single instance restriction.
1804 -- We can visualize this DB as:
1806 -- > C-1 C-2
1807 -- > /|\ /|\
1808 -- > / | \ / | \
1809 -- > / | X | \
1810 -- > | | / \ | |
1811 -- > | |/ \| |
1812 -- > | + + |
1813 -- > | | | |
1814 -- > | A B |
1815 -- > \ |\ /| /
1816 -- > \ | \ / | /
1817 -- > \| V |/
1818 -- > D F E
1819 testIndepGoals3 :: String -> SolverTest
1820 testIndepGoals3 name =
1821 goalOrder goals $
1822 independentGoals $
1823 mkTest db name ["D", "E", "F"] anySolverFailure
1824 where
1825 db :: ExampleDb
1826 db =
1827 [ Right $ exAv "A" 1 [ExAny "C"]
1828 , Right $ exAv "B" 1 [ExAny "C"]
1829 , Right $ exAv "C" 1 []
1830 , Right $ exAv "C" 2 []
1831 , Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1]
1832 , Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2]
1833 , Right $ exAv "F" 1 [ExAny "A", ExAny "B"]
1836 goals :: [ExampleVar]
1837 goals =
1838 [ P (QualIndep "D") "D"
1839 , P (QualIndep "D") "C"
1840 , P (QualIndep "D") "A"
1841 , P (QualIndep "E") "E"
1842 , P (QualIndep "E") "C"
1843 , P (QualIndep "E") "B"
1844 , P (QualIndep "F") "F"
1845 , P (QualIndep "F") "B"
1846 , P (QualIndep "F") "C"
1847 , P (QualIndep "F") "A"
1850 -- | This test checks that the solver correctly backjumps when dependencies
1851 -- of linked packages are not linked. It is an example where the conflict set
1852 -- from enforcing the single instance restriction is not sufficient. See pull
1853 -- request #3327.
1855 -- When A, B, and C are installed as independent goals with the specified goal
1856 -- order, the first choice that the solver makes for E is 0.E-2. Then, when it
1857 -- chooses dependencies for B and C, it links both 1.E and 2.E to 0.E. Finally,
1858 -- the solver discovers C's test's constraint on E. It must backtrack to try
1859 -- 1.E-1 and then link 2.E to 1.E. Backjumping all the way to 0.E does not lead
1860 -- to a solution, because 0.E's version is constrained by A and cannot be
1861 -- changed.
1862 testIndepGoals4 :: String -> SolverTest
1863 testIndepGoals4 name =
1864 goalOrder goals $
1865 independentGoals $
1866 enableAllTests $
1867 mkTest db name ["A", "B", "C"] $
1868 solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("E", 1), ("E", 2)]
1869 where
1870 db :: ExampleDb
1871 db =
1872 [ Right $ exAv "A" 1 [ExFix "E" 2]
1873 , Right $ exAv "B" 1 [ExAny "D"]
1874 , Right $ exAv "C" 1 [ExAny "D"] `withTest` exTest "test" [ExFix "E" 1]
1875 , Right $ exAv "D" 1 [ExAny "E"]
1876 , Right $ exAv "E" 1 []
1877 , Right $ exAv "E" 2 []
1880 goals :: [ExampleVar]
1881 goals =
1882 [ P (QualIndep "A") "A"
1883 , P (QualIndep "A") "E"
1884 , P (QualIndep "B") "B"
1885 , P (QualIndep "B") "D"
1886 , P (QualIndep "B") "E"
1887 , P (QualIndep "C") "C"
1888 , P (QualIndep "C") "D"
1889 , P (QualIndep "C") "E"
1890 , S (QualIndep "C") "C" TestStanzas
1893 -- | Test the trace messages that we get when a package refers to an unknown pkg
1895 -- TODO: Currently we don't actually test the trace messages, and this particular
1896 -- test still succeeds. The trace can only be verified by hand.
1897 db21 :: ExampleDb
1898 db21 =
1899 [ Right $ exAv "A" 1 [ExAny "B"]
1900 , Right $ exAv "A" 2 [ExAny "C"] -- A-2.0 will be tried first, but C unknown
1901 , Right $ exAv "B" 1 []
1904 -- | A variant of 'db21', which actually fails.
1905 db22 :: ExampleDb
1906 db22 =
1907 [ Right $ exAv "A" 1 [ExAny "B"]
1908 , Right $ exAv "A" 2 [ExAny "C"]
1911 -- | Another test for the unknown package message. This database tests that
1912 -- filtering out redundant conflict set messages in the solver log doesn't
1913 -- interfere with generating a message about a missing package (part of issue
1914 -- #3617). The conflict set for the missing package is {A, B}. That conflict set
1915 -- is propagated up the tree to the level of A. Since the conflict set is the
1916 -- same at both levels, the solver only keeps one of the backjumping messages.
1917 db23 :: ExampleDb
1918 db23 =
1919 [ Right $ exAv "A" 1 [ExAny "B"]
1922 -- | Database for (unsuccessfully) trying to expose a bug in the handling
1923 -- of implied linking constraints. The question is whether an implied linking
1924 -- constraint should only have the introducing package in its conflict set,
1925 -- or also its link target.
1927 -- It turns out that as long as the Single Instance Restriction is in place,
1928 -- it does not matter, because there will always be an option that is failing
1929 -- due to the SIR, which contains the link target in its conflict set.
1931 -- Even if the SIR is not in place, if there is a solution, one will always
1932 -- be found, because without the SIR, linking is always optional, but never
1933 -- necessary.
1934 testIndepGoals5 :: String -> GoalOrder -> SolverTest
1935 testIndepGoals5 name fixGoalOrder =
1936 case fixGoalOrder of
1937 FixedGoalOrder -> goalOrder goals test
1938 DefaultGoalOrder -> test
1939 where
1940 test :: SolverTest
1941 test =
1942 independentGoals $
1943 mkTest db name ["X", "Y"] $
1944 solverSuccess
1945 [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)]
1947 db :: ExampleDb
1948 db =
1949 [ Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"]
1950 , Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2]
1951 , Right $ exAv "A" 1 []
1952 , Right $ exAv "A" 2 [ExAny "B"]
1953 , Right $ exAv "B" 1 [ExAny "C"]
1954 , Right $ exAv "C" 1 []
1955 , Right $ exAv "C" 2 []
1958 goals :: [ExampleVar]
1959 goals =
1960 [ P (QualIndep "X") "X"
1961 , P (QualIndep "X") "A"
1962 , P (QualIndep "X") "B"
1963 , P (QualIndep "X") "C"
1964 , P (QualIndep "Y") "Y"
1965 , P (QualIndep "Y") "A"
1966 , P (QualIndep "Y") "B"
1967 , P (QualIndep "Y") "C"
1970 -- | A simplified version of 'testIndepGoals5'.
1971 testIndepGoals6 :: String -> GoalOrder -> SolverTest
1972 testIndepGoals6 name fixGoalOrder =
1973 case fixGoalOrder of
1974 FixedGoalOrder -> goalOrder goals test
1975 DefaultGoalOrder -> test
1976 where
1977 test :: SolverTest
1978 test =
1979 independentGoals $
1980 mkTest db name ["X", "Y"] $
1981 solverSuccess
1982 [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)]
1984 db :: ExampleDb
1985 db =
1986 [ Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"]
1987 , Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2]
1988 , Right $ exAv "A" 1 []
1989 , Right $ exAv "A" 2 [ExAny "B"]
1990 , Right $ exAv "B" 1 []
1991 , Right $ exAv "B" 2 []
1994 goals :: [ExampleVar]
1995 goals =
1996 [ P (QualIndep "X") "X"
1997 , P (QualIndep "X") "A"
1998 , P (QualIndep "X") "B"
1999 , P (QualIndep "Y") "Y"
2000 , P (QualIndep "Y") "A"
2001 , P (QualIndep "Y") "B"
2004 dbExts1 :: ExampleDb
2005 dbExts1 =
2006 [ Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)]
2007 , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"]
2008 , Right $ exAv "C" 1 [ExAny "B"]
2009 , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"]
2010 , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"]
2013 dbLangs1 :: ExampleDb
2014 dbLangs1 =
2015 [ Right $ exAv "A" 1 [ExLang Haskell2010]
2016 , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"]
2017 , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"]
2020 -- This test checks how the scope of a constraint interacts with qualified goals.
2021 -- If you specify `A == 2`, that top-level should /not/ apply to an independent goal!
2022 testIndepGoals7 :: String -> SolverTest
2023 testIndepGoals7 name =
2024 constraints [ExVersionConstraint (scopeToplevel "A") (V.thisVersion (V.mkVersion [2, 0, 0]))] $
2025 independentGoals $
2026 mkTest dbIndepGoals78 name ["A"] $
2027 -- The more recent version should be picked by the solver. As said
2028 -- above, the top-level A==2 should not apply to an independent goal.
2029 solverSuccess [("A", 3)]
2031 dbIndepGoals78 :: ExampleDb
2032 dbIndepGoals78 =
2033 [ Right $ exAv "A" 1 []
2034 , Right $ exAv "A" 2 []
2035 , Right $ exAv "A" 3 []
2038 -- This test checks how the scope of a constraint interacts with qualified goals.
2039 -- If you specify `any.A == 2`, then that should apply inside an independent goal.
2040 testIndepGoals8 :: String -> SolverTest
2041 testIndepGoals8 name =
2042 constraints [ExVersionConstraint (ScopeAnyQualifier "A") (V.thisVersion (V.mkVersion [2, 0, 0]))] $
2043 independentGoals $
2044 mkTest dbIndepGoals78 name ["A"] $
2045 solverSuccess [("A", 2)]
2047 -- | cabal must set enable-exe to false in order to avoid the unavailable
2048 -- dependency. Flags are true by default. The flag choice causes "pkg" to
2049 -- depend on "false-dep".
2050 testBuildable :: String -> ExampleDependency -> TestTree
2051 testBuildable testName unavailableDep =
2052 runTest $
2053 mkTestExtLangPC (Just []) (Just [Haskell98]) (Just []) db testName ["pkg"] expected
2054 where
2055 expected = solverSuccess [("false-dep", 1), ("pkg", 1)]
2056 db =
2057 [ Right $
2058 exAv
2059 "pkg"
2061 [ exFlagged
2062 "enable-exe"
2063 [ExAny "true-dep"]
2064 [ExAny "false-dep"]
2066 `withExe` exExe
2067 "exe"
2068 [ unavailableDep
2069 , ExFlagged "enable-exe" (dependencies []) unbuildableDependencies
2071 , Right $ exAv "true-dep" 1 []
2072 , Right $ exAv "false-dep" 1 []
2075 -- | cabal must choose -flag1 +flag2 for "pkg", which requires packages
2076 -- "flag1-false" and "flag2-true".
2077 dbBuildable1 :: ExampleDb
2078 dbBuildable1 =
2079 [ Right $
2080 exAv
2081 "pkg"
2083 [ exFlagged "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"]
2084 , exFlagged "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]
2086 `withExes` [ exExe
2087 "exe1"
2088 [ ExAny "unknown"
2089 , ExFlagged "flag1" (dependencies []) unbuildableDependencies
2090 , ExFlagged "flag2" (dependencies []) unbuildableDependencies
2092 , exExe
2093 "exe2"
2094 [ ExAny "unknown"
2095 , ExFlagged
2096 "flag1"
2097 (dependencies [])
2098 (dependencies [ExFlagged "flag2" unbuildableDependencies (dependencies [])])
2101 , Right $ exAv "flag1-true" 1 []
2102 , Right $ exAv "flag1-false" 1 []
2103 , Right $ exAv "flag2-true" 1 []
2104 , Right $ exAv "flag2-false" 1 []
2107 -- | cabal must pick B-2 to avoid the unknown dependency.
2108 dbBuildable2 :: ExampleDb
2109 dbBuildable2 =
2110 [ Right $ exAv "A" 1 [ExAny "B"]
2111 , Right $ exAv "B" 1 [ExAny "unknown"]
2112 , Right $
2113 exAv "B" 2 []
2114 `withExe` exExe
2115 "exe"
2116 [ ExAny "unknown"
2117 , ExFlagged "disable-exe" unbuildableDependencies (dependencies [])
2119 , Right $ exAv "B" 3 [ExAny "unknown"]
2122 -- | Package databases for testing @pkg-config@ dependencies.
2123 -- when no pkgconfig db is present, cabal must pick flag1 false and flag2 true to avoid the pkg dependency.
2124 dbPC1 :: ExampleDb
2125 dbPC1 =
2126 [ Right $ exAv "A" 1 [ExPkg ("pkgA", 1)]
2127 , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"]
2128 , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"]
2129 , Right $ exAv "C" 1 [ExAny "B"]
2130 , Right $ exAv "D" 1 [exFlagged "flag1" [ExAny "A"] [], exFlagged "flag2" [] [ExAny "A"]]
2133 -- | Test for the solver's summarized log. The final conflict set is {A, F},
2134 -- though the goal order forces the solver to find the (avoidable) conflict
2135 -- between B and C first. When the solver reaches the backjump limit, it should
2136 -- only show the log to the first conflict. When the backjump limit is high
2137 -- enough to allow an exhaustive search, the solver should make use of the final
2138 -- conflict set to only show the conflict between A and F in the summarized log.
2139 testSummarizedLog :: String -> Maybe Int -> String -> TestTree
2140 testSummarizedLog testName mbj expectedMsg =
2141 runTest $
2142 maxBackjumps mbj $
2143 goalOrder goals $
2144 mkTest db testName ["A"] $
2145 solverFailure (== expectedMsg)
2146 where
2147 db =
2148 [ Right $ exAv "A" 1 [ExAny "B", ExAny "F"]
2149 , Right $ exAv "B" 3 [ExAny "C"]
2150 , Right $ exAv "B" 2 [ExAny "D"]
2151 , Right $ exAv "B" 1 [ExAny "E"]
2152 , Right $ exAv "E" 1 []
2155 goals :: [ExampleVar]
2156 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D", "E", "F"]]
2158 dbMinimizeConflictSet :: ExampleDb
2159 dbMinimizeConflictSet =
2160 [ Right $ exAv "A" 3 [ExFix "B" 2, ExFix "C" 1, ExFix "D" 2]
2161 , Right $ exAv "A" 2 [ExFix "B" 1, ExFix "C" 2, ExFix "D" 2]
2162 , Right $ exAv "A" 1 [ExFix "B" 1, ExFix "C" 1, ExFix "D" 2]
2163 , Right $ exAv "B" 1 []
2164 , Right $ exAv "C" 1 []
2165 , Right $ exAv "D" 1 []
2168 -- | Test that the solver can find a minimal conflict set with
2169 -- --minimize-conflict-set. In the first run, the goal order causes the solver
2170 -- to find that A-3 conflicts with B, A-2 conflicts with C, and A-1 conflicts
2171 -- with D. The full log should show that the original final conflict set is
2172 -- {A, B, C, D}. Then the solver should be able to reduce the conflict set to
2173 -- {A, D}, since all versions of A conflict with D. The summarized log should
2174 -- only mention A and D.
2175 testMinimizeConflictSet :: String -> TestTree
2176 testMinimizeConflictSet testName =
2177 runTest $
2178 minimizeConflictSet $
2179 goalOrder goals $
2180 setVerbose $
2181 mkTest dbMinimizeConflictSet testName ["A"] $
2182 SolverResult checkFullLog (Left (== expectedMsg))
2183 where
2184 checkFullLog :: [String] -> Bool
2185 checkFullLog =
2186 containsInOrder
2187 [ "[__0] fail (backjumping, conflict set: A, B, C, D)"
2188 , "Found no solution after exhaustively searching the dependency tree. "
2189 ++ "Rerunning the dependency solver to minimize the conflict set ({A, B, C, D})."
2190 , "Trying to remove variable \"A\" from the conflict set."
2191 , "Failed to remove \"A\" from the conflict set. Continuing with {A, B, C, D}."
2192 , "Trying to remove variable \"B\" from the conflict set."
2193 , "Successfully removed \"B\" from the conflict set. Continuing with {A, D}."
2194 , "Trying to remove variable \"D\" from the conflict set."
2195 , "Failed to remove \"D\" from the conflict set. Continuing with {A, D}."
2198 expectedMsg =
2199 "Could not resolve dependencies:\n"
2200 ++ "[__0] trying: A-3.0.0 (user goal)\n"
2201 ++ "[__1] next goal: D (dependency of A)\n"
2202 ++ "[__1] rejecting: D-1.0.0 (conflict: A => D==2.0.0)\n"
2203 ++ "[__1] fail (backjumping, conflict set: A, D)\n"
2204 ++ "After searching the rest of the dependency tree exhaustively, these "
2205 ++ "were the goals I've had most trouble fulfilling: A (5), D (4)"
2207 goals :: [ExampleVar]
2208 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
2210 -- | This test uses the same packages and goal order as testMinimizeConflictSet,
2211 -- but it doesn't set --minimize-conflict-set. The solver should print the
2212 -- original final conflict set and the conflict between A and B. It should also
2213 -- suggest rerunning with --minimize-conflict-set.
2214 testNoMinimizeConflictSet :: String -> TestTree
2215 testNoMinimizeConflictSet testName =
2216 runTest $
2217 goalOrder goals $
2218 setVerbose $
2219 mkTest dbMinimizeConflictSet testName ["A"] $
2220 solverFailure (== expectedMsg)
2221 where
2222 expectedMsg =
2223 "Could not resolve dependencies:\n"
2224 ++ "[__0] trying: A-3.0.0 (user goal)\n"
2225 ++ "[__1] next goal: B (dependency of A)\n"
2226 ++ "[__1] rejecting: B-1.0.0 (conflict: A => B==2.0.0)\n"
2227 ++ "[__1] fail (backjumping, conflict set: A, B)\n"
2228 ++ "After searching the rest of the dependency tree exhaustively, "
2229 ++ "these were the goals I've had most trouble fulfilling: "
2230 ++ "A (7), B (2), C (2), D (2)\n"
2231 ++ "Try running with --minimize-conflict-set to improve the error message."
2233 goals :: [ExampleVar]
2234 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]]
2236 {-------------------------------------------------------------------------------
2237 Simple databases for the illustrations for the backjumping blog post
2238 -------------------------------------------------------------------------------}
2240 -- | Motivate conflict sets
2241 dbBJ1a :: ExampleDb
2242 dbBJ1a =
2243 [ Right $ exAv "A" 1 [ExFix "B" 1]
2244 , Right $ exAv "A" 2 [ExFix "B" 2]
2245 , Right $ exAv "B" 1 []
2248 -- | Show that we can skip some decisions
2249 dbBJ1b :: ExampleDb
2250 dbBJ1b =
2251 [ Right $ exAv "A" 1 [ExFix "B" 1]
2252 , Right $ exAv "A" 2 [ExFix "B" 2, ExAny "C"]
2253 , Right $ exAv "B" 1 []
2254 , Right $ exAv "C" 1 []
2255 , Right $ exAv "C" 2 []
2258 -- | Motivate why both A and B need to be in the conflict set
2259 dbBJ1c :: ExampleDb
2260 dbBJ1c =
2261 [ Right $ exAv "A" 1 [ExFix "B" 1]
2262 , Right $ exAv "B" 1 []
2263 , Right $ exAv "B" 2 []
2266 -- | Motivate the need for accumulating conflict sets while we walk the tree
2267 dbBJ2 :: ExampleDb
2268 dbBJ2 =
2269 [ Right $ exAv "A" 1 [ExFix "B" 1]
2270 , Right $ exAv "A" 2 [ExFix "B" 2]
2271 , Right $ exAv "B" 1 [ExFix "C" 1]
2272 , Right $ exAv "B" 2 [ExFix "C" 2]
2273 , Right $ exAv "C" 1 []
2276 -- | Motivate the need for `QGoalReason`
2277 dbBJ3 :: ExampleDb
2278 dbBJ3 =
2279 [ Right $ exAv "A" 1 [ExAny "Ba"]
2280 , Right $ exAv "A" 2 [ExAny "Bb"]
2281 , Right $ exAv "Ba" 1 [ExFix "C" 1]
2282 , Right $ exAv "Bb" 1 [ExFix "C" 2]
2283 , Right $ exAv "C" 1 []
2286 -- | `QGOalReason` not unique
2287 dbBJ4 :: ExampleDb
2288 dbBJ4 =
2289 [ Right $ exAv "A" 1 [ExAny "B", ExAny "C"]
2290 , Right $ exAv "B" 1 [ExAny "C"]
2291 , Right $ exAv "C" 1 []
2294 -- | Flags are represented somewhat strangely in the tree
2296 -- This example probably won't be in the blog post itself but as a separate
2297 -- bug report (#3409)
2298 dbBJ5 :: ExampleDb
2299 dbBJ5 =
2300 [ Right $ exAv "A" 1 [exFlagged "flagA" [ExFix "B" 1] [ExFix "C" 1]]
2301 , Right $ exAv "B" 1 [ExFix "D" 1]
2302 , Right $ exAv "C" 1 [ExFix "D" 2]
2303 , Right $ exAv "D" 1 []
2306 -- | Conflict sets for cycles
2307 dbBJ6 :: ExampleDb
2308 dbBJ6 =
2309 [ Right $ exAv "A" 1 [ExAny "B"]
2310 , Right $ exAv "B" 1 []
2311 , Right $ exAv "B" 2 [ExAny "C"]
2312 , Right $ exAv "C" 1 [ExAny "A"]
2315 -- | Conflicts not unique
2316 dbBJ7 :: ExampleDb
2317 dbBJ7 =
2318 [ Right $ exAv "A" 1 [ExAny "B", ExFix "C" 1]
2319 , Right $ exAv "B" 1 [ExFix "C" 1]
2320 , Right $ exAv "C" 1 []
2321 , Right $ exAv "C" 2 []
2324 -- | Conflict sets for SIR (C shared subgoal of independent goals A, B)
2325 dbBJ8 :: ExampleDb
2326 dbBJ8 =
2327 [ Right $ exAv "A" 1 [ExAny "C"]
2328 , Right $ exAv "B" 1 [ExAny "C"]
2329 , Right $ exAv "C" 1 []
2332 {-------------------------------------------------------------------------------
2333 Databases for build-tool-depends
2334 -------------------------------------------------------------------------------}
2336 -- | Multiple packages depending on exes from 'bt-pkg'.
2337 dbBuildTools :: ExampleDb
2338 dbBuildTools =
2339 [ Right $ exAv "A" 1 [ExBuildToolAny "bt-pkg" "exe1"]
2340 , Right $
2341 exAv
2344 [ exFlagged
2345 "flagB"
2346 [ExAny "unknown"]
2347 [ExBuildToolAny "bt-pkg" "exe1"]
2349 , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExBuildToolAny "bt-pkg" "exe1"]
2350 , Right $ exAv "D" 1 [ExBuildToolAny "bt-pkg" "unknown-exe"]
2351 , Right $ exAv "E" 1 [ExBuildToolAny "unknown-pkg" "exe1"]
2352 , Right $
2353 exAv
2356 [ exFlagged
2357 "flagF"
2358 [ExBuildToolAny "bt-pkg" "unknown-exe"]
2359 [ExAny "unknown"]
2361 , Right $ exAv "G" 1 [] `withTest` exTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"]
2362 , Right $ exAv "H" 1 [ExBuildToolFix "bt-pkg" "exe1" 3]
2363 , Right $ exAv "bt-pkg" 4 []
2364 , Right $ exAv "bt-pkg" 3 [] `withExe` exExe "exe2" []
2365 , Right $ exAv "bt-pkg" 2 [] `withExe` exExe "exe1" []
2366 , Right $ exAv "bt-pkg" 1 []
2369 -- The solver should never choose an installed package for a build tool
2370 -- dependency.
2371 rejectInstalledBuildToolPackage :: String -> SolverTest
2372 rejectInstalledBuildToolPackage name =
2373 mkTest db name ["A"] $
2374 solverFailure $
2375 isInfixOf $
2376 "rejecting: A:B:exe.B-1.0.0/installed-1 "
2377 ++ "(does not contain executable 'exe', which is required by A)"
2378 where
2379 db :: ExampleDb
2380 db =
2381 [ Right $ exAv "A" 1 [ExBuildToolAny "B" "exe"]
2382 , Left $ exInst "B" 1 "B-1" []
2385 -- | This test forces the solver to choose B as a build-tool dependency before
2386 -- it sees the dependency on executable exe2 from B. The solver needs to check
2387 -- that the version that it already chose for B contains the necessary
2388 -- executable. This order causes a different "missing executable" error message
2389 -- than when the solver checks for the executable in the same step that it
2390 -- chooses the build-tool package.
2392 -- This case may become impossible if we ever add the executable name to the
2393 -- build-tool goal qualifier. Then this test would involve two qualified goals
2394 -- for B, one for exe1 and another for exe2.
2395 chooseExeAfterBuildToolsPackage :: Bool -> String -> SolverTest
2396 chooseExeAfterBuildToolsPackage shouldSucceed name =
2397 goalOrder goals $
2398 mkTest db name ["A"] $
2399 if shouldSucceed
2400 then solverSuccess [("A", 1), ("B", 1)]
2401 else
2402 solverFailure $
2403 isInfixOf $
2404 "rejecting: A:+flagA (requires executable 'exe2' from A:B:exe.B, "
2405 ++ "but the component does not exist)"
2406 where
2407 db :: ExampleDb
2408 db =
2409 [ Right $
2410 exAv
2413 [ ExBuildToolAny "B" "exe1"
2414 , exFlagged
2415 "flagA"
2416 [ExBuildToolAny "B" "exe2"]
2417 [ExAny "unknown"]
2419 , Right $
2420 exAv "B" 1 []
2421 `withExes` [exExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]]
2424 goals :: [ExampleVar]
2425 goals =
2426 [ P QualNone "A"
2427 , P (QualExe "A" "B") "B"
2428 , F QualNone "A" "flagA"
2431 -- | Test that when one package depends on two executables from another package,
2432 -- both executables must come from the same instance of that package. We could
2433 -- lift this restriction in the future by adding the executable name to the goal
2434 -- qualifier.
2435 requireConsistentBuildToolVersions :: String -> SolverTest
2436 requireConsistentBuildToolVersions name =
2437 mkTest db name ["A"] $
2438 solverFailure $
2439 isInfixOf $
2440 "[__1] rejecting: A:B:exe.B-2.0.0 (conflict: A => A:B:exe.B (exe exe1)==1.0.0)\n"
2441 ++ "[__1] rejecting: A:B:exe.B-1.0.0 (conflict: A => A:B:exe.B (exe exe2)==2.0.0)"
2442 where
2443 db :: ExampleDb
2444 db =
2445 [ Right $
2446 exAv
2449 [ ExBuildToolFix "B" "exe1" 1
2450 , ExBuildToolFix "B" "exe2" 2
2452 , Right $ exAv "B" 2 [] `withExes` exes
2453 , Right $ exAv "B" 1 [] `withExes` exes
2456 exes = [exExe "exe1" [], exExe "exe2" []]
2458 -- | This test is similar to the failure case for
2459 -- chooseExeAfterBuildToolsPackage, except that the build tool is unbuildable
2460 -- instead of missing.
2461 chooseUnbuildableExeAfterBuildToolsPackage :: String -> SolverTest
2462 chooseUnbuildableExeAfterBuildToolsPackage name =
2463 constraints [ExFlagConstraint (ScopeAnyQualifier "B") "build-bt2" False] $
2464 goalOrder goals $
2465 mkTest db name ["A"] $
2466 solverFailure $
2467 isInfixOf $
2468 "rejecting: A:+use-bt2 (requires executable 'bt2' from A:B:exe.B, but "
2469 ++ "the component is not buildable in the current environment)"
2470 where
2471 db :: ExampleDb
2472 db =
2473 [ Right $
2474 exAv
2477 [ ExBuildToolAny "B" "bt1"
2478 , exFlagged
2479 "use-bt2"
2480 [ExBuildToolAny "B" "bt2"]
2481 [ExAny "unknown"]
2483 , Right $
2484 exAvNoLibrary "B" 1
2485 `withExes` [ exExe "bt1" []
2486 , exExe "bt2" [ExFlagged "build-bt2" (dependencies []) unbuildableDependencies]
2490 goals :: [ExampleVar]
2491 goals =
2492 [ P QualNone "A"
2493 , P (QualExe "A" "B") "B"
2494 , F QualNone "A" "use-bt2"
2497 {-------------------------------------------------------------------------------
2498 Databases for legacy build-tools
2499 -------------------------------------------------------------------------------}
2500 dbLegacyBuildTools1 :: ExampleDb
2501 dbLegacyBuildTools1 =
2502 [ Right $ exAv "alex" 1 [] `withExe` exExe "alex" []
2503 , Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"]
2506 -- Test that a recognized build tool dependency specifies the name of both the
2507 -- package and the executable. This db has no solution.
2508 dbLegacyBuildTools2 :: ExampleDb
2509 dbLegacyBuildTools2 =
2510 [ Right $ exAv "alex" 1 [] `withExe` exExe "other-exe" []
2511 , Right $ exAv "other-package" 1 [] `withExe` exExe "alex" []
2512 , Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"]
2515 -- Test that build-tools on a random thing doesn't matter (only
2516 -- the ones we recognize need to be in db)
2517 dbLegacyBuildTools3 :: ExampleDb
2518 dbLegacyBuildTools3 =
2519 [ Right $ exAv "A" 1 [ExLegacyBuildToolAny "otherdude"]
2522 -- Test that we can solve for different versions of executables
2523 dbLegacyBuildTools4 :: ExampleDb
2524 dbLegacyBuildTools4 =
2525 [ Right $ exAv "alex" 1 [] `withExe` exExe "alex" []
2526 , Right $ exAv "alex" 2 [] `withExe` exExe "alex" []
2527 , Right $ exAv "A" 1 [ExLegacyBuildToolFix "alex" 1]
2528 , Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 2]
2529 , Right $ exAv "C" 1 [ExAny "A", ExAny "B"]
2532 -- Test that exe is not related to library choices
2533 dbLegacyBuildTools5 :: ExampleDb
2534 dbLegacyBuildTools5 =
2535 [ Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` exExe "alex" []
2536 , Right $ exAv "A" 1 []
2537 , Right $ exAv "A" 2 []
2538 , Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 1, ExFix "A" 2]
2541 -- Test that build-tools on build-tools works
2542 dbLegacyBuildTools6 :: ExampleDb
2543 dbLegacyBuildTools6 =
2544 [ Right $ exAv "alex" 1 [] `withExe` exExe "alex" []
2545 , Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` exExe "happy" []
2546 , Right $ exAv "A" 1 [ExLegacyBuildToolAny "happy"]
2549 -- Test that build-depends on library/executable package works.
2550 -- Extracted from https://github.com/haskell/cabal/issues/3775
2551 dbIssue3775 :: ExampleDb
2552 dbIssue3775 =
2553 [ Right $ exAv "warp" 1 []
2554 , -- NB: the warp build-depends refers to the package, not the internal
2555 -- executable!
2556 Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` exExe "warp" [ExAny "A"]
2557 , Right $ exAv "B" 2 [ExAny "A", ExAny "warp"]
2560 -- A database where the setup depends on something which has a test stanza, does the
2561 -- test stanza get enabled?
2562 dbSetupStanza :: ExampleDb
2563 dbSetupStanza =
2564 [ Right $
2565 exAv "A" 1 []
2566 `withSetupDeps` [ExAny "B"]
2567 , Right $
2568 exAv "B" 1 []
2569 `withTest` exTest "test" [ExAny "C"]
2572 -- With the "top-level" qualifier syntax
2573 setupStanzaTest1 :: SolverTest
2574 setupStanzaTest1 = constraints [ExStanzaConstraint (scopeToplevel "B") [TestStanzas]] $ mkTest dbSetupStanza "setupStanzaTest1" ["A"] (solverSuccess [("A", 1), ("B", 1)])
2576 -- With the "any" qualifier syntax
2577 setupStanzaTest2 :: SolverTest
2578 setupStanzaTest2 =
2579 constraints [ExStanzaConstraint (ScopeAnyQualifier "B") [TestStanzas]] $
2580 mkTest
2581 dbSetupStanza
2582 "setupStanzaTest2"
2583 ["A"]
2584 (solverFailure ("unknown package: A:setup.C (dependency of A:setup.B *test)" `isInfixOf`))
2586 -- | Returns true if the second list contains all elements of the first list, in
2587 -- order.
2588 containsInOrder :: Eq a => [a] -> [a] -> Bool
2589 containsInOrder [] _ = True
2590 containsInOrder _ [] = False
2591 containsInOrder (x : xs) (y : ys)
2592 | x == y = containsInOrder xs ys
2593 | otherwise = containsInOrder (x : xs) ys