1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
-- | Tests for detecting space leaks in the dependency solver.
module UnitTests.Distribution.Solver.Modular.MemoryUsage (tests) where
import Test.Tasty (TestTree)
import UnitTests.Distribution.Solver.Modular.DSL
import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
tests :: [TestTree]
tests = [
runTest $ basicTest "basic space leak test"
, runTest $ flagsTest "package with many flags"
, runTest $ issue2899 "issue #2899"
, runTest $ duplicateDependencies "duplicate dependencies"
, runTest $ duplicateFlaggedDependencies "duplicate flagged dependencies"
]
-- | This test solves for n packages that each have two versions. There is no
-- solution, because the nth package depends on another package that doesn't fit
-- its version constraint. Backjumping and fine grained conflicts are disabled,
-- so the solver must explore a search tree of size 2^n. It should fail if
-- memory usage is proportional to the size of the tree.
basicTest :: String -> SolverTest
basicTest name =
disableBackjumping $
disableFineGrainedConflicts $
mkTest pkgs name ["target"] anySolverFailure
where
n :: Int
n = 18
pkgs :: ExampleDb
pkgs = map Right $
[ exAv "target" 1 [ExAny $ pkgName 1]]
++ [ exAv (pkgName i) v [ExRange (pkgName $ i + 1) 2 4]
| i <- [1..n], v <- [2, 3]]
++ [exAv (pkgName $ n + 1) 1 []]
pkgName :: Int -> ExamplePkgName
pkgName x = "pkg-" ++ show x
-- | This test is similar to 'basicTest', except that it has one package with n
-- flags, flag-1 through flag-n. The solver assigns flags in order, so it
-- doesn't discover the unknown dependencies under flag-n until it has assigned
-- all of the flags. It has to explore the whole search tree.
flagsTest :: String -> SolverTest
flagsTest name =
disableBackjumping $
disableFineGrainedConflicts $
goalOrder orderedFlags $ mkTest pkgs name ["pkg"] anySolverFailure
where
n :: Int
n = 16
pkgs :: ExampleDb
pkgs = [Right $ exAv "pkg" 1 $
[exFlagged (numberedFlag n) [ExAny "unknown1"] [ExAny "unknown2"]]
-- The remaining flags have no effect:
++ [exFlagged (numberedFlag i) [] [] | i <- [1..n - 1]]
]
orderedFlags :: [ExampleVar]
orderedFlags = [F QualNone "pkg" (numberedFlag i) | i <- [1..n]]
-- | Test for a space leak caused by sharing of search trees under packages with
-- link choices (issue #2899).
--
-- The goal order is fixed so that the solver chooses setup-dep and then
-- target-setup.setup-dep at the top of the search tree. target-setup.setup-dep
-- has two choices: link to setup-dep, and don't link to setup-dep. setup-dep
-- has a long chain of dependencies (pkg-1 through pkg-n). However, pkg-n
-- depends on pkg-n+1, which doesn't exist, so there is no solution. Since each
-- dependency has two versions, the solver must try 2^n combinations when
-- backjumping and fine grained conflicts are disabled. These combinations
-- create large search trees under each of the two choices for
-- target-setup.setup-dep. Although the choice to not link is disallowed by the
-- Single Instance Restriction, the solver doesn't know that until it has
-- explored (and evaluated) the whole tree under the choice to link. If the two
-- trees are shared, memory usage spikes.
issue2899 :: String -> SolverTest
issue2899 name =
disableBackjumping $
disableFineGrainedConflicts $
goalOrder goals $ mkTest pkgs name ["target"] anySolverFailure
where
n :: Int
n = 16
pkgs :: ExampleDb
pkgs = map Right $
[ exAv "target" 1 [ExAny "setup-dep"] `withSetupDeps` [ExAny "setup-dep"]
, exAv "setup-dep" 1 [ExAny $ pkgName 1]]
++ [ exAv (pkgName i) v [ExAny $ pkgName (i + 1)]
| i <- [1..n], v <- [1, 2]]
pkgName :: Int -> ExamplePkgName
pkgName x = "pkg-" ++ show x
goals :: [ExampleVar]
goals = [P QualNone "setup-dep", P (QualSetup "target") "setup-dep"]
-- | Test for an issue related to lifting dependencies out of conditionals when
-- converting a PackageDescription to the solver's internal representation.
--
-- Issue:
-- For each conditional and each package B, the solver combined each dependency
-- on B in the true branch with each dependency on B in the false branch. It
-- added the combined dependencies to the build-depends outside of the
-- conditional. Since dependencies could be lifted out of multiple levels of
-- conditionals, the number of new dependencies could grow exponentially in the
-- number of levels. For example, the following package generated 4 copies of B
-- under flag-2=False, 8 copies under flag-1=False, and 16 copies at the top
-- level:
--
-- if flag(flag-1)
-- build-depends: B, B
-- else
-- if flag(flag-2)
-- build-depends: B, B
-- else
-- if flag(flag-3)
-- build-depends: B, B
-- else
-- build-depends: B, B
--
-- This issue caused the quickcheck tests to start frequently running out of
-- memory after an optimization that pruned unreachable branches (See PR #4929).
-- Each problematic test case contained at least one build-depends field with
-- duplicate dependencies, which was then duplicated under multiple levels of
-- conditionals by the solver's "buildable: False" transformation, when
-- "buildable: False" was under multiple flags. Finally, the branch pruning
-- feature put all build-depends fields in consecutive levels of the condition
-- tree, causing the solver's representation of the package to follow the
-- pattern in the example above.
--
-- Now the solver avoids this issue by combining all dependencies on the same
-- package before lifting them out of conditionals.
--
-- This test case is an expanded version of the example above, with library and
-- build-tool dependencies.
duplicateDependencies :: String -> SolverTest
duplicateDependencies name =
mkTest pkgs name ["A"] $ solverSuccess [("A", 1), ("B", 1)]
where
copies, depth :: Int
copies = 50
depth = 50
pkgs :: ExampleDb
pkgs = [
Right $ exAv "A" 1 (dependencyTree 1)
, Right $ exAv "B" 1 [] `withExe` exExe "exe" []
]
dependencyTree :: Int -> [ExampleDependency]
dependencyTree n
| n > depth = buildDepends
| otherwise = [exFlagged (numberedFlag n) buildDepends
(dependencyTree (n + 1))]
where
buildDepends = replicate copies (ExFix "B" 1)
++ replicate copies (ExBuildToolFix "B" "exe" 1)
-- | This test is similar to duplicateDependencies, except that every dependency
-- on B is replaced by a conditional that contains B in both branches. It tests
-- that the solver doesn't just combine dependencies within one build-depends or
-- build-tool-depends field; it also needs to combine dependencies after they
-- are lifted out of conditionals.
duplicateFlaggedDependencies :: String -> SolverTest
duplicateFlaggedDependencies name =
mkTest pkgs name ["A"] $ solverSuccess [("A", 1), ("B", 1)]
where
copies, depth :: Int
copies = 15
depth = 15
pkgs :: ExampleDb
pkgs = [
Right $ exAv "A" 1 (dependencyTree 1)
, Right $ exAv "B" 1 [] `withExe` exExe "exe" []
]
dependencyTree :: Int -> [ExampleDependency]
dependencyTree n
| n > depth = flaggedDeps
| otherwise = [exFlagged (numberedFlag n) flaggedDeps
(dependencyTree (n + 1))]
where
flaggedDeps = zipWith ($) (replicate copies flaggedDep) [0 :: Int ..]
flaggedDep m = exFlagged (numberedFlag n ++ "-" ++ show m) buildDepends
buildDepends
buildDepends = [ExFix "B" 1, ExBuildToolFix "B" "exe" 1]
numberedFlag :: Int -> ExampleFlagName
numberedFlag n = "flag-" ++ show n
|
