Test case for issue #2899.

Author: sebright

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

@@ -10,6 +10,7 @@ tests :: [TestTree]
 tests = [
       runTest $ basicTest "basic space leak test"
     , runTest $ flagsTest "package with many flags"
+    , runTest $ issue2899 "issue #2899"
     ]
 
 -- | This test solves for n packages that each have two versions. Backjumping
@@ -56,3 +57,38 @@ flagsTest name =
 
     orderedFlags :: [ExampleVar]
     orderedFlags = [F None "pkg" (flagName 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 is 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 $
+    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 None "setup-dep", P (Setup "target") "setup-dep"]