Allow "cycles" through test suite dependencies (VERSION TWO)

Cabal/doc/developing-packages.markdown

@@ -1237,6 +1237,47 @@ $ cabal test
 See the output of `cabal help test` for a list of options you can pass
 to `cabal test`.
 
+#### Package cycles through test suites ####
+
+A lot of test suites depend on the `tasty` test infrastructure. However, `tasty`
+has a bunch of dependencies of its own; for example, `tasty` depends both on the
+`containers` package and the `optparse-applicative` package. Take `containers`
+as an example: we might like to be able to use `tasty` in the test-suite for
+containers, but is that possible? It seems to create a cyclic dependency with
+`tasty` depending on `containers` and `containers` in turn depending on `tasty`.
+
+In one sense, it can be argued that this cycle is not actually real. After all,
+we can first build `containers` without its test suite, then `tasty`,
+and finally the `containers` test suite. Right now this is only possible to do
+by hand; `cabal` cannot currently "split" packages in that way.
+
+But perhaps this isn't the right solution anyway. Suppose that we are working
+on the `containers` package; let's say for the sake of the discussion that we
+are experimenting with changing the internal representation of a `Map` (one
+of the datatypes provided by `containers`). Do we really want to build
+`containers`, then rebuild `tasty`, and finally rebuild the `containers` test
+suite for every change to `containers` that we make? Probably not. Not only
+would it be annoyingly slow, but do we really want to build `tasty` against
+a possible broken version of `containers`? Far better to build `tasty` against a
+known stable version of `containers` while we experiment.
+
+If we want to do that, however, it means that the `containers` test suite
+executable now uses _two_ versions of `containers`: the version-under-test
+and the older, stable version that we have linked `tasty` against.
+
+As of  version 1.24, this scenario is supported. The `cabal` solver can make
+independent choices for the dependencies of test suites which do not appear
+as (direct) dependencies of any other component in the package. In other words,
+if the test suite for `containers` _directly_ depends on `containers` (as it
+typically will), then _this_ version of containers _must_ be equal to the
+current version. It would be terribly confusing if the test suite got built
+against an older version after all! However, any dependencies of the test suite
+that do _not_ appear as dependencies elsewhere (such as `tasty`) will be
+considered independent; in our example, this means that the solver will be able
+to make independent choices for the dependency on `tasty`, _including all its
+transitive dependencies_, thus allowing it to pick a different version of
+`containers` to satisfy `tasty`'s dependency.
+
 ### Benchmarks ###
 
 Benchmark sections (if present) describe benchmarks contained in the package and

cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs

