From 106b16a5aa98e257e0b175282f44ae2e12ebf398 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 11 Mar 2016 11:33:25 +0800 Subject: [PATCH 1/8] Add test for cycles through test suites Of course, this test currently fails. --- .../Client/Dependency/Modular/Solver.hs | 98 +++++++++++++++++++ 1 file changed, 98 insertions(+) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index 7086a65068f..fdeb8c65fea 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -83,6 +83,10 @@ tests = [ , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (Just [("C", 2), ("D", 1)]) , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (Just [("D", 1)]) , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (Just [("C", 2), ("D", 1), ("E", 1)]) + , runTest $ mkTest db16 "cycleThroughTests1a" ["B"] (Just [ ("A" , 2), ("B" , 1), ("T" , 1)]) + , runTest $ mkTest db17 "cycleThroughTests1b" ["B"] (Just [("A" , 1), ("A" , 2), ("B" , 1), ("T" , 1)]) + , runTest $ mkTest db16 "cycleThroughTests2a" ["B'"] (Just [ ("A'", 2), ("B'", 1), ("T'", 1)]) + , runTest $ mkTest db17 "cycleThroughTests2b" ["B'"] (Just [("A'", 1), ("A'", 2), ("B'", 1), ("T'", 1)]) ] , testGroup "Extensions" [ runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] Nothing @@ -507,6 +511,100 @@ db15 = [ , Right $ exAv "E" 1 [ExFix "C" 2] ] +-- | Cycles through test cycles that can be broken if test suites dependencies +-- are independent from dependencies of the library proper +-- +-- This models situations such as the following: +-- +-- * optparse-applicative (A) has a test suite that depends on tasty (T) +-- * tasty (T) has a (regular) dependency on optparse-applicative +-- +-- We can resolve this by linking optparse-applicative's test suite against an +-- older version of itself. +-- +-- Test suites can be written in two different ways: +-- +-- * The test suite declares an explicit, internal, dependency on the library +-- * The test suite compiles the library in directly (by adding the @/src@ +-- to the test suite's list of source directories, or whatever) +-- +-- Whichever option is chosen, it is of course very important that the test +-- suite gets compiled against /this/ version of the library. It would be +-- terribly confusing if tests started failing because the test suite got built +-- against an old version of the library from Hackage, rather than the version +-- in the current directory. This happens by default if option (B) is chosen, +-- but in the case of option (A) we need to make sure that the solver picks the +-- right version (that is, /this/ version) for the internal dependency. +-- +-- In the case of optparse-applicative's test suite, the tests should be +-- linked against /this/ version of optparse-applicative; however, it is not +-- essential that its transitive dependency on itself through tasty is also +-- linked against the same version. Indeed, the only way to break the cycle is +-- to link tasty against a /different/ version (typically an older, perhaps +-- already installed, version). +-- +-- This means that (again whichever method we chose) we will end up with two +-- versions of the library in a single executable (the test suite): in the +-- example, we will have both the version of optparse-applicative that we are +-- testing as well as the older version that we linked tasty against. This does +-- have the unfortunate consequence that if tasty does not re-export all +-- functionality from optparse-applicative, it might mean that +-- optparse-applicative cannot use tasty's full functionality because it cannot +-- construct elements of types defined in the older version of +-- optparse-applicative (as it can only import the newer version). What this +-- means in practice is that if this feature becomes more popular, packages like +-- tasty will have become more careful with their "private" dependencies, +-- re-exporting the bits of optparse-applicative that it requires for its API. +-- +-- Normally when we compile a library, we conservatively assume that all its +-- transitive dependencies should be able to be used together. For test suites +-- however we optimistically assume that any of the transitive dependencies +-- of the "private" test suite dependencies are not used by the library and +-- can therefore be different versions. +-- +-- In this database we test both scenarios: A, T, B models the scenario where +-- the test suite compiles in the library directly; A', T', B' models the +-- scenario where the test suite declares the internal lib dependency. +-- (B/B' is just there to force the version of A.) We expect the same +-- solution in either case. +db16 :: ExampleDb +db16 = [ + -- No internal dependency + Left $ exInst "A" 1 "A-1" [] + , Right $ exAv "A" 2 [ExTest "A-test-suite" [ExAny "T"]] + , Right $ exAv "T" 1 [ExAny "A"] + , Right $ exAv "B" 1 [ExFix "A" 2] + -- With internal dependency + , Left $ exInst "A'" 1 "A'-1" [] + , Right $ exAv "A'" 2 [ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"]] + , Right $ exAv "T'" 1 [ExAny "A'"] + , Right $ exAv "B'" 1 [ExFix "A'" 2] + ] + +-- | Like 'db16', but now with the older version of optparse-applicative (A) +-- not yet installed +-- +-- In this test we declare the older version of optparse-applicative (A) not +-- to have any test suite dependencies. In reality, it might well have such +-- dependencies, including a dependency on tasty and hence a recursive +-- dependency on itself, but we simply wouldn't enable the test suite. +-- We cannot test that here right now because the solver DSL requires all +-- test suites to be built. +db17 :: ExampleDb +db17 = [ + -- No internal dependency + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [ExTest "A-test-suite" [ExAny "T"]] + , Right $ exAv "T" 1 [ExAny "A"] + , Right $ exAv "B" 1 [ExFix "A" 2] + -- With internal dependency + , Right $ exAv "A'" 1 [] + , Right $ exAv "A'" 2 [ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"]] + , Right $ exAv "T'" 1 [ExAny "A'"] + , Right $ exAv "B'" 1 [ExFix "A'" 2] + ] + + dbExts1 :: ExampleDb dbExts1 = [ Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)] From ff4d4b8987613f2b3939330c278511e214e6dc2b Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 11 Mar 2016 15:09:30 +0800 Subject: [PATCH 2/8] Make private test suite deps independent When a test suite has a dependency which is not shared with the main library, we can consider it independent. This addresses #1575 to some degree. Suppose * optparse-applicative has a test suite that depends on tasty * tasty has a (regular) dependency on optparse-applicative We can resolve this by linking optparse-applicative's test suite against an older version of itself. This only works provided that optparse-applicative's test suite does not declare optparse-applicative as a dependency (and instead just compiles in the modules from the src/ directory or whatever). If the test suite did declare the library as a dependency, then clearly the test suite needs to be built against _this_ version of the library; it would be terribly confusing if the test suite got built against an older version. But if the test suite gets built against the library itself, then if the test suite also needs tasty, we cannot pick two different versions in the same application (yet). In this commit we add the appropriate qualifiers; however, the resulting install plan will now be rejected by the internal validity check. That's next up. --- .../Client/Dependency/Modular/Dependency.hs | 49 ++++++++++++++++--- .../Client/Dependency/Modular/Index.hs | 25 ++++++---- .../Client/Dependency/Modular/Package.hs | 10 +++- 3 files changed, 66 insertions(+), 18 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs index 7f3c759ba46..35a1a56fd5f 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs +++ b/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,8 +228,12 @@ 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 @@ -236,8 +241,13 @@ data QualifyOptions = QO { -- -- 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,9 +284,10 @@ 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 @@ -283,7 +295,28 @@ qualifyDeps QO{..} (Q pp@(PP ns q) pn) = go -- 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 diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Index.hs b/cabal-install/Distribution/Client/Dependency/Modular/Index.hs index 3d593b0885f..b2ad47ab769 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Index.hs +++ b/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" diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs index ef903f19d15..512b9602fc2 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs @@ -119,10 +119,16 @@ 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 @@ -130,6 +136,7 @@ primaryPP (PP _ns q) = go q 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. From 0f5d7f9c82195f7b0a89d38a96890f78ea79da3f Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 18 Mar 2016 15:38:05 +0800 Subject: [PATCH 3/8] Only insist on consistency for libraries For test suites etc. we might want to allow for inconsistent dependencies. For instance, in the optparse-applicative -> tasty -> optparse-applicative dependency cycle we might want to allow two versions of optparse-applicative in the same executable (one that is the library-under-test and one used internally by tasty). --- .../Distribution/Client/PlanIndex.hs | 34 +++++++++++-------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/cabal-install/Distribution/Client/PlanIndex.hs b/cabal-install/Distribution/Client/PlanIndex.hs index c8bf44bde7c..72a9637d2b2 100644 --- a/cabal-install/Distribution/Client/PlanIndex.hs +++ b/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 + => (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. From 8c473364adb844c5f4b38b6bbc1f9b9b6012378c Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Mon, 4 Apr 2016 17:14:19 +0800 Subject: [PATCH 4/8] Document introduction of qualifiers for test deps --- Cabal/doc/developing-packages.markdown | 41 ++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown index e4368d0889e..49bc6984db1 100644 --- a/Cabal/doc/developing-packages.markdown +++ b/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 From 4807f293663c228b8483f2a674ee4dd4aa02b198 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Wed, 6 Apr 2016 11:54:00 +0800 Subject: [PATCH 5/8] Integration test for private test suite deps Details of the test in the README. --- .../private-test-deps/common.sh | 8 +++++ .../private-test-deps/should_run/A.cabal | 22 ++++++++++++++ .../private-test-deps/should_run/ChangeLog.md | 5 ++++ .../private-test-deps/should_run/LICENSE | 30 +++++++++++++++++++ .../private-test-deps/should_run/README | 12 ++++++++ .../private-test-deps/should_run/Setup.hs | 2 ++ .../should_run/deps/A-1/A.cabal | 15 ++++++++++ .../should_run/deps/A-1/ChangeLog.md | 5 ++++ .../should_run/deps/A-1/LICENSE | 30 +++++++++++++++++++ .../should_run/deps/A-1/Setup.hs | 2 ++ .../should_run/deps/A-1/src/A.hs | 4 +++ .../should_run/deps/T/ChangeLog.md | 5 ++++ .../should_run/deps/T/LICENSE | 30 +++++++++++++++++++ .../should_run/deps/T/Setup.hs | 2 ++ .../should_run/deps/T/T.cabal | 15 ++++++++++ .../should_run/deps/T/src/T.hs | 6 ++++ .../should_run/multiple-versions-of-A.err | 0 .../should_run/multiple-versions-of-A.out | 1 + .../should_run/multiple-versions-of-A.sh | 16 ++++++++++ .../private-test-deps/should_run/src/A.hs | 4 +++ .../private-test-deps/should_run/test/Test.hs | 7 +++++ 21 files changed, 221 insertions(+) create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/common.sh create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/LICENSE create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/README create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/LICENSE create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/LICENSE create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.err create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs create mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/common.sh b/cabal-install/tests/IntegrationTests/private-test-deps/common.sh new file mode 100644 index 00000000000..6180d5e7395 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/common.sh @@ -0,0 +1,8 @@ +cabal() { + "$CABAL" $CABAL_ARGS "$@" +} + +die() { + echo "die: $@" + exit 1 +} diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal new file mode 100644 index 00000000000..a8d362b73c9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal @@ -0,0 +1,22 @@ +name: A +version: 2 +license: BSD3 +license-file: LICENSE +author: Edsko de Vries +maintainer: edsko@well-typed.com +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 diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md new file mode 100644 index 00000000000..cd050c1fb30 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for A + +## 2 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/LICENSE new file mode 100644 index 00000000000..1e10c27b541 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/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. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/README b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/README new file mode 100644 index 00000000000..b9bf1409705 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/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. + diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal new file mode 100644 index 00000000000..6c1de6fef47 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal @@ -0,0 +1,15 @@ +name: A +version: 1 +license: BSD3 +license-file: LICENSE +author: Edsko de Vries +maintainer: edsko@well-typed.com +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 diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md new file mode 100644 index 00000000000..93d639a49a9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for A + +## 1 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/LICENSE new file mode 100644 index 00000000000..1e10c27b541 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/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. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs new file mode 100644 index 00000000000..0e703fe342c --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: [(String, Int)] +a = [("A", 1)] diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md new file mode 100644 index 00000000000..cb1b4ae3181 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for T + +## 1 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/LICENSE new file mode 100644 index 00000000000..1e10c27b541 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/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. diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal new file mode 100644 index 00000000000..a657832eb49 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal @@ -0,0 +1,15 @@ +name: T +version: 1 +license: BSD3 +license-file: LICENSE +author: Edsko de Vries +maintainer: edsko@well-typed.com +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +library + exposed-modules: T + hs-source-dirs: src + default-language: Haskell2010 + build-depends: base >=4.5, A diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs new file mode 100644 index 00000000000..33ce66cc481 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs @@ -0,0 +1,6 @@ +module T where + +import A + +t :: [(String, Int)] +t = ("T", 1) : a diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.err b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.err new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out new file mode 100644 index 00000000000..0b290c57092 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out @@ -0,0 +1 @@ +([("A",2)],[("T",1),("A",1)]) diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh new file mode 100644 index 00000000000..ca177a36452 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh @@ -0,0 +1,16 @@ +. ../common.sh + +# Create the sandbox +cabal sandbox init >/dev/null + +# Add additional sources +cabal sandbox add-source deps/A-1 >/dev/null +cabal sandbox add-source deps/T >/dev/null + +# Install +cabal install --enable-tests >/dev/null + +# Run the test +# We don't know the name of the sandbox dir, +# but there will only be one so we can use '*' +dist/*/build/T-test/T-test diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs new file mode 100644 index 00000000000..273ef5b4a68 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: [(String, Int)] +a = [("A", 2)] diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs new file mode 100644 index 00000000000..88fe8a9c42a --- /dev/null +++ b/cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs @@ -0,0 +1,7 @@ +module Main where + +import A +import T + +main :: IO () +main = print (a, t) From a2461b1c60de831fd147d9a9573b91fffb387dcd Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 6 Apr 2016 11:38:52 -0700 Subject: [PATCH 6/8] Qualification fix. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/PlanIndex.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/PlanIndex.hs b/cabal-install/Distribution/Client/PlanIndex.hs index 72a9637d2b2..edafb468ea0 100644 --- a/cabal-install/Distribution/Client/PlanIndex.hs +++ b/cabal-install/Distribution/Client/PlanIndex.hs @@ -188,7 +188,7 @@ dependencyCycles index = -- * 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) - => (ComponentDeps [UnitId] -> [UnitId]) + => (CD.ComponentDeps [UnitId] -> [UnitId]) -> PackageIndex pkg -> [UnitId] -> Either [(pkg, [UnitId])] From 68baf7dc5e57641cad287bf1588ae18499b75376 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Wed, 6 Apr 2016 14:56:38 +0800 Subject: [PATCH 7/8] Merge with master --- .../Distribution/Client/Dependency/Modular/Dependency.hs | 4 ++-- .../private-test-deps/{should_run => }/A.cabal | 0 .../private-test-deps/{should_run => }/ChangeLog.md | 0 .../private-test-deps/{should_run => }/LICENSE | 0 .../private-test-deps/{should_run => }/README | 0 .../private-test-deps/{should_run => }/Setup.hs | 0 .../tests/IntegrationTests/private-test-deps/common.sh | 8 -------- .../private-test-deps/{should_run => }/deps/A-1/A.cabal | 0 .../{should_run => }/deps/A-1/ChangeLog.md | 0 .../private-test-deps/{should_run => }/deps/A-1/LICENSE | 0 .../private-test-deps/{should_run => }/deps/A-1/Setup.hs | 0 .../private-test-deps/{should_run => }/deps/A-1/src/A.hs | 0 .../{should_run => }/deps/T/ChangeLog.md | 0 .../private-test-deps/{should_run => }/deps/T/LICENSE | 0 .../private-test-deps/{should_run => }/deps/T/Setup.hs | 0 .../private-test-deps/{should_run => }/deps/T/T.cabal | 0 .../private-test-deps/{should_run => }/deps/T/src/T.hs | 0 .../{should_run => }/multiple-versions-of-A.err | 0 .../{should_run => }/multiple-versions-of-A.out | 0 .../{should_run => }/multiple-versions-of-A.sh | 2 +- .../private-test-deps/{should_run => }/src/A.hs | 0 .../private-test-deps/{should_run => }/test/Test.hs | 0 .../Distribution/Client/Dependency/Modular/Solver.hs | 8 ++++---- 23 files changed, 7 insertions(+), 15 deletions(-) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/A.cabal (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/ChangeLog.md (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/LICENSE (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/README (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/Setup.hs (100%) delete mode 100644 cabal-install/tests/IntegrationTests/private-test-deps/common.sh rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/A-1/A.cabal (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/A-1/ChangeLog.md (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/A-1/LICENSE (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/A-1/Setup.hs (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/A-1/src/A.hs (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/T/ChangeLog.md (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/T/LICENSE (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/T/Setup.hs (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/T/T.cabal (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/deps/T/src/T.hs (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/multiple-versions-of-A.err (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/multiple-versions-of-A.out (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/multiple-versions-of-A.sh (95%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/src/A.hs (100%) rename cabal-install/tests/IntegrationTests/private-test-deps/{should_run => }/test/Test.hs (100%) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs index 35a1a56fd5f..0700fd4054f 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs @@ -315,8 +315,8 @@ qualifyDeps QO{..} (Q pp@(PP ns q) pn) allDeps = go allDeps isInternalDep dep = dep == pn maybeLibDep :: (Dep PN, Component) -> Maybe PN - maybeLibDep (Dep qpn _ci, ComponentLib) = Just qpn - maybeLibDep _otherwise = Nothing + maybeLibDep (Dep qpn _ci, ComponentLib _) = Just qpn + maybeLibDep _otherwise = Nothing {------------------------------------------------------------------------------- Setting/forgetting the Component diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/A.cabal similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/A.cabal rename to cabal-install/tests/IntegrationTests/private-test-deps/A.cabal diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/ChangeLog.md similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/ChangeLog.md rename to cabal-install/tests/IntegrationTests/private-test-deps/ChangeLog.md diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/LICENSE similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/LICENSE rename to cabal-install/tests/IntegrationTests/private-test-deps/LICENSE diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/README b/cabal-install/tests/IntegrationTests/private-test-deps/README similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/README rename to cabal-install/tests/IntegrationTests/private-test-deps/README diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/Setup.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/Setup.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/Setup.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/common.sh b/cabal-install/tests/IntegrationTests/private-test-deps/common.sh deleted file mode 100644 index 6180d5e7395..00000000000 --- a/cabal-install/tests/IntegrationTests/private-test-deps/common.sh +++ /dev/null @@ -1,8 +0,0 @@ -cabal() { - "$CABAL" $CABAL_ARGS "$@" -} - -die() { - echo "die: $@" - exit 1 -} diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/A.cabal similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/A.cabal rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/A.cabal diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/ChangeLog.md similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/ChangeLog.md rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/ChangeLog.md diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/LICENSE similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/LICENSE rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/LICENSE diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/Setup.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/Setup.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/Setup.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs b/cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/src/A.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/A-1/src/A.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/A-1/src/A.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md b/cabal-install/tests/IntegrationTests/private-test-deps/deps/T/ChangeLog.md similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/ChangeLog.md rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/T/ChangeLog.md diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/LICENSE b/cabal-install/tests/IntegrationTests/private-test-deps/deps/T/LICENSE similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/LICENSE rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/T/LICENSE diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs b/cabal-install/tests/IntegrationTests/private-test-deps/deps/T/Setup.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/Setup.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/T/Setup.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal b/cabal-install/tests/IntegrationTests/private-test-deps/deps/T/T.cabal similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/T.cabal rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/T/T.cabal diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs b/cabal-install/tests/IntegrationTests/private-test-deps/deps/T/src/T.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/deps/T/src/T.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/deps/T/src/T.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.err b/cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.err similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.err rename to cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.err diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out b/cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.out similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.out rename to cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.out diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh b/cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.sh similarity index 95% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh rename to cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.sh index ca177a36452..744e76abeac 100644 --- a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/multiple-versions-of-A.sh +++ b/cabal-install/tests/IntegrationTests/private-test-deps/multiple-versions-of-A.sh @@ -1,4 +1,4 @@ -. ../common.sh +. ./common.sh # Create the sandbox cabal sandbox init >/dev/null diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs b/cabal-install/tests/IntegrationTests/private-test-deps/src/A.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/src/A.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/src/A.hs diff --git a/cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs b/cabal-install/tests/IntegrationTests/private-test-deps/test/Test.hs similarity index 100% rename from cabal-install/tests/IntegrationTests/private-test-deps/should_run/test/Test.hs rename to cabal-install/tests/IntegrationTests/private-test-deps/test/Test.hs diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index fdeb8c65fea..b60e37d7130 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -571,12 +571,12 @@ db16 :: ExampleDb db16 = [ -- No internal dependency Left $ exInst "A" 1 "A-1" [] - , Right $ exAv "A" 2 [ExTest "A-test-suite" [ExAny "T"]] + , Right $ exAv "A" 2 [] `withTest` ExTest "A-test-suite" [ExAny "T"] , Right $ exAv "T" 1 [ExAny "A"] , Right $ exAv "B" 1 [ExFix "A" 2] -- With internal dependency , Left $ exInst "A'" 1 "A'-1" [] - , Right $ exAv "A'" 2 [ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"]] + , Right $ exAv "A'" 2 [] `withTest` ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"] , Right $ exAv "T'" 1 [ExAny "A'"] , Right $ exAv "B'" 1 [ExFix "A'" 2] ] @@ -594,12 +594,12 @@ db17 :: ExampleDb db17 = [ -- No internal dependency Right $ exAv "A" 1 [] - , Right $ exAv "A" 2 [ExTest "A-test-suite" [ExAny "T"]] + , Right $ exAv "A" 2 [] `withTest` ExTest "A-test-suite" [ExAny "T"] , Right $ exAv "T" 1 [ExAny "A"] , Right $ exAv "B" 1 [ExFix "A" 2] -- With internal dependency , Right $ exAv "A'" 1 [] - , Right $ exAv "A'" 2 [ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"]] + , Right $ exAv "A'" 2 [] `withTest` ExTest "A'-test-suite" [ExAny "A'", ExAny "T'"] , Right $ exAv "T'" 1 [ExAny "A'"] , Right $ exAv "B'" 1 [ExFix "A'" 2] ] From 85c74487839d42f3b456656ae0283e666e90400e Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 6 Apr 2016 13:07:46 -0700 Subject: [PATCH 8/8] Update cabal-install.cabal Signed-off-by: Edward Z. Yang --- cabal-install/cabal-install.cabal | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 6999fa9c8fc..80d57f46340 100644 --- a/cabal-install/cabal-install.cabal +++ b/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