master 29c44e61c59: Fix VC Git patch check-in for sparse checkouts

branch: master
commit 29c44e61c595ce44301badd8251737fd725fe1d0
Author: Paul Nelson <[email protected]>
Commit: Sean Whitton <[email protected]>

    Fix VC Git patch check-in for sparse checkouts
    
    * lisp/vc/vc-git.el (vc-git--with-temp-index): New macro.  Pass
    the temporary index through 'file-local-name' when setting
    GIT_INDEX_FILE.
    (vc-git--stash-staged-changes): Use it.  This fixes a Tramp bug:
    GIT_INDEX_FILE was previously set to the full remote name of the
    temporary index, which the remote Git process cannot use.
    (vc-git--checkin): Prepare git apply --3way with a temporary
    GIT_INDEX_FILE, so that sparse checkout errors from out-of-cone
    untracked files do not leave the user's index partially
    modified.  (Bug#80951)
    * test/lisp/vc/vc-git-tests.el: Require log-edit.
    (vc-git-test-checkin-patch-sparse-checkout): New test.
---
 lisp/vc/vc-git.el            | 89 ++++++++++++++++++++++++--------------------
 test/lisp/vc/vc-git-tests.el | 39 ++++++++++++++++++-
 2 files changed, 86 insertions(+), 42 deletions(-)

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 312abcbb975..83e624e618c 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1296,6 +1296,21 @@ It is based on `log-edit-mode', and has Git-specific extensions."
                                             (file-local-name ,temp)))
        (delete-file ,temp))))
 
+(defmacro vc-git--with-temp-index (&rest body)
+  "Execute BODY with a temporary Git index file.
+After executing, delete the temporary index.  The index starts empty;
+callers may populate it with, e.g., \\='git read-tree HEAD\\='."
+  (declare (indent 0) (debug t))
+  (cl-with-gensyms (index)
+    `(let ((,index (make-nearby-temp-file "git-index")))
+       (unwind-protect
+           ;; Use `file-local-name' to strip the TRAMP prefix
+           ;; from the index.
+           (with-environment-variables
+               (("GIT_INDEX_FILE" (file-local-name ,index)))
+             ,@body)
+         (delete-file ,index)))))
+
 (defalias 'vc-git-async-checkins #'always)
 
 (defalias 'vc-git-working-revision-symbol (cl-constantly "HEAD"))
@@ -1418,35 +1433,35 @@ It is an error to supply both or neither."
              ;;
              ;; 'git apply --3way --ours' is the way Git provides to
              ;; achieve this.  This requires that the index match the
-             ;; working tree and also implies the --index option, which
-             ;; means applying the changes to the index in addition to
-             ;; the working tree.  These are both okay here because
-             ;; before doing this we know the index is empty (we just
-             ;; committed) and so we can just make use of it and reset
-             ;; afterwards.
+             ;; working tree and also implies the --index option.  Use a
+             ;; temporary index for that.
              (when (and patch-string (not (string-empty-p patch-string)))
-               (vc-git-command nil 0 nil "add" "--all")
-               (with-temp-buffer
-                 (vc-git--with-apply-temp (patch t 1 "--3way")
-                   (with-temp-file patch
-                     (insert patch-string)))
-                 ;; We could delete the following if we could also pass
-                 ;; --ours to git-apply, but that is only available in
-                 ;; recent versions of Git.  --3way is much older.
-                 (cl-loop
-                  initially (goto-char (point-min))
-                  ;; git-apply doesn't apply Git's usual quotation and
-                  ;; escape rules for printing file names so we can do
-                  ;; this simple regexp processing.
-                  ;; (Passing -z does not affect the relevant output.)
-                  while (re-search-forward "^U " nil t)
-                  collect (buffer-substring-no-properties (point)
-                                                          (pos-eol))
-                  into paths
-                  finally (when paths
-                            (vc-git-command nil 0 paths
-                                            "checkout" "--ours"))))
-               (vc-git-command nil 0 nil "reset"))
+               (vc-git--with-temp-index
+                 (vc-git-command nil 0 nil "read-tree" "HEAD")
+                 ;; This index is scratch for 'git apply --3way',
+                 ;; so ignore nonzero exit status (e.g., due to
+                 ;; out-of-cone files in a sparse checkout).
+                 (vc-git-command nil t nil "add" "--all")
+                 (with-temp-buffer
+                   (vc-git--with-apply-temp (patch t 1 "--3way")
+                     (with-temp-file patch
+                       (insert patch-string)))
+                   ;; We could delete the following if we could also pass
+                   ;; --ours to git-apply, but that is only available in
+                   ;; recent versions of Git.  --3way is much older.
+                   (cl-loop
+                    initially (goto-char (point-min))
+                    ;; git-apply doesn't apply Git's usual quotation and
+                    ;; escape rules for printing file names so we can do
+                    ;; this simple regexp processing.
+                    ;; (Passing -z does not affect the relevant output.)
+                    while (re-search-forward "^U " nil t)
+                    collect (buffer-substring-no-properties (point)
+                                                            (pos-eol))
+                    into paths
+                    finally (when paths
+                              (vc-git-command nil 0 paths
+                                              "checkout" "--ours"))))))
              (when to-stash
                (vc-git--with-apply-temp (cached)
                  (with-temp-file cached
@@ -1589,19 +1604,11 @@ REV is ignored."
             (progn
               (with-temp-file cached
                 (vc-git-command t 0 files "diff" "--cached" "--"))
-              (let* ((index (make-nearby-temp-file "git-index"))
-                     (process-environment
-                      (cons (format "GIT_INDEX_FILE=%s" index)
-                            process-environment)))
-                (unwind-protect
-                    (progn
-                      (vc-git-command nil 0 nil "read-tree" "HEAD")
-                      ;; See `vc-git--with-apply-temp'
-                      ;; regarding use of `file-local-name'.
-                      (vc-git-command nil 0 nil "apply" "--cached"
-                                      (file-local-name cached))
-                      (setq tree (git-string "write-tree")))
-                  (delete-file index))))
+              (vc-git--with-temp-index
+                (vc-git-command nil 0 nil "read-tree" "HEAD")
+                (vc-git-command nil 0 nil "apply" "--cached"
+                                (file-local-name cached))
+                (setq tree (git-string "write-tree"))))
           (delete-file cached))
         ;; Prepare stash commit object, which has a special structure.
         (let* ((tree-commit (git-string "commit-tree" "-m" message
diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el
index 96fa3d65c05..6a6de5707f2 100644
--- a/test/lisp/vc/vc-git-tests.el
+++ b/test/lisp/vc/vc-git-tests.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'ert-x)
+(require 'log-edit)
 (require 'vc)
 (require 'vc-dir)
 (require 'vc-git)
@@ -232,7 +233,6 @@ is absent."
 (ert-deftest vc-git-test-checkin-patch-staged-diff ()
   "Checking in a patch that matches staged changes should not error."
   (skip-unless (executable-find vc-git-program))
-  (require 'log-edit)
   (vc-git-test--with-repo repo
     (vc-git-test--start-branch)
     (write-region "Hello\n" nil "README")
@@ -242,4 +242,41 @@ is absent."
     (should (equal (string-trim (vc-git-test--run "log" "-1" "--pretty=%s"))
                    "Second"))))
 
+(ert-deftest vc-git-test-checkin-patch-sparse-checkout ()
+  "Check in a single-file patch in a sparse checkout.
+The patch should be committed and the user's index left untouched, even
+when an untracked file lies outside the sparse-checkout cone.
+Regression test for bug#80951."
+  (skip-unless (executable-find vc-git-program))
+  ;; `sparse-checkout' was introduced in Git 2.25.
+  (skip-unless (version<= "2.25" (vc-git--program-version)))
+  (vc-git-test--with-repo repo
+    (write-region "1\n" nil "tracked.txt")
+    (write-region "a\n" nil "other.txt")
+    (vc-git-test--run "add" "tracked.txt" "other.txt")
+    (vc-git-test--run "commit" "-m" "Initial")
+    ;; Restrict the sparse checkout to the two committed files, so that
+    ;; any other path is "outside the cone".
+    (vc-git-test--run "sparse-checkout" "init" "--no-cone")
+    (vc-git-test--run "sparse-checkout" "set" "/tracked.txt" "/other.txt")
+    ;; scratch.txt is untracked and outside the cone: this is what makes
+    ;; `git add --all' exit non-zero.
+    (write-region "do not add me\n" nil "scratch.txt")
+    ;; Modify both in-cone files, but only check in tracked.txt.
+    (write-region "2\n" nil "tracked.txt")
+    (write-region "b\n" nil "other.txt")
+    (let ((patch (vc-git-test--run "diff" "--" "tracked.txt"))
+          vc-async-checkin)
+      ;; Before the fix, this signaled an error from `git add --all'.
+      (vc-git--checkin "Update tracked" nil patch))
+    ;; Check that the selected patch was committed.
+    (should (equal (string-trim (vc-git-test--run "log" "-1" "--pretty=%s"))
+                   "Update tracked"))
+    ;; Check that nothing was left staged in the user's index.
+    (should (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")))
+    ;; Check that other.txt remains modified in the worktree, while
+    ;; scratch.txt is untracked.
+    (should (equal (vc-git-test--run "status" "--short")
+                   " M other.txt\n?? scratch.txt\n"))))
+
 ;;; vc-git-tests.el ends here