@@ -39,6 +39,7 @@ module Distribution.Client.Dependency.Modular.Dependency (
 import Prelude hiding (pi)
 
 import Data.List (intercalate)
+import Data.Maybe (mapMaybe)
 import Data.Map (Map)
 import Data.Set (Set)
 import qualified Data.List as L
@@ -227,17 +228,26 @@ data QualifyOptions = QO {
     -- | Do we have a version of base relying on another version of base?
     qoBaseShim :: Bool
 
-    -- Should dependencies of the setup script be treated as independent?
+    -- | Should dependencies of the setup script be treated as independent?
   , qoSetupIndependent :: Bool
+
+    -- | Should dependencies of a test suite, which are not shared with the
+    -- main library, be considered independent?
+  , qoTestsIndependent :: Bool
   }
   deriving Show
 
 -- | Apply built-in rules for package qualifiers
 --
 -- NOTE: It's the _dependencies_ of a package that may or may not be independent
 -- from the package itself. Package flag choices must of course be consistent.
+--
+-- NOTE 2: This should be called on _all_ dependencies of a package. If it gets
+-- called on a subset of the dependencies, we might construct invalid
+-- quantifiers. In particular, we might conclude that a dependency of a test
+-- suite is not shared with the library and hence is independent.
 qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps Component PN -> FlaggedDeps Component QPN
-qualifyDeps QO{..} (Q pp@(PP ns q) pn) = go
+qualifyDeps QO{..} (Q pp@(PP ns q) pn) allDeps = go allDeps
   where
     go :: FlaggedDeps Component PN -> FlaggedDeps Component QPN
     go = map go1
@@ -260,9 +270,10 @@ qualifyDeps QO{..} (Q pp@(PP ns q) pn) = go
     goD (Lang lang)   _    = Lang lang
     goD (Pkg pkn vr)  _    = Pkg pkn vr
     goD (Dep  dep ci) comp
-      | qBase  dep  = Dep (Q (PP ns (Base  pn)) dep) (fmap (Q pp) ci)
-      | qSetup comp = Dep (Q (PP ns (Setup pn)) dep) (fmap (Q pp) ci)
-      | otherwise   = Dep (Q (PP ns inheritedQ) dep) (fmap (Q pp) ci)
+      | qBase  dep      = Dep (Q (PP ns (Base  pn)) dep) (fmap (Q pp) ci)
+      | qSetup     comp = Dep (Q (PP ns (Setup pn)) dep) (fmap (Q pp) ci)
+      | qTest  dep comp = Dep (Q (PP ns (Test  pn)) dep) (fmap (Q pp) ci)
+      | otherwise       = Dep (Q (PP ns inheritedQ) dep) (fmap (Q pp) ci)
 
     -- If P has a setup dependency on Q, and Q has a regular dependency on R, then
     -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup
@@ -273,17 +284,39 @@ qualifyDeps QO{..} (Q pp@(PP ns q) pn) = go
     -- a detailed discussion.
     inheritedQ :: Qualifier
     inheritedQ = case q of
-                   Setup _     -> q
                    Unqualified -> q
-                   Base _      -> Unqualified
+                   Setup _     -> q
+                   Test  _     -> q
+                   Base  _     -> Unqualified
 
     -- Should we qualify this goal with the 'Base' package path?
     qBase :: PN -> Bool
     qBase dep = qoBaseShim && unPackageName dep == "base"
 
     -- Should we qualify this goal with the 'Setup' package path?
     qSetup :: Component -> Bool
-    qSetup comp = qoSetupIndependent && comp == ComponentSetup
+    qSetup ComponentSetup = qoSetupIndependent
+    qSetup _ = False
+
+    -- Should we qualify this goal with the 'Test' package path?
+    qTest :: PN -> Component -> Bool
+    qTest dep (ComponentTest _) = and [ qoTestsIndependent
+                                      , not $ isInternalDep dep
+                                      , dep `S.notMember` libDeps
+                                      ]
+    qTest _ _ = False
+
+    -- The dependencies of the main library only
+    libDeps :: Set PN
+    libDeps = S.fromList $ mapMaybe maybeLibDep $ flattenFlaggedDeps allDeps
+
+    -- Is this an internal dependency? (Say, from a test suite on the lib)
+    isInternalDep :: PN -> Bool
+    isInternalDep dep = dep == pn
+
+    maybeLibDep :: (Dep PN, Component) -> Maybe PN
+    maybeLibDep (Dep qpn _ci, ComponentLib _) = Just qpn
+    maybeLibDep _otherwise                    = Nothing
 
 {-------------------------------------------------------------------------------
   Setting/forgetting the Component

cabal-install/Distribution/Client/Dependency/Modular/Index.hs

@@ -38,15 +38,22 @@ groupMap xs = M.fromListWith (flip (++)) (L.map (\ (x, y) -> (x, [y])) xs)
 
 defaultQualifyOptions :: Index -> QualifyOptions
 defaultQualifyOptions idx = QO {
-      qoBaseShim         = or [ dep == base
-                              | -- Find all versions of base ..
-                                Just is <- [M.lookup base idx]
-                                -- .. which are installed ..
-                              , (I _ver (Inst _), PInfo deps _flagNfo _fr) <- M.toList is
-                                -- .. and flatten all their dependencies ..
-                              , (Dep dep _ci, _comp) <- flattenFlaggedDeps deps
-                              ]
-    , qoSetupIndependent = True
+      qoSetupIndependent = True
+    , qoTestsIndependent = True
+    , qoBaseShim         = baseOnBaseDependency
     }
   where
+    -- does base depend on base?
+    baseOnBaseDependency :: Bool
+    baseOnBaseDependency = or [
+        dep == base
+      | -- Find all versions of base ..
+        Just is <- [M.lookup base idx]
+        -- .. which are installed ..
+      , (I _ver (Inst _), PInfo deps _flagNfo _fr) <- M.toList is
+        -- .. and flatten all their dependencies ..
+      , (Dep dep _ci, _comp) <- flattenFlaggedDeps deps
+      ]
+
+    base :: PackageName
     base = PackageName "base"

cabal-install/Distribution/Client/Dependency/Modular/Package.hs

@@ -119,17 +119,24 @@ data Qualifier =
     -- infinite search trees in the solver. Therefore we limit ourselves to
     -- a single qualifier (within a given namespace).
   | Setup PN
+
+    -- | (Private) dependency of a test suite
+    --
+    -- We use this qualifier only for test suite dependencies that are not
+    -- shared with the main library.
+  | Test PN
   deriving (Eq, Ord, Show)
 
 -- | Is the package in the primary group of packages. In particular this
--- does not include packages pulled in as setup deps.
+-- does not include packages pulled in as setup deps or private test suite deps.
 --
 primaryPP :: PP -> Bool
 primaryPP (PP _ns q) = go q
   where
     go Unqualified = True
     go (Base  _)   = True
     go (Setup _)   = False
+    go (Test  _)   = False
 
 -- | String representation of a package path.
 --
@@ -150,6 +157,7 @@ showPP (PP ns q) =
     -- 'Base' qualifier, will always be @base@).
     go Unqualified = ""
     go (Setup pn)  = display pn ++ "-setup."
+    go (Test  pn)  = display pn ++ "-test."
     go (Base  pn)  = display pn ++ "."
 
 -- | A qualified entity. Pairs a package path with the entity.

cabal-install/Distribution/Client/PlanIndex.hs

@@ -57,6 +57,8 @@ brokenPackages index =
 -- | Compute all roots of the install plan, and verify that the transitive
 -- plans from those roots are all consistent.
 --
+-- NOTE: We check the consistency of libraries only (see note on 'rootSets').
+--
 -- NOTE: This does not check for dependency cycles. Moreover, dependency cycles
 -- may be absent from the subplans even if the larger plan contains a dependency
 -- cycle. Such cycles may or may not be an issue; either way, we don't check
@@ -70,20 +72,23 @@ dependencyInconsistencies indepGoals index  =
   where
     subplans :: [PackageIndex pkg]
     subplans = rights $
-                 map (dependencyClosure index)
+                 map (dependencyClosure CD.libraryDeps index)
                      (rootSets indepGoals index)
 
 -- | Compute the root sets of a plan
 --
 -- A root set is a set of packages whose dependency closure must be consistent.
 -- This is the set of all top-level library roots (taken together normally, or
--- as singletons sets if we are considering them as independent goals), along
--- with all setup dependencies of all packages.
+-- as singletons sets if we are considering them as independent goals).
+--
+-- We do not consider executables/testsuites/setup scripts/etc here, because
+-- we want to allow them to have inconsistent package choices (we might want
+-- to link two versions of a library into an executable undercertain
+-- circumstances). We insist on consistency only for libraries.
 rootSets :: (PackageFixedDeps pkg, HasUnitId pkg)
          => Bool -> PackageIndex pkg -> [[UnitId]]
 rootSets indepGoals index =
        if indepGoals then map (:[]) libRoots else [libRoots]
