Solver.hs 43.5 KB
Newer Older
Edsko de Vries's avatar
Edsko de Vries committed
1
{-# LANGUAGE RecordWildCards #-}
2
module UnitTests.Distribution.Solver.Modular.Solver (tests)
3
       where
Edsko de Vries's avatar
Edsko de Vries committed
4
5

-- base
6
import Data.List (isInfixOf)
Edsko de Vries's avatar
Edsko de Vries committed
7

8
9
10
import qualified Data.Version         as V
import qualified Distribution.Version as V

Edsko de Vries's avatar
Edsko de Vries committed
11
12
13
14
-- test-framework
import Test.Tasty as TF
import Test.Tasty.HUnit (testCase, assertEqual, assertBool)

15
-- Cabal
16
17
import Language.Haskell.Extension ( Extension(..)
                                  , KnownExtension(..), Language(..))
18

Edsko de Vries's avatar
Edsko de Vries committed
19
-- cabal-install
20
import Distribution.Solver.Types.OptionalStanza
21
22
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigDbFromList)
import Distribution.Solver.Types.Settings
23
import Distribution.Client.Dependency (foldProgress)
24
import Distribution.Client.Dependency.Types
25
26
         ( Solver(Modular) )
import UnitTests.Distribution.Solver.Modular.DSL
27
import UnitTests.Options
Edsko de Vries's avatar
Edsko de Vries committed
28
29
30
31

tests :: [TF.TestTree]
tests = [
      testGroup "Simple dependencies" [
32
33
34
35
36
37
38
39
40
41
42
43
44
45
          runTest $         mkTest db1 "alreadyInstalled"   ["A"]      (SolverSuccess [])
        , runTest $         mkTest db1 "installLatest"      ["B"]      (SolverSuccess [("B", 2)])
        , runTest $         mkTest db1 "simpleDep1"         ["C"]      (SolverSuccess [("B", 1), ("C", 1)])
        , runTest $         mkTest db1 "simpleDep2"         ["D"]      (SolverSuccess [("B", 2), ("D", 1)])
        , runTest $         mkTest db1 "failTwoVersions"    ["C", "D"] anySolverFailure
        , runTest $ indep $ mkTest db1 "indepTwoVersions"   ["C", "D"] (SolverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)])
        , runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (SolverSuccess [("B", 1), ("C", 1), ("E", 1)])
        , runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (SolverSuccess [("B", 2), ("D", 1), ("E", 1)])
        , runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
        , runTest $         mkTest db1 "buildDepAgainstOld" ["F"]      (SolverSuccess [("B", 1), ("E", 1), ("F", 1)])
        , runTest $         mkTest db1 "buildDepAgainstNew" ["G"]      (SolverSuccess [("B", 2), ("E", 1), ("G", 1)])
        , runTest $ indep $ mkTest db1 "multipleInstances"  ["F", "G"] anySolverFailure
        , runTest $         mkTest db21 "unknownPackage1"   ["A"]      (SolverSuccess [("A", 1), ("B", 1)])
        , runTest $         mkTest db22 "unknownPackage2"   ["A"]      (SolverFailure (isInfixOf "unknown package: C"))
46
        , runTest $         mkTest db23 "unknownPackage3"   ["A"]      (SolverFailure (isInfixOf "unknown package: B"))
Edsko de Vries's avatar
Edsko de Vries committed
47
48
        ]
    , testGroup "Flagged dependencies" [
49
50
51
52
53
          runTest $         mkTest db3 "forceFlagOn"  ["C"]      (SolverSuccess [("A", 1), ("B", 1), ("C", 1)])
        , runTest $         mkTest db3 "forceFlagOff" ["D"]      (SolverSuccess [("A", 2), ("B", 1), ("D", 1)])
        , runTest $ indep $ mkTest db3 "linkFlags1"   ["C", "D"] anySolverFailure
        , runTest $ indep $ mkTest db4 "linkFlags2"   ["C", "D"] anySolverFailure
        , runTest $ indep $ mkTest db18 "linkFlags3"  ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)])
Edsko de Vries's avatar
Edsko de Vries committed
54
55
        ]
    , testGroup "Stanzas" [
56
57
58
59
60
61
62
63
64
          runTest $         mkTest db5 "simpleTest1" ["C"]      (SolverSuccess [("A", 2), ("C", 1)])
        , runTest $         mkTest db5 "simpleTest2" ["D"]      anySolverFailure
        , runTest $         mkTest db5 "simpleTest3" ["E"]      (SolverSuccess [("A", 1), ("E", 1)])
        , runTest $         mkTest db5 "simpleTest4" ["F"]      anySolverFailure -- TODO
        , runTest $         mkTest db5 "simpleTest5" ["G"]      (SolverSuccess [("A", 2), ("G", 1)])
        , runTest $         mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
        , runTest $ indep $ mkTest db5 "simpleTest7" ["E", "G"] (SolverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
        , runTest $         mkTest db6 "depsWithTests1" ["C"]      (SolverSuccess [("A", 1), ("B", 1), ("C", 1)])
        , runTest $ indep $ mkTest db6 "depsWithTests2" ["C", "D"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
Edsko de Vries's avatar
Edsko de Vries committed
65
        ]
66
    , testGroup "Setup dependencies" [
67
68
69
70
71
72
73
74
75
          runTest $         mkTest db7  "setupDeps1" ["B"] (SolverSuccess [("A", 2), ("B", 1)])
        , runTest $         mkTest db7  "setupDeps2" ["C"] (SolverSuccess [("A", 2), ("C", 1)])
        , runTest $         mkTest db7  "setupDeps3" ["D"] (SolverSuccess [("A", 1), ("D", 1)])
        , runTest $         mkTest db7  "setupDeps4" ["E"] (SolverSuccess [("A", 1), ("A", 2), ("E", 1)])
        , runTest $         mkTest db7  "setupDeps5" ["F"] (SolverSuccess [("A", 1), ("A", 2), ("F", 1)])
        , runTest $         mkTest db8  "setupDeps6" ["C", "D"] (SolverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
        , 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)])
        , runTest $         mkTest db10 "setupDeps8" ["C"] (SolverSuccess [("C", 1)])
        , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
76
        ]
