diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index b9b5d6d94f2..603827e108e 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -45,6 +45,7 @@ checkTests = testGroup "regressions" , checkTest "assoc-cpp-options.cabal" , checkTest "public-multilib-1.cabal" , checkTest "public-multilib-2.cabal" + , checkTest "all-upper-bound.cabal" , checkTest "issue-6288-a.cabal" , checkTest "issue-6288-b.cabal" , checkTest "issue-6288-c.cabal" diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.cabal b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.cabal new file mode 100644 index 00000000000..2b12c477fcf --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.0 +name: all-upper-bound +version: 0 +synopsis: all-upper-bound +category: Tests +license: MIT +maintainer: someone@example.com +description: all-upper-bound test package. + +library + default-language: Haskell2010 + build-depends: + , base ^>=4.14 + , somelib + , alphalib + , betalib + , deltalib + + exposed-modules: Foo diff --git a/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check new file mode 100644 index 00000000000..0da0e871ebb --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/all-upper-bound.check @@ -0,0 +1,6 @@ +These packages miss upper bounds: + - alphalib + - betalib + - deltalib + - somelib +Please add them, using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal index fe0d60a561c..13d6c72f2de 100644 --- a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal @@ -9,6 +9,6 @@ library default-language: Haskell2010 build-depends: , base ^>=4.14 - , somelib:internal + , somelib:internal ^>=1.0 exposed-modules: Foo diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index b364979bd20..1908b6a412e 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -227,6 +227,7 @@ data CheckExplanation = | UnknownArch [String] | UnknownCompiler [String] | BaseNoUpperBounds + | MissingUpperBounds [PackageName] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set FlagName) (Set FlagName) | NonASCIICustomField [String] @@ -666,6 +667,14 @@ ppExplanation (UnknownArch unknownArches) = "Unknown architecture name " ++ commaSep (map quote unknownArches) ppExplanation (UnknownCompiler unknownImpls) = "Unknown compiler name " ++ commaSep (map quote unknownImpls) +ppExplanation (MissingUpperBounds names) = + let separator = "\n - " + in + "These packages miss upper bounds:" ++ separator + ++ (intercalate separator (unPackageName <$> names)) ++ "\n" + ++ "Please add them, using `cabal gen-bounds` for suggestions." + ++ " For more information see: " + ++ " https://pvp.haskell.org/" ppExplanation BaseNoUpperBounds = "The dependency 'build-depends: base' does not specify an upper " ++ "bound on the version number. Each major release of the 'base' " @@ -1813,29 +1822,23 @@ checkCabalVersion pkg = -- checkPackageVersions :: GenericPackageDescription -> [PackageCheck] checkPackageVersions pkg = - catMaybes [ - - -- Check that the version of base is bounded above. - -- For example this bans "build-depends: base >= 3". - -- It should probably be "build-depends: base >= 3 && < 4" - -- which is the same as "build-depends: base == 3.*" - check (not (hasUpperBound baseDependency)) $ - PackageDistInexcusable BaseNoUpperBounds - - ] + -- if others is empty, + -- the error will still fire but listing no dependencies. + -- so we have to check + if length others > 0 + then + PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors + else + baseErrors where - baseDependency = case typicalPkg pkg of - Right (pkg', _) | not (null baseDeps) -> - foldr intersectVersionRanges anyVersion baseDeps - where - baseDeps = - [ vr | Dependency pname vr _ <- allBuildDepends pkg' - , pname == mkPackageName "base" ] - - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- then we will just skip the check, since hasUpperBound noVersion = True - _ -> noVersion + baseErrors = PackageDistInexcusable BaseNoUpperBounds <$ bases + deps = toDependencyVersionsMap allBuildDepends pkg + -- base gets special treatment (it's more critical) + (bases, others) = partition (("base" ==) . unPackageName) $ + [ name + | (name, vr) <- Map.toList deps + , not (hasUpperBound vr) + ] checkConditionals :: GenericPackageDescription -> [PackageCheck] checkConditionals pkg = @@ -2409,14 +2412,7 @@ checkSetupVersions pkg = ] where criticalPkgs = ["Cabal", "base"] - deps = case typicalPkg pkg of - Right (pkgs', _) -> - Map.fromListWith intersectVersionRanges - [ (pname, vr) - | sbi <- maybeToList $ setupBuildInfo pkgs' - , Dependency pname vr _ <- setupDepends sbi - ] - _ -> Map.empty + deps = toDependencyVersionsMap (foldMap setupDepends . setupBuildInfo) pkg emitError nm = PackageDistInexcusable (UpperBoundSetup nm) @@ -2455,6 +2451,24 @@ checkDuplicateModules pkg = -- * Utils -- ------------------------------------------------------------ +toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange +toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of + Right (pkgs', _) -> + let + self :: PackageName + self = pkgName $ package pkgs' + in + Map.fromListWith intersectVersionRanges $ + [ (pname, vr) + | Dependency pname vr _ <- selectDependencies pkgs' + , pname /= self + ] + -- Just in case finalizePD fails for any reason, + -- or if the package doesn't depend on the base package at all, + -- no deps is no checks. + _ -> Map.empty + + quote :: String -> String quote s = "'" ++ s ++ "'" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 157f5c3cc2f..0d22d5fe758 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -474,11 +474,14 @@ exAvSrcPkg ex = } } pkgCheckErrors = - -- We ignore these warnings because some unit tests test that the - -- solver allows unknown extensions/languages when the compiler - -- supports them. + -- We ignore unknown extensions/languages warnings because + -- some there are some unit tests test in which the solver allows + -- unknown extensions/languages when the compiler supports them. + -- Furthermore we ignore missing upper bound warnings because + -- they are not related to this test suite, and are tested + -- with golden tests. let checks = C.checkPackage (srcpkgDescription package) Nothing - in filter (not . isUnknownLangExt) checks + in filter (\x -> not (isMissingUpperBound x) && not (isUnknownLangExt x)) checks in if null pkgCheckErrors then package else error $ "invalid GenericPackageDescription for package " @@ -671,6 +674,10 @@ exAvSrcPkg ex = C.UnknownExtensions {} -> True C.UnknownLanguages {} -> True _ -> False + isMissingUpperBound :: C.PackageCheck -> Bool + isMissingUpperBound pc = case C.explanation pc of + C.MissingUpperBounds {} -> True + _ -> False mkSimpleVersion :: ExamplePkgVersion -> C.Version diff --git a/changelog.d/pr-8339 b/changelog.d/pr-8339 new file mode 100644 index 00000000000..1e602c1e985 --- /dev/null +++ b/changelog.d/pr-8339 @@ -0,0 +1,4 @@ +synopsis: Add check for upper bound on any dependency in cabal check +report, list, init, fetch, info, upload, get. +prs: #8339 +issues: #8291