[WIP] Avoid sharing shallow SRP references

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`.

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

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)

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

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

cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-a/src/PkgA.hs

@@ -0,0 +1,4 @@
+module PkgA where
+
+pkgA :: String
+pkgA = "a"

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

cabal-testsuite/PackageTests/NewBuild/SourceRepositoryPackageShallowReference/repo-template/pkg-b/src/PkgB.hs

@@ -0,0 +1,4 @@
+module PkgB where
+
+pkgB :: String
+pkgB = "b"