77
    , testGroup "Base shim" [
78
79
80
81
82
83
          runTest $ mkTest db11 "baseShim1" ["A"] (SolverSuccess [("A", 1)])
        , runTest $ mkTest db12 "baseShim2" ["A"] (SolverSuccess [("A", 1)])
        , runTest $ mkTest db12 "baseShim3" ["B"] (SolverSuccess [("B", 1)])
        , runTest $ mkTest db12 "baseShim4" ["C"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)])
        , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure
        , runTest $ mkTest db12 "baseShim6" ["E"] (SolverSuccess [("E", 1), ("syb", 2)])
84
        ]
85
    , testGroup "Cycles" [
86
87
88
89
90
91
92
93
          runTest $ mkTest db14 "simpleCycle1"          ["A"]      anySolverFailure
        , runTest $ mkTest db14 "simpleCycle2"          ["A", "B"] anySolverFailure
        , runTest $ mkTest db14 "cycleWithFlagChoice1"  ["C"]      (SolverSuccess [("C", 1), ("E", 1)])
        , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"]      anySolverFailure
        , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"]      anySolverFailure
        , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"]      (SolverSuccess [("C", 2), ("D", 1)])
        , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"]      (SolverSuccess [("D", 1)])
        , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"]      (SolverSuccess [("C", 2), ("D", 1), ("E", 1)])
94
        ]
95
    , testGroup "Extensions" [
96
97
98
99
100
101
102
          runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure
        , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure
        , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (SolverSuccess [("A",1)])
        , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (SolverSuccess [("A",1),("B",1), ("C",1)])
        , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure
        , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure
        , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (SolverSuccess [("A",1),("B",1),("C",1),("E",1)])
103
104
        ]
    , testGroup "Languages" [
105
106
107
108
          runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure
        , runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (SolverSuccess [("A",1)])
        , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure
        , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (SolverSuccess [("A",1),("B",1),("C",1)])
109
        ]
110
111

     , testGroup "Soft Constraints" [
112
113
          runTest $ soft [ ExPref "A" $ mkvrThis 1]      $ mkTest db13 "selectPreferredVersionSimple" ["A"] (SolverSuccess [("A", 1)])
        , runTest $ soft [ ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (SolverSuccess [("A", 2)])
114
        , runTest $ soft [ ExPref "A" $ mkvrOrEarlier 2
115
                         , ExPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (SolverSuccess [("A", 1)])
116
        , runTest $ soft [ ExPref "A" $ mkvrOrEarlier 1
117
                         , ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (SolverSuccess [("A", 1)])
118
        , runTest $ soft [ ExPref "A" $ mkvrThis 1
119
                         , ExPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (SolverSuccess [("A", 2)])
120
        , runTest $ soft [ ExPref "A" $ mkvrThis 1
121
                         , ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (SolverSuccess [("A", 1)])
122
        ]
123
124
125
126
     , testGroup "Buildable Field" [
          testBuildable "avoid building component with unknown dependency" (ExAny "unknown")
        , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown"))
        , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown"))
127
128
        , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (SolverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
        , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (SolverSuccess [("A", 1), ("B", 2)])
129
130
         ]
    , testGroup "Pkg-config dependencies" [
131
132
133
134
          runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] anySolverFailure
        , runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] anySolverFailure
        , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)])
        , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (SolverSuccess [("A", 1), ("B", 2), ("C", 1)])
135
        ]
136
    , testGroup "Independent goals" [
137
          runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
138
        , runTest $ testIndepGoals2 "indepGoals2"
139
        , runTest $ testIndepGoals3 "indepGoals3"
140
        , runTest $ testIndepGoals4 "indepGoals4"
141
142
143
144
        , runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder
        , runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder
        , runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder
        , runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder
145
        ]
146
147
148
149
150
151
152
153
154
155
156
157
158
      -- Tests designed for the backjumping blog post
    , testGroup "Backjumping" [
          runTest $         mkTest dbBJ1a "bj1a" ["A"]      (SolverSuccess [("A", 1), ("B",  1)])
        , runTest $         mkTest dbBJ1b "bj1b" ["A"]      (SolverSuccess [("A", 1), ("B",  1)])
        , runTest $         mkTest dbBJ1c "bj1c" ["A"]      (SolverSuccess [("A", 1), ("B",  1)])
        , runTest $         mkTest dbBJ2  "bj2"  ["A"]      (SolverSuccess [("A", 1), ("B",  1), ("C", 1)])
        , runTest $         mkTest dbBJ3  "bj3 " ["A"]      (SolverSuccess [("A", 1), ("Ba", 1), ("C", 1)])
        , runTest $         mkTest dbBJ4  "bj4"  ["A"]      (SolverSuccess [("A", 1), ("B",  1), ("C", 1)])
        , runTest $         mkTest dbBJ5  "bj5"  ["A"]      (SolverSuccess [("A", 1), ("B",  1), ("D", 1)])
        , runTest $         mkTest dbBJ6  "bj6"  ["A"]      (SolverSuccess [("A", 1), ("B",  1)])
        , runTest $         mkTest dbBJ7  "bj7"  ["A"]      (SolverSuccess [("A", 1), ("B",  1), ("C", 1)])
        , runTest $ indep $ mkTest dbBJ8  "bj8"  ["A", "B"] (SolverSuccess [("A", 1), ("B",  1), ("C", 1)])
        ]
Edsko de Vries's avatar
Edsko de Vries committed
159
160
    ]
  where
161
162
163
164
    soft prefs test = test { testSoftConstraints = prefs }
    mkvrThis        = V.thisVersion . makeV
    mkvrOrEarlier   = V.orEarlierVersion . makeV
    makeV v         = V.Version [v,0,0] []
