Solver.hs 45.3 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)])
        ]
159
160
161
162
163
164
165
166
    -- Build-tools dependencies
    , testGroup "build-tools" [
          runTest $ mkTest dbBuildTools1 "bt1" ["A"] (SolverSuccess [("A", 1), ("alex", 1)])
        , runTest $ mkTest dbBuildTools2 "bt2" ["A"] (SolverSuccess [("A", 1)])
        , runTest $ mkTest dbBuildTools3 "bt3" ["C"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)])
        , runTest $ mkTest dbBuildTools4 "bt4" ["B"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)])
        , runTest $ mkTest dbBuildTools5 "bt5" ["A"] (SolverSuccess [("A", 1), ("alex", 1), ("happy", 1)])
        ]
Edsko de Vries's avatar
Edsko de Vries committed
167
168
    ]
  where
169
170
171
172
    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
173

174
175
176
177
178
179
180
181
-- | Combinator to turn on --independent-goals behavior, i.e. solve
-- for the goals as if we were solving for each goal independently.
indep :: SolverTest -> SolverTest
indep test = test { testIndepGoals = IndependentGoals True }

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

182
183
data GoalOrder = FixedGoalOrder | DefaultGoalOrder

Edsko de Vries's avatar
Edsko de Vries committed
184
185
186
187
188
{-------------------------------------------------------------------------------
  Solver tests
-------------------------------------------------------------------------------}

data SolverTest = SolverTest {
189
190
    testLabel          :: String
  , testTargets        :: [String]
191
  , testResult         :: SolverResult
192
  , testIndepGoals     :: IndependentGoals
193
  , testGoalOrder      :: Maybe [ExampleVar]
194
  , testSoftConstraints :: [ExPreference]
195
  , testDb             :: ExampleDb
196
197
  , testSupportedExts  :: Maybe [Extension]
  , testSupportedLangs :: Maybe [Language]
198
  , testPkgConfigDb    :: PkgConfigDb
Edsko de Vries's avatar
Edsko de Vries committed
199
200
  }

201
202
203
204
205
206
207
208
209
210
-- | 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)

211
212
213
214
215
216
217
218
219
220
-- | 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.
--
221
-- See 'UnitTests.Distribution.Solver.Modular.DSL' for how
222
223
-- to construct an 'ExampleDb', as well as definitions of 'db1' etc.
-- in this file.
Edsko de Vries's avatar
Edsko de Vries committed
224
225
226
mkTest :: ExampleDb
       -> String
       -> [String]
227
       -> SolverResult
Edsko de Vries's avatar
Edsko de Vries committed
228
       -> SolverTest
229
mkTest = mkTestExtLangPC Nothing Nothing []
230
231
232
233
234

mkTestExts :: [Extension]
           -> ExampleDb
           -> String
           -> [String]
235
           -> SolverResult
236
           -> SolverTest
237
mkTestExts exts = mkTestExtLangPC (Just exts) Nothing []
238
239
240
241
242

mkTestLangs :: [Language]
            -> ExampleDb
            -> String
            -> [String]
243
            -> SolverResult
244
            -> SolverTest
245
246
247
248
249
250
mkTestLangs langs = mkTestExtLangPC Nothing (Just langs) []

mkTestPCDepends :: [(String, String)]
                -> ExampleDb
                -> String
                -> [String]
251
                -> SolverResult
252
253
254
255
256
257
258
259
260
                -> SolverTest
mkTestPCDepends pkgConfigDb = mkTestExtLangPC Nothing Nothing pkgConfigDb

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

runTest :: SolverTest -> TF.TestTree
runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
    testCase testLabel $ do
279
280
281
282
283
284
285
286
      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
287
      case result of
288
289
290
291
292
293
294
295
296
297
        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
298
299
300
301
302
303
304

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

db1 :: ExampleDb
db1 =
305
    let a = exInst "A" 1 "A-1" []
Edsko de Vries's avatar
Edsko de Vries committed
306
    in [ Left a
307
308
309
310
311
312
313
314
       , 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
315
316
317
318
319
320
       ]

-- 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 = [
321
322
323
324
325
326
    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
327
328
329
330
  ]

db3 :: ExampleDb
db3 = [
331
332
     Right $ exAv "A" 1 []
   , Right $ exAv "A" 2 []
333
   , Right $ exAv "B" 1 [exFlag "flagB" [ExFix "A" 1] [ExFix "A" 2]]
334
335
   , 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
336
337
   ]

338
-- | Like db3, but the flag picks a different package rather than a
Edsko de Vries's avatar
Edsko de Vries committed
339
340
-- different package version
--
341
-- In db3 we cannot install C and D as independent goals because:
Edsko de Vries's avatar
Edsko de Vries committed
342
343
--
-- * The multiple instance restriction says C and D _must_ share B
344
345
-- * 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
346
347
348
349
350
-- * 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
351
-- 1.A and therefore we cannot link 0.B to 1.B.
Edsko de Vries's avatar
Edsko de Vries committed
352
--
353
-- In db4 the situation however is trickier. We again cannot install
Edsko de Vries's avatar
Edsko de Vries committed
354
355
356
357
358
359
360
361
362
363
364
-- 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
365
366
-- * 0.B relies on Ay-1
-- * 1.B relies on Ax-1
Edsko de Vries's avatar
Edsko de Vries committed
367
--
368
-- 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
369
370
371
-- we only ever assign to one of these, these constraints are never broken.
db4 :: ExampleDb
db4 = [
372
373
374
375
     Right $ exAv "Ax" 1 []
   , Right $ exAv "Ax" 2 []
   , Right $ exAv "Ay" 1 []
   , Right $ exAv "Ay" 2 []
376
   , Right $ exAv "B"  1 [exFlag "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]]
377
378
   , 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
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
   ]

-- | 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 = [
398
399
400
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "B" 1 []
401
402
403
404
405
  , 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
406
407
408
409
410
411
412
413
414
415
416
417
  ]

-- 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 = [
418
419
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
420
  , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"]
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
468
469
470
471
472
473
474
  , 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
475
476
  ]

477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
-- 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]
    ]

