bug#68183: 28.3; vc-dir fails when I have a certain branch checked out

["Kévin Le Gouguec" <kevin.legouguec@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2044 bytes --]

Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:

> Tom Tromey <tom@tromey.com> writes:
>
>> Eli> Thanks, but I think we'd appreciate a reproducible recipe for this:
>> Eli> how can one create a Git repository which can be used to reproduce
>> Eli> this issue?
>>
>> This worked for me:
>>
>> $ cd ~/Emacs/trunk
>> # This is my Emacs git repository
>> $ git checkout --track -b vc-dir-bug master
>> branch 'vc-dir-bug' set up to track 'master'.
>> Switched to a new branch 'vc-dir-bug'
>>
>>
>> Now invoke vc-dir on that directory.
>

[…]

> git-config(1) says that branch.<name>.remote is "." when <name> is
> tracking a local branch, whereas branch.<name>.merge points to the local
> branch 'git pull' will resync with.  Wonder what TRT would be for the
> purposes of vc-dir?

Here's a patch.  tl;dr

(1) When branch.<name>.remote is ".", display…

    > Remote    : none (tracking local branch)

    … instead of raising an error.

(2) When branch.<name>.merge is set to BRANCH, display…

    > Tracking  : BRANCH

(3) Add tests, because why not.

CC'ing Dmitry and Juri, whom my brain associates with vc-git maintenance
(rightly or wrongly; apologies for the noise if the latter).

I might be slow to respond for the next couple of weeks, so please feel
free to adapt or dismiss the patch as convenient.  FWIW, off the top of
my head,

* the test should probably have a (skip-unless (have-git-or-something)),
* maybe "none (tracking local branch)" is not informative and we should
  ditch it,
  * maybe we should fall back to "origin", like vc-git-repository-url
    does,
* rushed the ChangeLog entry; vc-git-test--run should also be declared
  as a "new helper" (and maybe I should spell out that I used it to not
  have to depend on vc-git-- internal functions),
* maybe the new header deserves a NEWS entry.

I can tackle any of the above (and any other feedback), though again, if
someone has a vision and I don't answer in a timely manner, don't wait
on me.