Edsko de Vries's avatar
Edsko de Vries committed
165

166
167
168
169
170
171
172
173
174
-- | Combinator to turn on --independent-goals behavior, i.e. solve
-- for the goals as if we were solving for each goal independently.
-- (This doesn't really work well at the moment, see #2842)
indep :: SolverTest -> SolverTest
indep test = test { testIndepGoals = IndependentGoals True }

goalOrder :: [ExampleVar] -> SolverTest -> SolverTest
goalOrder order test = test { testGoalOrder = Just order }

175
176
data GoalOrder = FixedGoalOrder | DefaultGoalOrder

Edsko de Vries's avatar
Edsko de Vries committed
177
178
179
180
181
{-------------------------------------------------------------------------------
  Solver tests
-------------------------------------------------------------------------------}

data SolverTest = SolverTest {
182
183
    testLabel          :: String
  , testTargets        :: [String]
184
  , testResult         :: SolverResult
185
  , testIndepGoals     :: IndependentGoals
186
  , testGoalOrder      :: Maybe [ExampleVar]
187
  , testSoftConstraints :: [ExPreference]
188
  , testDb             :: ExampleDb
189
190
  , testSupportedExts  :: Maybe [Extension]
  , testSupportedLangs :: Maybe [Language]
191
  , testPkgConfigDb    :: PkgConfigDb
Edsko de Vries's avatar
Edsko de Vries committed
192
193
  }

194
195
196
197
198
199
200
201
202
203
-- | Result of a solver test.
data SolverResult =
    SolverSuccess [(String, Int)]  -- ^ succeeds with given plan
  | SolverFailure (String -> Bool) -- ^ fails, and the error message satisfies the predicate

-- | Can be used for test cases where we just want to verify that
-- they fail, but do not care about the error message.
anySolverFailure :: SolverResult
anySolverFailure = SolverFailure (const True)

204
205
206
207
208
209
210
211
212
213
-- | Makes a solver test case, consisting of the following components:
--
--      1. An 'ExampleDb', representing the package database (both
--         installed and remote) we are doing dependency solving over,
--      2. A 'String' name for the test,
--      3. A list '[String]' of package names to solve for
--      4. The expected result, either 'Nothing' if there is no
--         satisfying solution, or a list '[(String, Int)]' of
--         packages to install, at which versions.
--
214
-- See 'UnitTests.Distribution.Solver.Modular.DSL' for how
215
216
-- to construct an 'ExampleDb', as well as definitions of 'db1' etc.
-- in this file.
Edsko de Vries's avatar
Edsko de Vries committed
217
218
219
mkTest :: ExampleDb
       -> String
       -> [String]
220
       -> SolverResult
Edsko de Vries's avatar
Edsko de Vries committed
221
       -> SolverTest
222
mkTest = mkTestExtLangPC Nothing Nothing []
223
224
225
226
227

mkTestExts :: [Extension]
           -> ExampleDb
           -> String
           -> [String]
228
           -> SolverResult
229
           -> SolverTest
230
mkTestExts exts = mkTestExtLangPC (Just exts) Nothing []
231
232
233
234
235

mkTestLangs :: [Language]
            -> ExampleDb
            -> String
            -> [String]
236
            -> SolverResult
237
            -> SolverTest
238
239
240
241
242
243
mkTestLangs langs = mkTestExtLangPC Nothing (Just langs) []

mkTestPCDepends :: [(String, String)]
                -> ExampleDb
                -> String
                -> [String]
244
                -> SolverResult
245
246
247
248
249
250
251
252
253
                -> SolverTest
mkTestPCDepends pkgConfigDb = mkTestExtLangPC Nothing Nothing pkgConfigDb

mkTestExtLangPC :: Maybe [Extension]
                -> Maybe [Language]
                -> [(String, String)]
                -> ExampleDb
                -> String
                -> [String]
254
                -> SolverResult
255
256
                -> SolverTest
mkTestExtLangPC exts langs pkgConfigDb db label targets result = SolverTest {
257
258
259
    testLabel          = label
  , testTargets        = targets
  , testResult         = result
260
  , testIndepGoals     = IndependentGoals False
261
  , testGoalOrder      = Nothing
262
  , testSoftConstraints = []
263
264
265
  , testDb             = db
  , testSupportedExts  = exts
  , testSupportedLangs = langs
266
  , testPkgConfigDb    = pkgConfigDbFromList pkgConfigDb
Edsko de Vries's avatar
Edsko de Vries committed
267
268
269
270
271
  }

runTest :: SolverTest -> TF.TestTree
runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
    testCase testLabel $ do
272
273
274
275
276
277
278
279
      let lg = exResolve testDb testSupportedExts
               testSupportedLangs testPkgConfigDb testTargets
               Modular Nothing testIndepGoals (ReorderGoals False)
               (EnableBackjumping True) testGoalOrder testSoftConstraints
          logMsg msg = if showSolverLog
                       then putStrLn msg
                       else return ()
      result <- foldProgress ((>>) . logMsg) (return . Left) (return . Right) lg
Edsko de Vries's avatar
Edsko de Vries committed
280
      case result of
281
282
283
284
285
286
287
288
289
290
        Left  err  -> assertBool ("Unexpected error:\n" ++ err) (check testResult err)
        Right plan -> assertEqual "" (toMaybe testResult) (Just (extractInstallPlan plan))
  where
    toMaybe :: SolverResult -> Maybe ([(String, Int)])
    toMaybe (SolverSuccess plan) = Just plan
    toMaybe (SolverFailure _   ) = Nothing

    check :: SolverResult -> (String -> Bool)
    check (SolverFailure f) = f
    check _                 = const False
Edsko de Vries's avatar
Edsko de Vries committed
291
292
293
294
295
296
297

{-------------------------------------------------------------------------------
  Specific example database for the tests
-------------------------------------------------------------------------------}

db1 :: ExampleDb
db1 =
298
    let a = exInst "A" 1 "A-1" []
Edsko de Vries's avatar
Edsko de Vries committed
299
    in [ Left a
300
301
302
303
304
305
306
307
       , Right $ exAv "B" 1 [ExAny "A"]
       , Right $ exAv "B" 2 [ExAny "A"]
       , Right $ exAv "C" 1 [ExFix "B" 1]
       , Right $ exAv "D" 1 [ExFix "B" 2]
       , Right $ exAv "E" 1 [ExAny "B"]
       , Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"]
       , Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"]
       , Right $ exAv "Z" 1 []
Edsko de Vries's avatar
Edsko de Vries committed
308
309
310
311
312
313
       ]

-- In this example, we _can_ install C and D as independent goals, but we have
-- to pick two diferent versions for B (arbitrarily)
db2 :: ExampleDb
db2 = [
314
315
316
317
318
319
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "B" 1 [ExAny "A"]
  , Right $ exAv "B" 2 [ExAny "A"]
  , Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1]
  , Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2]
Edsko de Vries's avatar
Edsko de Vries committed
320
321
322
323
  ]

db3 :: ExampleDb
db3 = [
324
325
     Right $ exAv "A" 1 []
   , Right $ exAv "A" 2 []
326
   , Right $ exAv "B" 1 [exFlag "flagB" [ExFix "A" 1] [ExFix "A" 2]]
327
328
   , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
   , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"]
Edsko de Vries's avatar
Edsko de Vries committed
329
330
   ]

331
-- | Like db3, but the flag picks a different package rather than a
Edsko de Vries's avatar
Edsko de Vries committed
332
333
-- different package version
--
334
-- In db3 we cannot install C and D as independent goals because:
Edsko de Vries's avatar
Edsko de Vries committed
335
336
--
-- * The multiple instance restriction says C and D _must_ share B
337
338
-- * Since C relies on A-1, C needs B to be compiled with flagB on
-- * Since D relies on A-2, D needs B to be compiled with flagB off
Edsko de Vries's avatar
Edsko de Vries committed
339
340
341
342
343
-- * Hence C and D have incompatible requirements on B's flags.
--
-- However, _even_ if we don't check explicitly that we pick the same flag
-- assignment for 0.B and 1.B, we will still detect the problem because
-- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to
344
-- 1.A and therefore we cannot link 0.B to 1.B.
Edsko de Vries's avatar
Edsko de Vries committed
345
--
346
-- In db4 the situation however is trickier. We again cannot install
Edsko de Vries's avatar
Edsko de Vries committed
347
348
349
350
351
352
353
354
355
356
357
-- packages C and D as independent goals because:
--
-- * As above, the multiple instance restriction says that C and D _must_ share B
-- * Since C relies on Ax-2, it requires B to be compiled with flagB off
-- * Since D relies on Ay-2, it requires B to be compiled with flagB on
-- * Hence C and D have incompatible requirements on B's flags.
--
-- But now this requirement is more indirect. If we only check dependencies
-- we don't see the problem:
--
-- * We link 0.B to 1.B
358
359
-- * 0.B relies on Ay-1
-- * 1.B relies on Ax-1
Edsko de Vries's avatar
Edsko de Vries committed
360
--
361
-- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since
Edsko de Vries's avatar
Edsko de Vries committed
362
363
364
-- we only ever assign to one of these, these constraints are never broken.
db4 :: ExampleDb
db4 = [
365
366
367
368
     Right $ exAv "Ax" 1 []
   , Right $ exAv "Ax" 2 []
   , Right $ exAv "Ay" 1 []
   , Right $ exAv "Ay" 2 []
369
   , Right $ exAv "B"  1 [exFlag "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]]
370
371
   , Right $ exAv "C"  1 [ExFix "Ax" 2, ExAny "B"]
   , Right $ exAv "D"  1 [ExFix "Ay" 2, ExAny "B"]
Edsko de Vries's avatar
Edsko de Vries committed
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
   ]

-- | Some tests involving testsuites
--
-- Note that in this test framework test suites are always enabled; if you
-- want to test without test suites just set up a test database without
-- test suites.
--
-- * C depends on A (through its test suite)
-- * D depends on B-2 (through its test suite), but B-2 is unavailable
-- * E depends on A-1 directly and on A through its test suite. We prefer
--     to use A-1 for the test suite in this case.
-- * F depends on A-1 directly and on A-2 through its test suite. In this
--     case we currently fail to install F, although strictly speaking
--     test suites should be considered independent goals.
-- * G is like E, but for version A-2. This means that if we cannot install
--     E and G together, unless we regard them as independent goals.
db5 :: ExampleDb
db5 = [
391
392
393
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "B" 1 []
394
395
396
397
398
  , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"]
  , Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2]
  , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"]
  , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2]
  , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"]
Edsko de Vries's avatar
Edsko de Vries committed
399
400
401
402
403
404
405
406
407
408
409
410
  ]