496
-- | This database tests that a package's setup dependencies are correctly
497
-- linked when the package is linked. See pull request #3268.
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
--
-- 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 []
  ]

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
545
546
547
548
549
550
551
-- | 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]
    ]

552
553
554
555
556
557
558
db13 :: ExampleDb
db13 = [
    Right $ exAv "A" 1 []
  , Right $ exAv "A" 2 []
  , Right $ exAv "A" 3 []
  ]

559
560
561
562
563
564
565
566
567
568
569
570
571
572
-- | 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 []
  ]

573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
-- | 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]
  ]

596
-- | Check that the solver can backtrack after encountering the SIR (issue #2843)
Edsko de Vries's avatar
Edsko de Vries committed
597
598
--
-- When A and B are installed as independent goals, the single instance
599
600
-- 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
601
602
603
604
605
606
607
608
609
610
611
612
-- 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.
613
614
615
616
db16 :: ExampleDb
db16 = [
    Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1]
  , Right $ exAv "B" 1 [ ExFix "D" 2
617
                       , exFlag "flagA"
618
                             [ExAny "C"]
619
                             [exFlag "flagB"
620
621
622
623
624
625
626
                                 [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
627

628
-- | This test checks that when the solver discovers a constraint on a
kristenk's avatar
kristenk committed
629
-- package's version after choosing to link that package, it can backtrack to
630
-- try alternative versions for the linked-to package. See pull request #3327.
kristenk's avatar
kristenk committed
631
632
633
--
-- 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
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
-- 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
663

664
665
-- | Issue #2834
-- When both A and B are installed as independent goals, their dependencies on
kristenk's avatar
kristenk committed
666
667
668
669
-- 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.
670
671
672
673
674
675
676
677
678
679
--
-- > 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
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
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 []
  ]

696
-- | Tricky test case with independent goals (issue #2842)
Edsko de Vries's avatar
Edsko de Vries committed
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
--
-- 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
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
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"
      ]
749

750
-- | This test checks that the solver correctly backjumps when dependencies
751
752
753
754
-- 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.
--
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
783
784
785
786
787
788
789
-- 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
      ]
790

791
-- | Test the trace messages that we get when a package refers to an unknown pkg
792
--
793
794
-- TODO: Currently we don't actually test the trace messages, and this particular
-- test still suceeds. The trace can only be verified by hand.
795
796
797
798
799
800
801
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 []
  ]

802
-- | A variant of 'db21', which actually fails.
803
804
805
806
807
808
db22 :: ExampleDb
db22 = [
    Right $ exAv "A" 1 [ExAny "B"]
  , Right $ exAv "A" 2 [ExAny "C"]
  ]

809
810
811
812
813
814
815
816
817
818
819
-- | 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
820
821
822
823
824
825
826
827
828
829
830
831
832
-- | 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.
--
833
834
835
836
837
testIndepGoals5 :: String -> GoalOrder -> SolverTest
testIndepGoals5 name fixGoalOrder =
    case fixGoalOrder of
      FixedGoalOrder   -> goalOrder goals test
      DefaultGoalOrder -> test
838
  where
839
840
841
842
843
    test :: SolverTest
    test = indep $ mkTest db name ["X", "Y"] $
           SolverSuccess
           [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)]

844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
    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
866

867
-- | A simplified version of 'testIndepGoals5'.
868
869
870
871
872
testIndepGoals6 :: String -> GoalOrder -> SolverTest
testIndepGoals6 name fixGoalOrder =
    case fixGoalOrder of
      FixedGoalOrder   -> goalOrder goals test
      DefaultGoalOrder -> test
873
  where
874
875
876
877
878
    test :: SolverTest
    test = indep $ mkTest db name ["X", "Y"] $
           SolverSuccess
           [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)]

879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
    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
898

899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
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"]
  ]

915
916
917
-- | 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".
918
919
testBuildable :: String -> ExampleDependency -> TestTree
testBuildable testName unavailableDep =
920
    runTest $ mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected
921
  where
922
    expected = SolverSuccess [("false-dep", 1), ("pkg", 1)]
923
    db = [
924
925
926
927
928
929
930
        Right $ exAv "pkg" 1
            [ unavailableDep
            , ExFlag "enable-lib" (Buildable []) NotBuildable ]
         `withTest`
            ExTest "test" [exFlag "enable-lib"
                              [ExAny "true-dep"]
                              [ExAny "false-dep"]]
931
932
933
934
      , Right $ exAv "true-dep" 1 []
      , Right $ exAv "false-dep" 1 []
      ]

935
936
-- | cabal must choose -flag1 +flag2 for "pkg", which requires packages
-- "flag1-false" and "flag2-true".
937
938
939
940
dbBuildable1 :: ExampleDb
dbBuildable1 = [
    Right $ exAv "pkg" 1
        [ ExAny "unknown"
941
        , ExFlag "flag1" (Buildable []) NotBuildable
942
943
944
        , ExFlag "flag2" (Buildable []) NotBuildable]
     `withTests`
        [ ExTest "optional-test"
945
946
              [ ExAny "unknown"
              , ExFlag "flag1"
947
948
                    (Buildable [])
                    (Buildable [ExFlag "flag2" NotBuildable (Buildable [])])]
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
        , 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"]
  ]
969

970
971
972
973
974
975
976
977
978
-- | 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"]
  ]

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 []
  ]

For faster browsing, not all history is shown. View entire blame