Fix vc-dir when "remote" Git branch is local

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'; stop calling
vc-git-repository-url when REMOTE is "." to avoid throwing an
error; 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)
(vc-git-test--run): New helpers, defined to steer clear of
vc-git-- internal functions.
(vc-git-test-dir-track-local-branch): Check that vc-dir does
not crash.
This commit is contained in:
Kévin Le Gouguec 2024-02-12 08:29:19 +01:00
parent 7a0f4de3c1
commit 21828f288e
2 changed files with 72 additions and 14 deletions

View file

@ -817,27 +817,31 @@ or an empty string if none."
cmds)) cmds))
(defun vc-git-dir-extra-headers (dir) (defun vc-git-dir-extra-headers (dir)
(let ((str (with-output-to-string (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list)) (stash-list (vc-git-stash-list))
(default-directory dir) (default-directory dir)
(in-progress (vc-git--cmds-in-progress)) (in-progress (vc-git--cmds-in-progress))
branch remote remote-url stash-button stash-string) branch remote-url stash-button stash-string tracking-branch)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
(progn (progn
(setq branch (match-string 2 str)) (setq branch (match-string 2 str))
(setq remote (let ((remote (vc-git--out-str
(with-output-to-string "config" (concat "branch." branch ".remote")))
(with-current-buffer standard-output (merge (vc-git--out-str
(vc-git--out-ok "config" "config" (concat "branch." branch ".merge"))))
(concat "branch." branch ".remote")))))
(when (string-match "\\([^\n]+\\)" remote) (when (string-match "\\([^\n]+\\)" remote)
(setq remote (match-string 1 remote))) (setq remote (match-string 1 remote)))
(when (> (length remote) 0) (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
(setq remote-url (vc-git-repository-url dir remote)))) (setq tracking-branch (match-string 2 merge)))
(setq branch "not (detached HEAD)")) (pcase remote
("."
(setq remote-url "none (tracking local branch)"))
((pred (not string-empty-p))
(setq
remote-url (vc-git-repository-url dir remote)
tracking-branch (concat remote "/" tracking-branch))))))
(setq branch "none (detached HEAD)"))
(when stash-list (when stash-list
(let* ((len (length stash-list)) (let* ((len (length stash-list))
(limit (limit
@ -890,6 +894,11 @@ or an empty string if none."
(propertize "Branch : " 'face 'vc-dir-header) (propertize "Branch : " 'face 'vc-dir-header)
(propertize branch (propertize branch
'face 'vc-dir-header-value) 'face 'vc-dir-header-value)
(when tracking-branch
(concat
"\n"
(propertize "Tracking : " 'face 'vc-dir-header)
(propertize tracking-branch 'face 'vc-dir-header-value)))
(when remote-url (when remote-url
(concat (concat
"\n" "\n"
@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes
(apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args)))
(defun vc-git--out-ok (command &rest 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))) (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) (defun vc-git--run-command-string (file &rest args)
"Run a git command on FILE and return its output as string. "Run a git command on FILE and return its output as string.
FILE can be nil." FILE can be nil."

View file

@ -24,6 +24,8 @@
;;; Code: ;;; Code:
(require 'ert-x)
(require 'vc)
(require 'vc-git) (require 'vc-git)
(ert-deftest vc-git-test-program-version-general () (ert-deftest vc-git-test-program-version-general ()
@ -81,4 +83,42 @@
(should-not (vc-git-annotate-time)) (should-not (vc-git-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. Bug#68183."
(skip-unless (executable-find vc-git-program))
(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 ;;; vc-git-tests.el ends here