diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index 17543b5f2de..ac80823f30e 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ViewPatterns #-} module Distribution.Solver.Types.ProjectConfigPath ( -- * Project Config Path Manipulation - ProjectConfigPath(..) + ProjectImport(..) + , ProjectConfigPath(..) , projectConfigPathRoot , nullProjectConfigPath , consProjectConfigPath @@ -14,6 +16,7 @@ module Distribution.Solver.Types.ProjectConfigPath , docProjectConfigPath , docProjectConfigFiles , cyclicalImportMsg + , duplicateImportMsg , untrimmedUriImportMsg , docProjectConfigPathFailReason @@ -44,6 +47,13 @@ import Text.PrettyPrint import Distribution.Simple.Utils (ordNub) import Distribution.System (OS(Windows), buildOS) +data ProjectImport = + ProjectImport + { importOf :: FilePath + , importBy :: ProjectConfigPath + } + deriving (Eq, Ord) + -- | Path to a configuration file, either a singleton project root, or a longer -- list representing a path to an import. The path is a non-empty list that we -- build up by prepending relative imports with @consProjectConfigPath@. @@ -174,9 +184,27 @@ docProjectConfigFiles ps = vcat -- | A message for a cyclical import, a "cyclical import of". cyclicalImportMsg :: ProjectConfigPath -> Doc cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) = + seenImportMsg + (text "cyclical import of" <+> text duplicate <> semi) + (ProjectImport duplicate path) + [] + +-- | A message for a duplicate import, a "duplicate import of". If a check for +-- cyclical imports has already been made then this would report a duplicate +-- import by two different paths. +duplicateImportMsg :: Doc -> ProjectImport -> [ProjectImport] -> Doc +duplicateImportMsg intro = seenImportMsg intro + +seenImportMsg :: Doc -> ProjectImport -> [ProjectImport] -> Doc +seenImportMsg intro ProjectImport{importOf = duplicate, importBy = path} seenImports = vcat - [ text "cyclical import of" <+> text duplicate <> semi + [ intro , nest 2 (docProjectConfigPath path) + , nest 2 $ + vcat + [ docProjectConfigPath importBy + | ProjectImport{importBy} <- filter ((duplicate ==) . importOf) seenImports + ] ] -- | A message for an import that has leading or trailing spaces. diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 10858d5601d..b2f1bc3ce8b 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -1,7 +1,6 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -35,6 +34,7 @@ module Distribution.Client.ProjectConfig.Legacy ) where import Data.Coerce (coerce) +import Data.IORef import Distribution.Client.Compat.Prelude import Distribution.Types.Flag (FlagName, parsecFlagAssignment) @@ -142,7 +142,8 @@ import Distribution.Types.CondTree ) import Distribution.Types.SourceRepo (RepoType) import Distribution.Utils.NubList - ( fromNubList + ( NubList + , fromNubList , overNubList , toNubList ) @@ -194,18 +195,14 @@ import Distribution.Utils.Path hiding ) import qualified Data.ByteString.Char8 as BS -import Data.Functor ((<&>)) +import Data.List (sortOn) import qualified Data.Map as Map import qualified Data.Set as Set import Network.URI (URI (..), nullURIAuth, parseURI) import System.Directory (createDirectoryIfMissing, makeAbsolute) import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) -import Text.PrettyPrint - ( Doc - , render - , ($+$) - ) -import qualified Text.PrettyPrint as Disp +import Text.PrettyPrint (Doc, int, render, semi, text, vcat, ($+$)) +import qualified Text.PrettyPrint as Disp (empty) ------------------------------------------------------------------ -- Handle extended project config files with conditionals and imports. @@ -256,19 +253,44 @@ parseProject -> ProjectConfigToParse -- ^ The contents of the file to parse -> IO (ProjectParseResult ProjectConfigSkeleton) -parseProject rootPath cacheDir httpTransport verbosity configToParse = - do - let (dir, projectFileName) = splitFileName rootPath - projectDir <- makeAbsolute dir - projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| []) - parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse - -- NOTE: Reverse the warnings so they are in line number order. - <&> \case ProjectParseOk ws x -> ProjectParseOk (reverse ws) x; x -> x +parseProject rootPath cacheDir httpTransport verbosity configToParse = do + let (dir, projectFileName) = splitFileName rootPath + projectDir <- makeAbsolute dir + projectPath@(ProjectConfigPath (canonicalRoot :| _)) <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| []) + importsBy <- newIORef $ toNubList [ProjectImport canonicalRoot projectPath] + dupesMap <- newIORef mempty + result <- parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap projectDir projectPath configToParse + dupes <- Map.filter ((> 1) . length) <$> readIORef dupesMap + unless (Map.null dupes) (noticeDoc verbosity $ vcat (dupesMsg <$> Map.toList dupes)) + return result + +data Dupes = Dupes + { dupesImport :: ProjectImport + -- ^ The import that we're checking for duplicates. + , dupesImports :: [ProjectImport] + -- ^ All the imports of this file. + } + deriving (Eq) + +instance Ord Dupes where + compare = compare `on` length . dupesImports + +type DupesMap = Map FilePath [Dupes] + +dupesMsg :: (FilePath, [Dupes]) -> Doc +dupesMsg (duplicate, ds@(take 1 . sortOn (importBy . dupesImport) -> dupes)) = + vcat $ + ((text "Warning:" <+> int (length ds) <+> text "imports of" <+> text duplicate) <> semi) + : ((\Dupes{..} -> duplicateImportMsg Disp.empty dupesImport dupesImports) <$> dupes) parseProjectSkeleton :: FilePath -> HttpTransport -> Verbosity + -> IORef (NubList ProjectImport) + -- ^ The imports seen so far, used to report on cycles and duplicates and to detect duplicates that are not cycles + -> IORef DupesMap + -- ^ The duplicates seen so far, used to defer reporting on duplicates -> FilePath -- ^ The directory of the project configuration, typically the directory of cabal.project -> ProjectConfigPath @@ -276,7 +298,7 @@ parseProjectSkeleton -> ProjectConfigToParse -- ^ The contents of the file to parse -> IO (ProjectParseResult ProjectConfigSkeleton) -parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (ProjectConfigToParse bs) = +parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap projectDir source (ProjectConfigToParse bs) = (sanityWalkPCS False =<<) <$> liftPR source (go []) (ParseUtils.readFields bs) where go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ProjectParseResult ProjectConfigSkeleton) @@ -284,20 +306,26 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project (ParseUtils.F _ "import" importLoc) -> do let importLocPath = importLoc `consProjectConfigPath` source - -- Once we canonicalize the import path, we can check for cyclical imports + -- Once we canonicalize the import path, we can check for cyclical and duplicate imports normSource <- canonicalizeConfigPath projectDir source - normLocPath <- canonicalizeConfigPath projectDir importLocPath + normLocPath@(ProjectConfigPath (uniqueImport :| _)) <- canonicalizeConfigPath projectDir importLocPath + seenImportsBy@(fmap importOf -> seenImports) <- fromNubList <$> atomicModifyIORef' importsBy (\ibs -> (toNubList [ProjectImport uniqueImport normLocPath] <> ibs, ibs)) debug verbosity $ "\nimport path, normalized\n=======================\n" ++ render (docProjectConfigPath normLocPath) + debug verbosity "\nseen unique paths\n=================" + mapM_ (debug verbosity) seenImports + debug verbosity "\n" if isCyclicConfigPath normLocPath then pure . projectParseFail Nothing (Just normSource) $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing else do when (isUntrimmedUriConfigPath importLocPath) - (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath) + (noticeDoc verbosity $ untrimmedUriImportMsg (text "Warning:") importLocPath) let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc) - res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath - rest <- go [] xs + let uniqueFields = if uniqueImport `elem` seenImports then [] else xs + atomicModifyIORef' dupesMap $ \dm -> (Map.insertWith (++) uniqueImport [Dupes (ProjectImport uniqueImport normLocPath) seenImportsBy] dm, ()) + res <- parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath + rest <- go [] uniqueFields pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest] (ParseUtils.Section l "if" p xs') -> do normSource <- canonicalizeConfigPath projectDir source @@ -1290,13 +1318,13 @@ parseLegacyProjectConfig rootConfig bs = showLegacyProjectConfig :: LegacyProjectConfig -> String showLegacyProjectConfig config = - Disp.render $ + render $ showConfig (legacyProjectConfigFieldDescrs constraintSrc) legacyPackageConfigSectionDescrs legacyPackageConfigFGSectionDescrs config - $+$ Disp.text "" + $+$ text "" where -- Note: ConstraintSource is unused when pretty-printing. We fake -- it here to avoid having to pass it on call-sites. It's not great @@ -1307,13 +1335,13 @@ legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectC legacyProjectConfigFieldDescrs constraintSrc = [ newLineListField "packages" - (Disp.text . renderPackageLocationToken) + (text . renderPackageLocationToken) parsePackageLocationTokenQ legacyPackages (\v flags -> flags{legacyPackages = v}) , newLineListField "optional-packages" - (Disp.text . renderPackageLocationToken) + (text . renderPackageLocationToken) parsePackageLocationTokenQ legacyPackagesOptional (\v flags -> flags{legacyPackagesOptional = v}) @@ -1424,7 +1452,7 @@ legacySharedConfigFieldDescrs constraintSrc = . addFields [ commaNewLineListFieldParsec "package-dbs" - (Disp.text . showPackageDb) + (text . showPackageDb) (fmap readPackageDb parsecToken) configPackageDBs (\v conf -> conf{configPackageDBs = v}) @@ -1717,8 +1745,8 @@ legacyPackageConfigFieldDescrs = in FieldDescr name ( \f -> case f of - Flag NoDumpBuildInfo -> Disp.text "False" - Flag DumpBuildInfo -> Disp.text "True" + Flag NoDumpBuildInfo -> text "False" + Flag DumpBuildInfo -> text "True" _ -> Disp.empty ) ( \line str _ -> case () of @@ -1745,9 +1773,9 @@ legacyPackageConfigFieldDescrs = in FieldDescr name ( \f -> case f of - Flag NoOptimisation -> Disp.text "False" - Flag NormalOptimisation -> Disp.text "True" - Flag MaximumOptimisation -> Disp.text "2" + Flag NoOptimisation -> text "False" + Flag NormalOptimisation -> text "True" + Flag MaximumOptimisation -> text "2" _ -> Disp.empty ) ( \line str _ -> case () of @@ -1770,10 +1798,10 @@ legacyPackageConfigFieldDescrs = in FieldDescr name ( \f -> case f of - Flag NoDebugInfo -> Disp.text "False" - Flag MinimalDebugInfo -> Disp.text "1" - Flag NormalDebugInfo -> Disp.text "True" - Flag MaximalDebugInfo -> Disp.text "3" + Flag NoDebugInfo -> text "False" + Flag MinimalDebugInfo -> text "1" + Flag NormalDebugInfo -> text "True" + Flag MaximalDebugInfo -> text "3" _ -> Disp.empty ) ( \line str _ -> case () of @@ -2098,6 +2126,6 @@ monoidFieldParsec name showF readF get' set = -- otherwise are special syntax. showTokenQ :: String -> Doc showTokenQ "" = Disp.empty -showTokenQ x@('-' : '-' : _) = Disp.text (show x) -showTokenQ x@('.' : []) = Disp.text (show x) +showTokenQ x@('-' : '-' : _) = text (show x) +showTokenQ x@('.' : []) = text (show x) showTokenQ x = showToken x diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out index 2ddeff77281..3f7b8d6c539 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out @@ -254,43 +254,123 @@ Could not resolve dependencies: (constraint from oops-0.project requires ==1.4.3.0) [__1] fail (backjumping, conflict set: hashable, oops) After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: hashable (3), oops (2) -# checking if we detect when the same config is imported via many different paths (we don't) +# checking that we detect when the same config is imported via many different paths # cabal v2-build -Configuration is affected by the following files: -- yops-0.project -- yops-2.config +Warning: 2 imports of yops-4.config; + yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project + yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops-4.config +Warning: 2 imports of yops-6.config; + yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config imported by: yops/yops-3.config imported by: yops-0.project -- yops-4.config + yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config imported by: yops/yops-3.config imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops-6.config +Warning: 2 imports of yops-8.config; + yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config imported by: yops-0.project -- yops-6.config + yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config imported by: yops/yops-5.config imported by: yops-4.config imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config imported by: yops-0.project -- yops-6.config +Warning: 2 imports of yops/yops-3.config; + yops/yops-3.config + imported by: yops-0.project + yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +Warning: 2 imports of yops/yops-5.config; + yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project + yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +Warning: 2 imports of yops/yops-7.config; + yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project + yops/yops-7.config + imported by: yops-6.config imported by: yops/yops-5.config imported by: yops-4.config imported by: yops/yops-3.config imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops-8.config +Warning: 2 imports of yops/yops-9.config; + yops/yops-9.config + imported by: yops-8.config imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config imported by: yops-0.project -- yops-8.config + yops/yops-9.config + imported by: yops-8.config imported by: yops/yops-7.config imported by: yops-6.config imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +Configuration is affected by the following files: +- yops-0.project +- yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config imported by: yops-0.project - yops-8.config imported by: yops/yops-7.config @@ -316,8 +396,6 @@ Configuration is affected by the following files: imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops/yops-5.config - imported by: yops-0.project - yops/yops-5.config imported by: yops-4.config imported by: yops/yops-3.config @@ -328,12 +406,6 @@ Configuration is affected by the following files: imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops/yops-7.config - imported by: yops-0.project -- yops/yops-7.config - imported by: yops-6.config - imported by: yops/yops-5.config - imported by: yops-0.project - yops/yops-7.config imported by: yops-6.config imported by: yops/yops-5.config @@ -348,18 +420,6 @@ Configuration is affected by the following files: imported by: yops-2.config imported by: yops/yops-1.config imported by: yops-0.project -- yops/yops-9.config - imported by: yops-0.project -- yops/yops-9.config - imported by: yops-8.config - imported by: yops/yops-7.config - imported by: yops-0.project -- yops/yops-9.config - imported by: yops-8.config - imported by: yops/yops-7.config - imported by: yops-6.config - imported by: yops/yops-5.config - imported by: yops-0.project - yops/yops-9.config imported by: yops-8.config imported by: yops/yops-7.config @@ -379,6 +439,330 @@ Configuration is affected by the following files: imported by: yops/yops-1.config imported by: yops-0.project Up to date +# checking that we detect when the same config is imported via many different paths +# cabal v2-build +Warning: 10 imports of https://www.stackage.org/lts-21.25/cabal.config; + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project + https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops-4.config; + woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops-6.config; + woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops-8.config; + woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops/woops-3.config; + woops/woops-3.config + imported by: woops-0.project + woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops/woops-5.config; + woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops/woops-7.config; + woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Warning: 2 imports of woops/woops-9.config; + woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project + woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Configuration is affected by the following files: +- woops-0.project +- woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops/woops-1.config + imported by: woops-0.project +- woops/woops-3.config + imported by: woops-0.project +- woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-0.project +- https://www.stackage.org/lts-21.25/cabal.config + imported by: woops/woops-9.config + imported by: woops-8.config + imported by: woops/woops-7.config + imported by: woops-6.config + imported by: woops/woops-5.config + imported by: woops-4.config + imported by: woops/woops-3.config + imported by: woops-2.config + imported by: woops/woops-1.config + imported by: woops-0.project +Resolving dependencies... +Build profile: -w ghc-9.4.8 -O1 +In order, the following will be built: + - my-0.1 (lib:my) (first run) +Configuring my-0.1... +Preprocessing library for my-0.1... +Building library for my-0.1... # checking bad conditional # cabal v2-build Error: [Cabal-7090] diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs index 681865df2e5..c1eb3f338cf 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs @@ -159,11 +159,13 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do -- +-- yops-8.config -- +-- yops/yops-9.config (no further imports) -- +-- yops/yops-9.config (no further imports) - -- - -- We don't check and don't error or warn on the same config being imported - -- via many different paths. - log "checking if we detect when the same config is imported via many different paths (we don't)" + log "checking that we detect when the same config is imported via many different paths" yopping <- cabal' "v2-build" [ "--project-file=yops-0.project" ] + assertOutputContains "Warning: 2 imports" yopping + + log "checking that we detect when the same config is imported via many different paths" + wooping <- cabal' "v2-build" [ "--project-file=woops-0.project" ] + assertOutputContains "Warning: 10 imports" wooping log "checking bad conditional" badIf <- fails $ cabal' "v2-build" [ "--project-file=bad-conditional.project" ] diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops-0.project b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-0.project new file mode 100644 index 00000000000..79933c8c1cb --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-0.project @@ -0,0 +1,7 @@ +packages: . + +import: woops/woops-1.config +import: woops/woops-3.config +import: woops/woops-5.config +import: woops/woops-7.config +import: woops/woops-9.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops-2.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-2.config new file mode 100644 index 00000000000..50deddaaef5 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-2.config @@ -0,0 +1,2 @@ +import: woops/woops-3.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops-4.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-4.config new file mode 100644 index 00000000000..6ff8dfb3013 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-4.config @@ -0,0 +1,2 @@ +import: woops/woops-5.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops-6.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-6.config new file mode 100644 index 00000000000..f32758b83e4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-6.config @@ -0,0 +1,2 @@ +import: woops/woops-7.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops-8.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-8.config new file mode 100644 index 00000000000..b9043ce7c5d --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops-8.config @@ -0,0 +1,2 @@ +import: woops/woops-9.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-1.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-1.config new file mode 100644 index 00000000000..1151046199a --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-1.config @@ -0,0 +1,2 @@ +import: ../woops-2.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-3.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-3.config new file mode 100644 index 00000000000..9bbcedeb506 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-3.config @@ -0,0 +1,2 @@ +import: ../woops-4.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-5.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-5.config new file mode 100644 index 00000000000..181577c4dfe --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-5.config @@ -0,0 +1,2 @@ +import: ../woops-6.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-7.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-7.config new file mode 100644 index 00000000000..c2d9821826a --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-7.config @@ -0,0 +1,2 @@ +import: ../woops-8.config +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-9.config b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-9.config new file mode 100644 index 00000000000..44d1cc5e562 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/woops/woops-9.config @@ -0,0 +1,2 @@ +-- No imports here +import: https://www.stackage.org/lts-21.25/cabal.config diff --git a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/cabal.test.hs index cf37d1621a6..3287c84521a 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromSimple/cabal.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude -main = cabalTest . recordMode RecordMarked $ do +main = cabalTest . flakyIfCI 10927. recordMode RecordMarked $ do let log = recordHeader . pure out <- fails $ cabal' "v2-build" [ "all", "--dry-run" ] diff --git a/changelog.d/pr-9933 b/changelog.d/pr-9933 new file mode 100644 index 00000000000..3e94a44609a --- /dev/null +++ b/changelog.d/pr-9933 @@ -0,0 +1,23 @@ +synopsis: Detect non-cyclical duplicate project imports +description: + Detect and report on duplicate imports that are non-cyclical. Give more detail + when reporting cyclical imports. Be more explicit and consistent with + non-cyclical duplicate reporting. + + ``` + $ cabal build --project-file=cabal.project + ... + Error: [Cabal-7090] + Error parsing project file cabal.project: + duplicate import of config/config-3.config; + config/config-3.config + imported by: cabal.project + config/config-3.config + imported by: config-2.config + imported by: config/config-1.config + imported by: cabal.project + ``` + +packages: cabal-install-solver cabal-install +prs: #9578 #9933 +issues: #9562