-- Now the _dependencies_ have test suites
--
-- * Installing C is a simple example. C wants version 1 of A, but depends on
--   B, and B's testsuite depends on an any version of A. In this case we prefer
--   to link (if we don't regard test suites as independent goals then of course
--   linking here doesn't even come into it).
-- * Installing [C, D] means that we prefer to link B -- depending on how we
--   set things up, this means that we should also link their test suites.
db6 :: ExampleDb
db6 = [
411
412
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
413
  , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"]
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
  , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
  , Right $ exAv "D" 1 [ExAny "B"]
  ]

-- Packages with setup dependencies
--
-- Install..
-- * B: Simple example, just make sure setup deps are taken into account at all
-- * C: Both the package and the setup script depend on any version of A.
--      In this case we prefer to link
-- * D: Variation on C.1 where the package requires a specific (not latest)
--      version but the setup dependency is not fixed. Again, we prefer to
--      link (picking the older version)
-- * E: Variation on C.2 with the setup dependency the more inflexible.
--      Currently, in this case we do not see the opportunity to link because
--      we consider setup dependencies after normal dependencies; we will
--      pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick
--      A.1 instead. This isn't so easy to fix (if we want to fix it at all);
--      in particular, considering setup dependencies _before_ other deps is
--      not an improvement, because in general we would prefer to link setup
--      setups to package deps, rather than the other way around. (For example,
--      if we change this ordering then the test for D would start to install
--      two versions of A).
-- * F: The package and the setup script depend on different versions of A.
--      This will only work if setup dependencies are considered independent.
db7 :: ExampleDb
db7 = [
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "B" 1 []            `withSetupDeps` [ExAny "A"]
  , Right $ exAv "C" 1 [ExAny "A"  ] `withSetupDeps` [ExAny "A"  ]
  , Right $ exAv "D" 1 [ExFix "A" 1] `withSetupDeps` [ExAny "A"  ]
  , Right $ exAv "E" 1 [ExAny "A"  ] `withSetupDeps` [ExFix "A" 1]
  , Right $ exAv "F" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
  ]

-- If we install C and D together (not as independent goals), we need to build
-- both B.1 and B.2, both of which depend on A.
db8 :: ExampleDb
db8 = [
    Right $ exAv "A" 1 []
  , Right $ exAv "B" 1 [ExAny "A"]
  , Right $ exAv "B" 2 [ExAny "A"]
  , Right $ exAv "C" 1 [] `withSetupDeps` [ExFix "B" 1]
  , Right $ exAv "D" 1 [] `withSetupDeps` [ExFix "B" 2]
  ]

-- Extended version of `db8` so that we have nested setup dependencies
db9 :: ExampleDb
db9 = db8 ++ [
    Right $ exAv "E" 1 [ExAny "C"]
  , Right $ exAv "E" 2 [ExAny "D"]
  , Right $ exAv "F" 1 [] `withSetupDeps` [ExFix "E" 1]
  , Right $ exAv "G" 1 [] `withSetupDeps` [ExFix "E" 2]
Edsko de Vries's avatar
Edsko de Vries committed
468
469
  ]

470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
-- Multiple already-installed packages with inter-dependencies, and one package
-- (C) that depends on package A-1 for its setup script and package A-2 as a
-- library dependency.
db10 :: ExampleDb
db10 =
  let rts         = exInst "rts"         1 "rts-inst"         []
      ghc_prim    = exInst "ghc-prim"    1 "ghc-prim-inst"    [rts]
      base        = exInst "base"        1 "base-inst"        [rts, ghc_prim]
      a1          = exInst "A"           1 "A1-inst"          [base]
      a2          = exInst "A"           2 "A2-inst"          [base]
  in [
      Left rts
    , Left ghc_prim
    , Left base
    , Left a1
    , Left a2
    , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
    ]

489
-- | This database tests that a package's setup dependencies are correctly
490
-- linked when the package is linked. See pull request #3268.
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
--
-- When A and B are installed as independent goals, their dependencies on C must
-- be linked, due to the single instance restriction. Since C depends on D, 0.D
-- and 1.D must be linked. C also has a setup dependency on D, so 0.C-setup.D
-- and 1.C-setup.D must be linked. However, D's two link groups must remain
-- independent. The solver should be able to choose D-1 for C's library and D-2
-- for C's setup script.
dbSetupDeps :: ExampleDb
dbSetupDeps = [
    Right $ exAv "A" 1 [ExAny "C"]
  , Right $ exAv "B" 1 [ExAny "C"]
  , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2]
  , Right $ exAv "D" 1 []
  , Right $ exAv "D" 2 []
  ]

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
-- | Tests for dealing with base shims
db11 :: ExampleDb
db11 =
  let base3 = exInst "base" 3 "base-3-inst" [base4]
      base4 = exInst "base" 4 "base-4-inst" []
  in [
      Left base3
    , Left base4
    , Right $ exAv "A" 1 [ExFix "base" 3]
    ]

-- | Slightly more realistic version of db11 where base-3 depends on syb
-- This means that if a package depends on base-3 and on syb, then they MUST
-- share the version of syb
--
-- * Package A relies on base-3 (which relies on base-4)
-- * Package B relies on base-4
-- * Package C relies on both A and B
-- * Package D relies on base-3 and on syb-2, which is not possible because
--     base-3 has a dependency on syb-1 (non-inheritance of the Base qualifier)
-- * Package E relies on base-4 and on syb-2, which is fine.
db12 :: ExampleDb
db12 =
  let base3 = exInst "base" 3 "base-3-inst" [base4, syb1]
      base4 = exInst "base" 4 "base-4-inst" []
      syb1  = exInst "syb" 1 "syb-1-inst" [base4]
  in [
      Left base3
    , Left base4
    , Left syb1
    , Right $ exAv "syb" 2 [ExFix "base" 4]
    , Right $ exAv "A" 1 [ExFix "base" 3, ExAny "syb"]
    , Right $ exAv "B" 1 [ExFix "base" 4, ExAny "syb"]
    , Right $ exAv "C" 1 [ExAny "A", ExAny "B"]
    , Right $ exAv "D" 1 [ExFix "base" 3, ExFix "syb" 2]
    , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2]
    ]

545
546
547
548
549
550
551
db13 :: ExampleDb
db13 = [
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "A" 3 []
  ]

552
553
554
555
556
557
558
559
560
561
562
563
564
565
-- | Database with some cycles
--
-- * Simplest non-trivial cycle: A -> B and B -> A
-- * There is a cycle C -> D -> C, but it can be broken by picking the
--   right flag assignment.
db14 :: ExampleDb
db14 = [
    Right $ exAv "A" 1 [ExAny "B"]
  , Right $ exAv "B" 1 [ExAny "A"]
  , Right $ exAv "C" 1 [exFlag "flagC" [ExAny "D"] [ExAny "E"]]
  , Right $ exAv "D" 1 [ExAny "C"]
  , Right $ exAv "E" 1 []
  ]