[-- Attachment #2: 0001-Fix-vc-dir-when-remote-Git-branch-is-local.patch --]
[-- Type: text/x-patch, Size: 6680 bytes --]

From ba9b1f6f340a551acab0014c69f05f38191bd345 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Mon, 12 Feb 2024 08:29:19 +0100
Subject: [PATCH] Fix vc-dir when "remote" Git branch is local
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

While in there, add that "tracking" branch to the vc-dir buffer.
For bug#68183.

* lisp/vc/vc-git.el (vc-git-dir-extra-headers): Reduce
boilerplate with new function 'vc-git--out-ok'; skip calling
vc-git-repository-url when REMOTE is "."; display tracking
branch; prefer "none (<details…>)" to "not (<details…>)" since
that reads more grammatically correct.
(vc-git--out-ok): Add documentation.
(vc-git--out-str): New function to easily get the output from a
Git command.
* test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo): New
helper.
(vc-git-test--run, vc-git-test-dir-track-local-branch): Check
that vc-dir does not crash.
---
 lisp/vc/vc-git.el            | 44 ++++++++++++++++++++++++------------
 test/lisp/vc/vc-git-tests.el | 39 ++++++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+), 14 deletions(-)

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 456417e566e..bf3032e5537 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -817,27 +817,29 @@ vc-git--cmds-in-progress
     cmds))
 
 (defun vc-git-dir-extra-headers (dir)
-  (let ((str (with-output-to-string
-               (with-current-buffer standard-output
-                 (vc-git--out-ok "symbolic-ref" "HEAD"))))
+  (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
 	(stash-list (vc-git-stash-list))
         (default-directory dir)
         (in-progress (vc-git--cmds-in-progress))
 
-	branch remote remote-url stash-button stash-string)
+	branch remote-url stash-button stash-string upstream-branch)
     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 	(progn
 	  (setq branch (match-string 2 str))
-	  (setq remote
-		(with-output-to-string
-		  (with-current-buffer standard-output
-		    (vc-git--out-ok "config"
-                                    (concat "branch." branch ".remote")))))
-	  (when (string-match "\\([^\n]+\\)" remote)
-	    (setq remote (match-string 1 remote)))
-          (when (> (length remote) 0)
-	    (setq remote-url (vc-git-repository-url dir remote))))
-      (setq branch "not (detached HEAD)"))
+          (let ((remote (vc-git--out-str
+                         "config" (concat "branch." branch ".remote")))
+                (merge (vc-git--out-str
+                        "config" (concat "branch." branch ".merge"))))
+            (when (string-match "\\([^\n]+\\)" remote)
+	      (setq remote (match-string 1 remote)))
+            (pcase remote
+              ("."
+               (setq remote-url "none (tracking local branch)"))
+              ((pred (not string-empty-p))
+               (setq remote-url (vc-git-repository-url dir remote))))
+            (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
+              (setq upstream-branch (match-string 2 merge)))))
+      (setq branch "none (detached HEAD)"))
     (when stash-list
       (let* ((len (length stash-list))
              (limit
@@ -896,6 +898,11 @@ vc-git-dir-extra-headers
 	(propertize "Remote     : " 'face 'vc-dir-header)
 	(propertize remote-url
 		    'face 'vc-dir-header-value)))
+     (when upstream-branch
+       (concat
+        "\n"
+        (propertize "Tracking   : " 'face 'vc-dir-header)
+        (propertize upstream-branch 'face 'vc-dir-header-value)))
      ;; For now just a heading, key bindings can be added later for various bisect actions
      (when (memq 'bisect in-progress)
        (propertize  "\nBisect     : in progress" 'face 'vc-dir-status-warning))
@@ -2219,8 +2226,17 @@ vc-git--call
     (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args)))
 
 (defun vc-git--out-ok (command &rest args)
+  "Run `git COMMAND ARGS...' and insert standard output in current buffer.
+Return whether the process exited with status zero."
   (zerop (apply #'vc-git--call '(t nil) command args)))
 
+(defun vc-git--out-str (command &rest args)
+  "Run `git COMMAND ARGS...' and return standard output.
+The exit status is ignored."
+  (with-output-to-string
+    (with-current-buffer standard-output
+      (apply #'vc-git--out-ok command args))))
+
 (defun vc-git--run-command-string (file &rest args)
   "Run a git command on FILE and return its output as string.
 FILE can be nil."
diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el
index c52cd9c5875..1f8abe7b9b0 100644
--- a/test/lisp/vc/vc-git-tests.el
+++ b/test/lisp/vc/vc-git-tests.el
@@ -24,6 +24,8 @@
 
 ;;; Code:
 
+(require 'ert-x)
+(require 'vc)
 (require 'vc-git)
 
 (ert-deftest vc-git-test-program-version-general ()
@@ -81,4 +83,41 @@ vc-git-test-annotate-time
     (should-not (vc-git-annotate-time))
     (should-not (vc-git-annotate-time))))
 
+(defmacro vc-git-test--with-repo (name &rest body)
+  "Initialize a repository in a temporary directory and evaluate BODY.
+
+The current directory will be set to the top of that repository; NAME
+will be bound to that directory's file name.  Once BODY exits, the
+directory will be deleted."
+  (declare (indent 1))
+  `(ert-with-temp-directory ,name
+     (let ((default-directory ,name))
+       (vc-create-repo 'Git)
+       ,@body)))
+
+(defun vc-git-test--run (&rest args)
+  "Run git ARGS…, check for non-zero status, and return output."
+  (with-temp-buffer
+    (apply 'vc-git-command t 0 nil args)
+    (buffer-string)))
+
+(ert-deftest vc-git-test-dir-track-local-branch ()
+  "Test that `vc-dir' works when tracking local branches.  See bug#68183."
+  (vc-git-test--with-repo repo
+    ;; Create an initial commit to get a branch started.
+    (write-region "hello" nil "README")
+    (vc-git-test--run "add" "README")
+    (vc-git-test--run "commit" "-mFirst")
+    ;; Get current branch name lazily, to remain agnostic of
+    ;; init.defaultbranch.
+    (let ((upstream-branch
+           (string-trim (vc-git-test--run "branch" "--show-current"))))
+      (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch)
+      (vc-dir default-directory)
+      (pcase-dolist (`(,header ,value)
+                     `(("Branch" "hack")
+                       ("Tracking" ,upstream-branch)))
+        (goto-char (point-min))
+        (re-search-forward (format "^%s *: %s$" header value))))))
+
 ;;; vc-git-tests.el ends here
-- 
2.43.0