-    ++ setupRoots index
   where
     libRoots = libraryRoots index
 
@@ -101,12 +106,6 @@ libraryRoots index =
     roots    = filter isRoot (Graph.vertices graph)
     isRoot v = indegree ! v == 0
 
--- | The setup dependencies of each package in the plan
-setupRoots :: PackageFixedDeps pkg => PackageIndex pkg -> [[UnitId]]
-setupRoots = filter (not . null)
-           . map (CD.setupDeps . depends)
-           . allPackages
-
 -- | Given a package index where we assume we want to use all the packages
 -- (use 'dependencyClosure' if you need to get such a index subset) find out
 -- if the dependencies within it use consistent versions of each package.
@@ -180,19 +179,24 @@ dependencyCycles index =
 
 -- | Tries to take the transitive closure of the package dependencies.
 --
+-- The function is parameterized by the kind of dependencies we should be
+-- considering.
+--
 -- If the transitive closure is complete then it returns that subset of the
 -- index. Otherwise it returns the broken packages as in 'brokenPackages'.
 --
 -- * Note that if the result is @Right []@ it is because at least one of
 -- the original given 'PackageIdentifier's do not occur in the index.
 dependencyClosure :: (PackageFixedDeps pkg, HasUnitId pkg)
-                  => PackageIndex pkg
+                  => (CD.ComponentDeps [UnitId] -> [UnitId])
+                  -> PackageIndex pkg
                   -> [UnitId]
                   -> Either [(pkg, [UnitId])]
                             (PackageIndex pkg)
-dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
-  (completed, []) -> Right completed
-  (completed, _)  -> Left (brokenPackages completed)
+dependencyClosure selectDeps index pkgids0 =
+  case closure mempty [] pkgids0 of
+    (completed, []) -> Right completed
+    (completed, _)  -> Left (brokenPackages completed)
  where
     closure completed failed []             = (completed, failed)
     closure completed failed (pkgid:pkgids) =
@@ -204,7 +208,7 @@ dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
             Just _  -> closure completed  failed pkgids
             Nothing -> closure completed' failed pkgids'
               where completed' = insert pkg completed
-                    pkgids'    = CD.nonSetupDeps (depends pkg) ++ pkgids
+                    pkgids'    = selectDeps (depends pkg) ++ pkgids
 
 
 -- | Builds a graph of the package dependencies.

cabal-install/cabal-install.cabal

@@ -76,6 +76,19 @@ Extra-Source-Files:
   tests/IntegrationTests/multiple-source/p/p.cabal
   tests/IntegrationTests/multiple-source/q/Setup.hs
   tests/IntegrationTests/multiple-source/q/q.cabal
+  tests/IntegrationTests/private-test-deps/A.cabal
+  tests/IntegrationTests/private-test-deps/Setup.hs
+  tests/IntegrationTests/private-test-deps/deps/A-1/A.cabal
+  tests/IntegrationTests/private-test-deps/deps/A-1/Setup.hs
+  tests/IntegrationTests/private-test-deps/deps/A-1/src/A.hs
+  tests/IntegrationTests/private-test-deps/deps/T/Setup.hs
+  tests/IntegrationTests/private-test-deps/deps/T/T.cabal
+  tests/IntegrationTests/private-test-deps/deps/T/src/T.hs
+  tests/IntegrationTests/private-test-deps/multiple-versions-of-A.err
+  tests/IntegrationTests/private-test-deps/multiple-versions-of-A.out
+  tests/IntegrationTests/private-test-deps/multiple-versions-of-A.sh
+  tests/IntegrationTests/private-test-deps/src/A.hs
+  tests/IntegrationTests/private-test-deps/test/Test.hs
   tests/IntegrationTests/sandbox-sources/fail_removing_source_thats_not_registered.err
   tests/IntegrationTests/sandbox-sources/fail_removing_source_thats_not_registered.sh
   tests/IntegrationTests/sandbox-sources/p/Setup.hs

cabal-install/tests/IntegrationTests/private-test-deps/A.cabal

@@ -0,0 +1,22 @@
+name:                A
+version:             2
+license:             BSD3
+license-file:        LICENSE
+author:              Edsko de Vries
+maintainer:          [email protected]
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     A
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  build-depends:       base >=4.5
+
+test-suite T-test
+  type:                exitcode-stdio-1.0
+  main-is:             Test.hs
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  build-depends:       base >=4.5, A, T

cabal-install/tests/IntegrationTests/private-test-deps/ChangeLog.md

@@ -0,0 +1,5 @@
+# Revision history for A
+
+## 2  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

cabal-install/tests/IntegrationTests/private-test-deps/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2016, Edsko de Vries
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Edsko de Vries nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

cabal-install/tests/IntegrationTests/private-test-deps/README

@@ -0,0 +1,12 @@
+This test models the cycle
+
+  optparse-applicative has test-suite dependency on tasty 
+  tasty depends on optparse-applicative
+
+In the test, package "A" models optparse-applicative; there are two versions
+available (1 and 2), and package "T" models tasty. 
+
+The output of the test shows the versions of the packages involved, and it shows
+that the direct dependency of optparse-applicative (A)'s test suite uses version
+2, but the indirect dependency on itself (through tasty/T) uses version 1.
+

cabal-install/tests/IntegrationTests/private-test-deps/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain