cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs

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