566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
-- | Cycles through setup dependencies
--
-- The first cycle is unsolvable: package A has a setup dependency on B,
-- B has a regular dependency on A, and we only have a single version available
-- for both.
--
-- The second cycle can be broken by picking different versions: package C-2.0
-- has a setup dependency on D, and D has a regular dependency on C-*. However,
-- version C-1.0 is already available (perhaps it didn't have this setup dep).
-- Thus, we should be able to break this cycle even if we are installing package
-- E, which explictly depends on C-2.0.
db15 :: ExampleDb
db15 = [
    -- First example (real cycle, no solution)
    Right $ exAv   "A" 1            []            `withSetupDeps` [ExAny "B"]
  , Right $ exAv   "B" 1            [ExAny "A"]
    -- Second example (cycle can be broken by picking versions carefully)
  , Left  $ exInst "C" 1 "C-1-inst" []
  , Right $ exAv   "C" 2            []            `withSetupDeps` [ExAny "D"]
  , Right $ exAv   "D" 1            [ExAny "C"  ]
  , Right $ exAv   "E" 1            [ExFix "C" 2]
  ]

589
-- | Check that the solver can backtrack after encountering the SIR (issue #2843)
Edsko de Vries's avatar
Edsko de Vries committed
590
591
--
-- When A and B are installed as independent goals, the single instance
592
593
-- restriction prevents B from depending on C.  This database tests that the
-- solver can backtrack after encountering the single instance restriction and
Edsko de Vries's avatar
Edsko de Vries committed
594
595
596
597
598
599
600
601
602
603
604
605
-- choose the only valid flag assignment (-flagA +flagB):
--
-- > flagA flagB  B depends on
-- >  On    _     C-*
-- >  Off   On    E-*               <-- only valid flag assignment
-- >  Off   Off   D-2.0, C-*
--
-- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D,
-- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have
-- C in the transitive closure of B's dependencies, because that would mean we
-- would need two instances of C: one built against D-1.0 and one built against
-- D-2.0.
606
607
608
609
db16 :: ExampleDb
db16 = [
    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
  , Right $ exAv "B" 1 [ ExFix "D" 2
610
                       , exFlag "flagA"
611
                             [ExAny "C"]
612
                             [exFlag "flagB"
613
614
615
616
617
618
619
                                 [ExAny "E"]
                                 [ExAny "C"]]]
  , Right $ exAv "C" 1 [ExAny "D"]
  , Right $ exAv "D" 1 []
  , Right $ exAv "D" 2 []
  , Right $ exAv "E" 1 []
  ]
Edsko de Vries's avatar
Edsko de Vries committed
620

621
-- | This test checks that when the solver discovers a constraint on a
kristenk's avatar
kristenk committed
622
-- package's version after choosing to link that package, it can backtrack to
623
-- try alternative versions for the linked-to package. See pull request #3327.
kristenk's avatar
kristenk committed
624
625
626
--
-- When A and B are installed as independent goals, their dependencies on C
-- must be linked. Since C depends on D, A and B's dependencies on D must also
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
-- be linked. This test fixes the goal order so that the solver chooses D-2 for
-- both 0.D and 1.D before it encounters the test suites' constraints. The
-- solver must backtrack to try D-1 for both 0.D and 1.D.
testIndepGoals2 :: String -> SolverTest
testIndepGoals2 name =
    goalOrder goals $ indep $
    mkTest db name ["A", "B"] $
    SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]
  where
    db :: ExampleDb
    db = [
        Right $ exAv "A" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
      , Right $ exAv "B" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
      , Right $ exAv "C" 1 [ExAny "D"]
      , Right $ exAv "D" 1 []
      , Right $ exAv "D" 2 []
      ]

    goals :: [ExampleVar]
    goals = [
        P (Indep 0) "A"
      , P (Indep 0) "C"
      , P (Indep 0) "D"
      , P (Indep 1) "B"
      , P (Indep 1) "C"
      , P (Indep 1) "D"
      , S (Indep 1) "B" TestStanzas
      , S (Indep 0) "A" TestStanzas
      ]
kristenk's avatar
kristenk committed
656

657
658
-- | Issue #2834
-- When both A and B are installed as independent goals, their dependencies on
kristenk's avatar
kristenk committed
659
660
661
662
-- C must be linked. The only combination of C's flags that is consistent with
-- A and B's dependencies on D is -flagA +flagB. This database tests that the
-- solver can backtrack to find the right combination of flags (requiring F, but
-- not E or G) and apply it to both 0.C and 1.C.
663
664
665
666
667
668
669
670
671
672
--
-- > flagA flagB  C depends on
-- >  On    _     D-1, E-*
-- >  Off   On    F-*        <-- Only valid choice
-- >  Off   Off   D-2, G-*
--
-- The single instance restriction means we cannot have one instance of C
-- built against D-1 and one instance built against D-2; since A depends on
-- D-1, and B depends on C-2, it is therefore important that C cannot depend
-- on any version of D.
kristenk's avatar
kristenk committed
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
db18 :: ExampleDb
db18 = [
    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
  , Right $ exAv "B" 1 [ExAny "C", ExFix "D" 2]
  , Right $ exAv "C" 1 [exFlag "flagA"
                           [ExFix "D" 1, ExAny "E"]
                           [exFlag "flagB"
                               [ExAny "F"]
                               [ExFix "D" 2, ExAny "G"]]]
  , Right $ exAv "D" 1 []
  , Right $ exAv "D" 2 []
  , Right $ exAv "E" 1 []
  , Right $ exAv "F" 1 []
  , Right $ exAv "G" 1 []
  ]

689
-- | Tricky test case with independent goals (issue #2842)
Edsko de Vries's avatar
Edsko de Vries committed
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
--
-- Suppose we are installing D, E, and F as independent goals:
--
-- * D depends on A-* and C-1, requiring A-1 to be built against C-1
-- * E depends on B-* and C-2, requiring B-1 to be built against C-2
-- * F depends on A-* and B-*; this means we need A-1 and B-1 both to be built
--     against the same version of C, violating the single instance restriction.
--
-- We can visualize this DB as:
--
-- >    C-1   C-2
-- >    /|\   /|\
-- >   / | \ / | \
-- >  /  |  X  |  \
-- > |   | / \ |   |
-- > |   |/   \|   |
-- > |   +     +   |
-- > |   |     |   |
-- > |   A     B   |
-- >  \  |\   /|  /
-- >   \ | \ / | /
-- >    \|  V  |/
-- >     D  F  E
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
testIndepGoals3 :: String -> SolverTest
testIndepGoals3 name =
    goalOrder goals $ indep $
    mkTest db name ["D", "E", "F"] anySolverFailure
  where
    db :: ExampleDb
    db = [
        Right $ exAv "A" 1 [ExAny "C"]
      , Right $ exAv "B" 1 [ExAny "C"]
      , Right $ exAv "C" 1 []
      , Right $ exAv "C" 2 []
      , Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1]
      , Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2]
      , Right $ exAv "F" 1 [ExAny "A", ExAny "B"]
      ]

    goals :: [ExampleVar]
    goals = [
        P (Indep 0) "D"
      , P (Indep 0) "C"
      , P (Indep 0) "A"
      , P (Indep 1) "E"
      , P (Indep 1) "C"
      , P (Indep 1) "B"
      , P (Indep 2) "F"
      , P (Indep 2) "B"
      , P (Indep 2) "C"
      , P (Indep 2) "A"
      ]
