diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs index 7953e438539..75100d13017 100644 --- a/cabal-install/src/Distribution/Client/VCS.hs +++ b/cabal-install/src/Distribution/Client/VCS.hs @@ -497,19 +497,25 @@ vcsGit = -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath] vcsSyncRepos _ _ [] = return [] - vcsSyncRepos - verbosity - gitProg - ((primaryRepo, primaryLocalDir) : secondaryRepos) = do - vcsSyncRepo verbosity gitProg primaryRepo primaryLocalDir Nothing - sequence_ - [ vcsSyncRepo verbosity gitProg repo localDir (Just primaryLocalDir) - | (repo, localDir) <- secondaryRepos - ] - return - [ monitorDirectoryExistence dir - | dir <- (primaryLocalDir : map snd secondaryRepos) - ] + vcsSyncRepos verbosity gitProg repos = + fmap reverse $ + snd + <$> foldM syncRepo (Map.empty, []) repos + where + syncRepo (referenceRepos, monitors) (repo, localDir) = do + let refKey = (srpBranch repo, srpTag repo) + peer = Map.lookup refKey referenceRepos + -- `git clone --reference` cannot use a shallow checkout as a peer for + -- a different target ref, so only share checkouts between identical + -- branch/tag selections within the same source location group. + vcsSyncRepo verbosity gitProg repo localDir peer + let referenceRepos' + | isJust peer = referenceRepos + | otherwise = Map.insert refKey localDir referenceRepos + return + ( referenceRepos' + , monitorDirectoryExistence localDir : monitors + ) -- NOTE: Repositories are cloned once, but can be synchronized multiple times. -- Therefore, this code has to work with both `git clone` and `git fetch`. diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/cabal.test.hs new file mode 100644 index 00000000000..3c0d43ffca5 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/cabal.test.hs @@ -0,0 +1,94 @@ +import Distribution.System (OS (Windows), buildOS) +import System.Directory (copyFile, createDirectoryIfMissing) +import System.Exit (ExitCode (ExitSuccess)) +import System.FilePath ((), takeDirectory) +import qualified System.FilePath.Posix as Posix +import qualified System.FilePath.Windows as Windows +import Test.Cabal.Prelude + +-- | Test that source-repository-package works correctly with shallow clones +-- when multiple packages from the same repository are referenced at different commits. +-- +-- Regression test for: https://github.com/haskell/cabal/pull/10254#issuecomment-4586318112 +-- Before the fix, Cabal would try to use --reference between shallow clones at +-- different commits, causing "fatal: reference repository '...' is shallow". +main :: IO () +main = cabalTest $ withShorterPathForNewBuildStore $ recordMode DoNotRecord $ do + env <- getTestEnv + let testDir = testCurrentDir env + upstreamPath = testDir "upstream" + + -- Copy template files from repo-template/ to upstream/ + -- We need to copy because: + -- 1. The test framework copies all files to a temp directory + -- 2. We need to initialize a git repo and make separate commits for pkg-a and pkg-b + -- 3. Can't initialize git repo in repo-template/ since it's tracked by the outer repo + liftIO $ do + copyFileToDir (testDir "repo-template/pkg-a/pkg-a.cabal") (upstreamPath "pkg-a/pkg-a.cabal") + copyFileToDir (testDir "repo-template/pkg-a/src/PkgA.hs") (upstreamPath "pkg-a/src/PkgA.hs") + copyFileToDir (testDir "repo-template/pkg-b/pkg-b.cabal") (upstreamPath "pkg-b/pkg-b.cabal") + copyFileToDir (testDir "repo-template/pkg-b/src/PkgB.hs") (upstreamPath "pkg-b/src/PkgB.hs") + + -- Initialize git repo with two packages at different commits + (pkgACommit, pkgBCommit) <- withDirectory "upstream" $ do + git "init" [] + git "config" ["user.email", "testsuite@example.invalid"] + git "config" ["user.name", "Cabal Testsuite"] + + -- Commit pkg-a first + git "add" ["pkg-a"] + git "commit" ["-m", "Add pkg-a"] + pkgACommit <- gitCommitHash + + -- Then commit pkg-b + git "add" ["pkg-b"] + git "commit" ["-m", "Add pkg-b"] + pkgBCommit <- gitCommitHash + + pure (pkgACommit, pkgBCommit) + + -- Generate cabal.project dynamically with commit hashes + -- (Must use writeSourceFile because commit hashes are determined at runtime) + writeSourceFile "cabal.project" $ + unlines + [ "packages: dummy-app" + , "" + , "source-repository-package" + , " type: git" + , " location: " ++ fileUriFromPath upstreamPath + , " tag: " ++ pkgACommit + , " subdir: pkg-a" + , "" + , "source-repository-package" + , " type: git" + , " location: " ++ fileUriFromPath upstreamPath + , " tag: " ++ pkgBCommit + , " subdir: pkg-b" + ] + + -- Build should succeed without shallow reference errors + result <- cabal' "v2-build" ["all", "-v"] + assertExitCode ExitSuccess result + assertOutputDoesNotContain "reference repository" result + + where + gitCommitHash = do + result <- git' "rev-parse" ["HEAD"] + case lines (resultOutput result) of + (commit:_) -> pure commit + [] -> error "git rev-parse returned no output" + + fileUriFromPath path = + case buildOS of + Windows -> "file:///" ++ toPosixPath path + _ -> "file://" ++ toPosixPath path + + toPosixPath = map toPosixSeparator + + toPosixSeparator pathSeparator + | pathSeparator == Windows.pathSeparator = Posix.pathSeparator + | otherwise = pathSeparator + + copyFileToDir src dest = do + createDirectoryIfMissing True (takeDirectory dest) + copyFile src dest diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/app/Main.hs b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/app/Main.hs new file mode 100644 index 00000000000..9d15d98e00f --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/app/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import PkgA (pkgA) +import PkgB (pkgB) + +main :: IO () +main = putStrLn (pkgA ++ pkgB) diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/dummy-app.cabal b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/dummy-app.cabal new file mode 100644 index 00000000000..daad4e7b946 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/dummy-app/dummy-app.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: dummy-app +version: 0.1.0.0 +build-type: Simple + +executable dummy-app + main-is: Main.hs + hs-source-dirs: app + build-depends: base, pkg-a, pkg-b + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..a9498f64340 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/pkg-a.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: pkg-a +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: PkgA + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/src/PkgA.hs b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/src/PkgA.hs new file mode 100644 index 00000000000..f5305425782 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/src/PkgA.hs @@ -0,0 +1,4 @@ +module PkgA where + +pkgA :: String +pkgA = "a" diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..af5e3af0c9d --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/pkg-b.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.0 +name: pkg-b +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: PkgB + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/src/PkgB.hs b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/src/PkgB.hs new file mode 100644 index 00000000000..a3407c36f79 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/src/PkgB.hs @@ -0,0 +1,4 @@ +module PkgB where + +pkgB :: String +pkgB = "b"