From 81f07d780d65da2282756876c76541a4e4528c85 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 8 Aug 2025 07:00:45 -0400 Subject: [PATCH 1/4] Add project duplicate package test --- .../PackageTests/ProjectDupPkg/cabal.out | 14 +++++++++++++ .../PackageTests/ProjectDupPkg/cabal.project | 1 + .../PackageTests/ProjectDupPkg/cabal.test.hs | 21 +++++++++++++++++++ .../PackageTests/ProjectDupPkg/pkg-one/Foo.hs | 4 ++++ .../ProjectDupPkg/pkg-one/pkg-one.cabal | 9 ++++++++ .../PackageTests/ProjectDupPkg/pkg-two/Bar.hs | 4 ++++ .../ProjectDupPkg/pkg-two/pkg-one.cabal | 9 ++++++++ 7 files changed, 62 insertions(+) create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs create mode 100644 cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out new file mode 100644 index 00000000000..3c50b2abdfa --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out @@ -0,0 +1,14 @@ +# checking repl command with a 'cabal.project' and no project options +# cabal repl +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - pkg-one-0.1 (interactive) (first run) +Configuring pkg-one-0.1... +Preprocessing library for pkg-one-0.1... +# checking repl command with the 'all' target +# cabal repl +Build profile: -w ghc- -O1 +In order, the following will be built: + - pkg-one-0.1 (interactive) (first run) +Preprocessing library for pkg-one-0.1... diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project new file mode 100644 index 00000000000..2f191f96e7e --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project @@ -0,0 +1 @@ +packages: pkg-one, pkg-two diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs new file mode 100644 index 00000000000..0ce0ada95ba --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs @@ -0,0 +1,21 @@ +import Test.Cabal.Prelude +import Data.List (isInfixOf) + +main = cabalTest . recordMode RecordMarked $ do + liftIO $ skipIfWindows "I'm seeing extra newlines in the output on Windows" + let log = recordHeader . pure + + -- If there is only one package in the project then the target could be inferred. + log "checking repl command with a 'cabal.project' and no project options" + defaultProject <- cabal' "repl" ["pkg-one"] + assertOutputContains "the following will be built" defaultProject + assertOutputContains "pkg-one-0.1" defaultProject + assertOutputContains "Compiling Bar" defaultProject + + log "checking repl command with the 'all' target" + allTarget <- cabal' "repl" ["all"] + assertOutputContains "the following will be built" allTarget + assertOutputContains "pkg-one-0.1" allTarget + assertOutputContains "Compiling Bar" allTarget + + return () diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs new file mode 100644 index 00000000000..8a39fe134cf --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +a :: Int +a = 42 diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal new file mode 100644 index 00000000000..3e17e5074d7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal @@ -0,0 +1,9 @@ +name: pkg-one +version: 0.1 +license: BSD3 +cabal-version: >=1.2 +build-type: Simple + +library + exposed-modules: Foo + build-depends: base diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs new file mode 100644 index 00000000000..870176c2b2d --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs @@ -0,0 +1,4 @@ +module Bar where + +a :: Int +a = 42 diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal new file mode 100644 index 00000000000..5708318ba15 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal @@ -0,0 +1,9 @@ +name: pkg-one +version: 0.1 +license: BSD3 +cabal-version: >=1.2 +build-type: Simple + +library + exposed-modules: Bar + build-depends: base From 234c9c6c55616e087650e529e5d32f524eef30ed Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 8 Aug 2025 07:16:13 -0400 Subject: [PATCH 2/4] Foo is not compiled --- cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs index 0ce0ada95ba..77e6eb308c6 100644 --- a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs @@ -10,12 +10,16 @@ main = cabalTest . recordMode RecordMarked $ do defaultProject <- cabal' "repl" ["pkg-one"] assertOutputContains "the following will be built" defaultProject assertOutputContains "pkg-one-0.1" defaultProject + -- Foo is a module in one of the packages pkg-one-0.1 + -- assertOutputContains "Compiling Foo" defaultProject assertOutputContains "Compiling Bar" defaultProject log "checking repl command with the 'all' target" allTarget <- cabal' "repl" ["all"] assertOutputContains "the following will be built" allTarget assertOutputContains "pkg-one-0.1" allTarget + -- Foo is a module in one of the packages pkg-one-0.1 + -- assertOutputContains "Compiling Foo" allTarget assertOutputContains "Compiling Bar" allTarget return () From 709c4b4216cb72581132b134ed7e0c84c21f8786 Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Thu, 12 Feb 2026 11:35:22 -0500 Subject: [PATCH 3/4] Make duplicates(By) return [NonEmpty a] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Strictly speaking it could return `(a, a, [a])` or `(a, NonEmpty a)` or something, but this at least makes `head` safe. Co-authored-by: Hécate Kleidukos --- cabal-install/src/Distribution/Client/Dependency.hs | 4 ++-- cabal-install/src/Distribution/Client/Utils.hs | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index a65c41cb046..bbbb1021f68 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -993,7 +993,7 @@ planPackagesProblems platform cinfo pkgs = , not (null packageProblems) ] ++ [ DuplicatePackageSolverId (Graph.nodeKey aDup) dups - | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs + | dups <- fmap toList $ duplicatesBy (comparing Graph.nodeKey) pkgs , aDup <- case dups of [] -> [] (ad : _) -> [ad] @@ -1055,7 +1055,7 @@ configuredPackageProblems | pkgs <- CD.nonSetupDeps ( fmap - (duplicatesBy (comparing packageName)) + (fmap toList . duplicatesBy (comparing packageName)) specifiedDeps1 ) ] diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 07db71a9f9d..92e12e8fcc6 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -140,18 +140,18 @@ mergeBy cmp = merge data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b -duplicates :: Ord a => [a] -> [[a]] +duplicates :: Ord a => [a] -> [NonEmpty a] duplicates = duplicatesBy compare -duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]] -duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp +duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a] +duplicatesBy cmp = mapMaybe moreThanOne . groupBy eq . sortBy cmp where eq :: a -> a -> Bool eq a b = case cmp a b of EQ -> True _ -> False - moreThanOne (_ : _ : _) = True - moreThanOne _ = False + moreThanOne (x : xs@(_ : _)) = Just (x :| xs) + moreThanOne _ = Nothing -- | Like 'removeFile', but does not throw an exception when the file does not -- exist. From b2ae9161193177818c8788cb712ac51ff78fc5d1 Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Thu, 12 Feb 2026 11:43:55 -0500 Subject: [PATCH 4/4] Log if there are multiple local packages with the same ID in a project MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Hécate Kleidukos --- .../Distribution/Client/ProjectPlanning.hs | 33 +++++++++++++----- .../Client/Types/PackageLocation.hs | 11 +++++- .../PackageTests/ProjectDupPkg/cabal.out | 14 -------- .../PackageTests/ProjectDupPkg/cabal.test.hs | 34 ++++++++----------- changelog.d/pr-11487 | 7 ++++ 5 files changed, 57 insertions(+), 42 deletions(-) create mode 100644 changelog.d/pr-11487 diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 685e46dfa77..2339b91f147 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -109,6 +109,7 @@ import Text.PrettyPrint , text , vcat , ($$) + , ($+$) ) import Prelude () @@ -137,7 +138,7 @@ import Distribution.Client.SetupWrapper import Distribution.Client.Store import Distribution.Client.Targets (userToPackageConstraint) import Distribution.Client.Types -import Distribution.Client.Utils (concatMapM, incVersion) +import Distribution.Client.Utils (concatMapM, duplicatesBy, incVersion) import qualified Distribution.Client.BuildReports.Storage as BuildReports import qualified Distribution.Client.IndexUtils as IndexUtils @@ -451,13 +452,29 @@ rebuildProjectConfig createDirectoryIfMissingVerbose verbosity True distDirectory createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory - fetchAndReadSourcePackages - verbosity - distDirLayout - compiler - projectConfigShared - projectConfigBuildOnly - pkgLocations + sourcePackages <- + fetchAndReadSourcePackages + verbosity + distDirLayout + compiler + projectConfigShared + projectConfigBuildOnly + pkgLocations + + case duplicatesBy (comparing srcpkgPackageId) [pkg | SpecificSourcePackage pkg <- sourcePackages] of + [] -> return () + duplicateSourcePkgs -> + liftIO $ + noticeDoc verbosity $ + vcat + [ text "cabal project has multiple sources for" + <+> (pretty (srcpkgPackageId (head dupeGroup)) <> text ":") + $+$ Disp.nest 2 (vcat [pretty (srcpkgSource srcpkg) | srcpkg <- toList dupeGroup]) + $+$ text "the choice of source that will be used is undefined." + | dupeGroup <- duplicateSourcePkgs + ] + + return sourcePackages informAboutConfigFiles projectConfig = do cwd <- getCurrentDirectory diff --git a/cabal-install/src/Distribution/Client/Types/PackageLocation.hs b/cabal-install/src/Distribution/Client/Types/PackageLocation.hs index 9a0537aae7a..9dd00c40080 100644 --- a/cabal-install/src/Distribution/Client/Types/PackageLocation.hs +++ b/cabal-install/src/Distribution/Client/Types/PackageLocation.hs @@ -16,7 +16,8 @@ import Network.URI (URI) import Distribution.Types.PackageId (PackageId) import Distribution.Client.Types.Repo -import Distribution.Client.Types.SourceRepo (SourceRepoMaybe) +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..)) +import Distribution.Pretty import Distribution.Solver.Types.SourcePackage (SourcePackage) type UnresolvedPkgLoc = PackageLocation (Maybe FilePath) @@ -39,6 +40,14 @@ data PackageLocation local RemoteSourceRepoPackage SourceRepoMaybe local deriving (Show, Functor, Eq, Ord, Generic) +instance Pretty (PackageLocation local) where + pretty (LocalUnpackedPackage fp) = showFilePath fp + pretty (LocalTarballPackage fp) = showFilePath fp + pretty (RemoteTarballPackage uri _) = showToken $ show uri + pretty (RepoTarballPackage repo pid _) = pretty pid <> showToken "@" <> pretty (repoName repo) + pretty (RemoteSourceRepoPackage sourceRepo _) = + pretty (srpType sourceRepo) <+> showToken (srpLocation sourceRepo) + instance Binary local => Binary (PackageLocation local) instance Structured local => Structured (PackageLocation local) diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out index 3c50b2abdfa..e69de29bb2d 100644 --- a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out @@ -1,14 +0,0 @@ -# checking repl command with a 'cabal.project' and no project options -# cabal repl -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - pkg-one-0.1 (interactive) (first run) -Configuring pkg-one-0.1... -Preprocessing library for pkg-one-0.1... -# checking repl command with the 'all' target -# cabal repl -Build profile: -w ghc- -O1 -In order, the following will be built: - - pkg-one-0.1 (interactive) (first run) -Preprocessing library for pkg-one-0.1... diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs index 77e6eb308c6..534ef613f3a 100644 --- a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs @@ -1,25 +1,21 @@ import Test.Cabal.Prelude import Data.List (isInfixOf) -main = cabalTest . recordMode RecordMarked $ do - liftIO $ skipIfWindows "I'm seeing extra newlines in the output on Windows" - let log = recordHeader . pure +-- output contains filepaths into /tmp, so we only match parts of the output +main = cabalTest . recordMode DoNotRecord $ do + liftIO $ skipIfWindows "\\r\\n confused with \\n" - -- If there is only one package in the project then the target could be inferred. - log "checking repl command with a 'cabal.project' and no project options" - defaultProject <- cabal' "repl" ["pkg-one"] - assertOutputContains "the following will be built" defaultProject - assertOutputContains "pkg-one-0.1" defaultProject - -- Foo is a module in one of the packages pkg-one-0.1 - -- assertOutputContains "Compiling Foo" defaultProject - assertOutputContains "Compiling Bar" defaultProject + let msg = unlines + [ "cabal project has multiple sources for pkg-one-0.1:" + , " .*/pkg-one" + , " .*/pkg-two" + , "the choice of source that will be used is undefined." + ] - log "checking repl command with the 'all' target" - allTarget <- cabal' "repl" ["all"] - assertOutputContains "the following will be built" allTarget - assertOutputContains "pkg-one-0.1" allTarget - -- Foo is a module in one of the packages pkg-one-0.1 - -- assertOutputContains "Compiling Foo" allTarget - assertOutputContains "Compiling Bar" allTarget + normal <- cabal' "configure" ["-v1", "pkg-one"] + assertOutputMatches msg normal - return () + quiet <- cabal' "configure" ["-v0", "pkg-one"] + assertOutputDoesNotMatch msg quiet + + return () diff --git a/changelog.d/pr-11487 b/changelog.d/pr-11487 new file mode 100644 index 00000000000..8669f946f69 --- /dev/null +++ b/changelog.d/pr-11487 @@ -0,0 +1,7 @@ +--- +synopsis: Log if there are multiple local packages with the same ID in a project +packages: [cabal-install] +prs: 11487 +--- + +Log duplicate local packages with the same package identifier, so that the user knows that only one will be picked.