742

743
-- | This test checks that the solver correctly backjumps when dependencies
744
745
746
747
-- of linked packages are not linked. It is an example where the conflict set
-- from enforcing the single instance restriction is not sufficient. See pull
-- request #3327.
--
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
-- When A, B, and C are installed as independent goals with the specified goal
-- order, the first choice that the solver makes for E is 0.E-2. Then, when it
-- chooses dependencies for B and C, it links both 1.E and 2.E to 0.E. Finally,
-- the solver discovers C's test's constraint on E. It must backtrack to try
-- 1.E-1 and then link 2.E to 1.E. Backjumping all the way to 0.E does not lead
-- to a solution, because 0.E's version is constrained by A and cannot be
-- changed.
testIndepGoals4 :: String -> SolverTest
testIndepGoals4 name =
    goalOrder goals $ indep $
    mkTest db name ["A", "B", "C"] $
    SolverSuccess [("A",1), ("B",1), ("C",1), ("D",1), ("E",1), ("E",2)]
  where
    db :: ExampleDb
    db = [
        Right $ exAv "A" 1 [ExFix "E" 2]
      , Right $ exAv "B" 1 [ExAny "D"]
      , Right $ exAv "C" 1 [ExAny "D"] `withTest` ExTest "test" [ExFix "E" 1]
      , Right $ exAv "D" 1 [ExAny "E"]
      , Right $ exAv "E" 1 []
      , Right $ exAv "E" 2 []
      ]

    goals :: [ExampleVar]
    goals = [
        P (Indep 0) "A"
      , P (Indep 0) "E"
      , P (Indep 1) "B"
      , P (Indep 1) "D"
      , P (Indep 1) "E"
      , P (Indep 2) "C"
      , P (Indep 2) "D"
      , P (Indep 2) "E"
      , S (Indep 2) "C" TestStanzas
      ]
783

784
-- | Test the trace messages that we get when a package refers to an unknown pkg
785
--
786
787
-- TODO: Currently we don't actually test the trace messages, and this particular
-- test still suceeds. The trace can only be verified by hand.
788
789
790
791
792
793
794
db21 :: ExampleDb
db21 = [
    Right $ exAv "A" 1 [ExAny "B"]
  , Right $ exAv "A" 2 [ExAny "C"] -- A-2.0 will be tried first, but C unknown
  , Right $ exAv "B" 1 []
  ]

795
-- | A variant of 'db21', which actually fails.
796
797
798
799
800
801
db22 :: ExampleDb
db22 = [
    Right $ exAv "A" 1 [ExAny "B"]
  , Right $ exAv "A" 2 [ExAny "C"]
  ]

802
803
804
805
806
807
808
809
810
811
812
-- | Another test for the unknown package message.  This database tests that
-- filtering out redundant conflict set messages in the solver log doesn't
-- interfere with generating a message about a missing package (part of issue
-- #3617). The conflict set for the missing package is {A, B}. That conflict set
-- is propagated up the tree to the level of A. Since the conflict set is the
-- same at both levels, the solver only keeps one of the backjumping messages.
db23 :: ExampleDb
db23 = [
    Right $ exAv "A" 1 [ExAny "B"]
  ]

Andres Löh's avatar
Andres Löh committed
813
814
815
816
817
818
819
820
821
822
823
824
825
-- | Database for (unsuccessfully) trying to expose a bug in the handling
-- of implied linking constraints. The question is whether an implied linking
-- constraint should only have the introducing package in its conflict set,
-- or also its link target.
--
-- It turns out that as long as the Single Instance Restriction is in place,
-- it does not matter, because there will aways be an option that is failing
-- due to the SIR, which contains the link target in its conflict set.
--
-- Even if the SIR is not in place, if there is a solution, one will always
-- be found, because without the SIR, linking is always optional, but never
-- necessary.
--
826
827
828
829
830
testIndepGoals5 :: String -> GoalOrder -> SolverTest
testIndepGoals5 name fixGoalOrder =
    case fixGoalOrder of
      FixedGoalOrder   -> goalOrder goals test
      DefaultGoalOrder -> test
831
  where
832
833
834
835
836
    test :: SolverTest
    test = indep $ mkTest db name ["X", "Y"] $
           SolverSuccess
           [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)]

