Add upper bound check to all

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"

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

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/

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/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 ++ "'"
 

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

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