Add check for upper bound on any dependency in cabal check

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 "public-multilib-3.cabal"
     , checkTest "issue-6288-a.cabal"
     , checkTest "issue-6288-b.cabal"
     , checkTest "issue-6288-c.cabal"

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

Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal

@@ -0,0 +1,14 @@
+cabal-version: 3.0
+name:          public-multilib3
+version:       0
+synopsis:      public-multilibs
+category:      Tests
+license:       MIT
+
+library
+  default-language: Haskell2010
+  build-depends:
+    , base     ^>=4.14
+    , somelib
+
+  exposed-modules:  Foo

Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check

@@ -0,0 +1,3 @@
+No 'maintainer' field.
+No 'description' field.
+These packages miss upper bounds 'somelib' please add them with with `cabal gen-bounds`. For more information see:  https://www.parsonsmatt.org/2020/05/07/on_pvp_restrictive_bounds.html

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]
@@ -669,6 +670,12 @@ ppExplanation (UnknownArch unknownArches) =
     "Unknown architecture name " ++ commaSep (map quote unknownArches)
 ppExplanation (UnknownCompiler unknownImpls) =
     "Unknown compiler name " ++ commaSep (map quote unknownImpls)
+ppExplanation (MissingUpperBounds names) =
+    "These packages miss upper bounds '"
+      ++ (intercalate "','" (unPackageName <$> names)) ++ "'"
+      ++ " please add them with with `cabal gen-bounds`."
+      ++ " For more information see: "
+      ++ " https://www.parsonsmatt.org/2020/05/07/on_pvp_restrictive_bounds.html"
 ppExplanation BaseNoUpperBounds =
     "The dependency 'build-depends: base' does not specify an upper "
       ++ "bound on the version number. Each major release of the 'base' "
@@ -1814,29 +1821,22 @@ 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 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) $ do
+      (name, vr) <- Map.toList deps
+      -- Check that the version of a package 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.*"
+      if hasUpperBound vr then [] else pure name -- emit for the error
 
 checkConditionals :: GenericPackageDescription -> [PackageCheck]
 checkConditionals pkg =
@@ -2410,14 +2410,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 ((=<<) setupDepends . maybeToList .  setupBuildInfo) pkg
     emitError nm =
       PackageDistInexcusable (UpperBoundSetup nm)
 
@@ -2456,6 +2449,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 $ do
+          Dependency pname vr _ <- selectDependencies pkgs'
+          if pname == self then
+            []
+          else [(pname, vr)]
+      -- 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 ++ "'"
 

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

@@ -478,7 +478,7 @@ exAvSrcPkg ex =
           -- solver allows unknown extensions/languages when the compiler
           -- supports them.
           let checks = C.checkPackage (srcpkgDescription package) Nothing
-          in filter (not . isUnknownLangExt) checks
+          in filter (not . isMissingUpperBound) $ filter (not . isUnknownLangExt) checks
     in if null pkgCheckErrors
        then package
        else error $ "invalid GenericPackageDescription for package "
@@ -671,6 +671,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

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