837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    db :: ExampleDb
    db = [
        Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"]
      , Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2]
      , Right $ exAv "A" 1 []
      , Right $ exAv "A" 2 [ExAny "B"]
      , Right $ exAv "B" 1 [ExAny "C"]
      , Right $ exAv "C" 1 []
      , Right $ exAv "C" 2 []
      ]

    goals :: [ExampleVar]
    goals = [
        P (Indep 0) "X"
      , P (Indep 0) "A"
      , P (Indep 0) "B"
      , P (Indep 0) "C"
      , P (Indep 1) "Y"
      , P (Indep 1) "A"
      , P (Indep 1) "B"
      , P (Indep 1) "C"
      ]
Andres Löh's avatar
Andres Löh committed
859

860
-- | A simplified version of 'testIndepGoals5'.
861
862
863
864
865
testIndepGoals6 :: String -> GoalOrder -> SolverTest
testIndepGoals6 name fixGoalOrder =
    case fixGoalOrder of
      FixedGoalOrder   -> goalOrder goals test
      DefaultGoalOrder -> test
866
  where
867
868
869
870
871
    test :: SolverTest
    test = indep $ mkTest db name ["X", "Y"] $
           SolverSuccess
           [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)]

872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
    db :: ExampleDb
    db = [
        Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"]
      , Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2]
      , Right $ exAv "A" 1 []
      , Right $ exAv "A" 2 [ExAny "B"]
      , Right $ exAv "B" 1 []
      , Right $ exAv "B" 2 []
      ]

    goals :: [ExampleVar]
    goals = [
        P (Indep 0) "X"
      , P (Indep 0) "A"
      , P (Indep 0) "B"
      , P (Indep 1) "Y"
      , P (Indep 1) "A"
      , P (Indep 1) "B"
      ]
Andres Löh's avatar
Andres Löh committed
891

892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
dbExts1 :: ExampleDb
dbExts1 = [
    Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)]
  , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"]
  , Right $ exAv "C" 1 [ExAny "B"]
  , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"]
  , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"]
  ]

dbLangs1 :: ExampleDb
dbLangs1 = [
    Right $ exAv "A" 1 [ExLang Haskell2010]
  , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"]
  , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"]
  ]

908
909
910
-- | cabal must set enable-lib to false in order to avoid the unavailable
-- dependency. Flags are true by default. The flag choice causes "pkg" to
-- depend on "false-dep".
911
912
testBuildable :: String -> ExampleDependency -> TestTree
testBuildable testName unavailableDep =
913
    runTest $ mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected
914
  where
915
    expected = SolverSuccess [("false-dep", 1), ("pkg", 1)]
916
    db = [
917
918
919
920
921
922
923
        Right $ exAv "pkg" 1
            [ unavailableDep
            , ExFlag "enable-lib" (Buildable []) NotBuildable ]
         `withTest`
            ExTest "test" [exFlag "enable-lib"
                              [ExAny "true-dep"]
                              [ExAny "false-dep"]]
924
925
926
927
      , Right $ exAv "true-dep" 1 []
      , Right $ exAv "false-dep" 1 []
      ]

928
929
-- | cabal must choose -flag1 +flag2 for "pkg", which requires packages
-- "flag1-false" and "flag2-true".
930
931
932
933
dbBuildable1 :: ExampleDb
dbBuildable1 = [
    Right $ exAv "pkg" 1
        [ ExAny "unknown"
934
        , ExFlag "flag1" (Buildable []) NotBuildable
935
936
937
        , ExFlag "flag2" (Buildable []) NotBuildable]
     `withTests`
        [ ExTest "optional-test"
938
939
              [ ExAny "unknown"
              , ExFlag "flag1"
940
941
                    (Buildable [])
                    (Buildable [ExFlag "flag2" NotBuildable (Buildable [])])]
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
        , ExTest "test" [ exFlag "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"]
                        , exFlag "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]]
        ]
  , Right $ exAv "flag1-true" 1 []
  , Right $ exAv "flag1-false" 1 []
  , Right $ exAv "flag2-true" 1 []
  , Right $ exAv "flag2-false" 1 []
  ]

-- | cabal must pick B-2 to avoid the unknown dependency.
dbBuildable2 :: ExampleDb
dbBuildable2 = [
    Right $ exAv "A" 1 [ExAny "B"]
  , Right $ exAv "B" 1 [ExAny "unknown"]
  , Right $ exAv "B" 2
        [ ExAny "unknown"
        , ExFlag "disable-lib" NotBuildable (Buildable [])
        ]
  , Right $ exAv "B" 3 [ExAny "unknown"]
  ]
962

963
964
965
966
967
968
969
970
971
-- | Package databases for testing @pkg-config@ dependencies.
dbPC1 :: ExampleDb
dbPC1 = [
    Right $ exAv "A" 1 [ExPkg ("pkgA", 1)]
  , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"]
  , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"]
  , Right $ exAv "C" 1 [ExAny "B"]
  ]

972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-------------------------------------------------------------------------------
  Simple databases for the illustrations for the backjumping blog post
-------------------------------------------------------------------------------}

-- | Motivate conflict sets
dbBJ1a :: ExampleDb
dbBJ1a = [
    Right $ exAv "A" 1 [ExFix "B" 1]
  , Right $ exAv "A" 2 [ExFix "B" 2]
  , Right $ exAv "B" 1 []
  ]

-- | Show that we can skip some decisions
dbBJ1b :: ExampleDb
dbBJ1b = [
    Right $ exAv "A" 1 [ExFix "B" 1]
  , Right $ exAv "A" 2 [ExFix "B" 2, ExAny "C"]
  , Right $ exAv "B" 1 []
  , Right $ exAv "C" 1 []
  , Right $ exAv "C" 2 []
  ]

-- | Motivate why both A and B need to be in the conflict set
dbBJ1c :: ExampleDb
dbBJ1c = [
    Right $ exAv "A" 1 [ExFix "B" 1]
  , Right $ exAv "B" 1 []
  , Right $ exAv "B" 2 []
  ]
For faster browsing, not all history is shown. View entire blame