* Re: master 8d4a8b7dfd0: ; Re-apply accidentally reverted commit
[not found] ` <20240317214528.4FA50C1CB35@vcs2.savannah.gnu.org>
@ 2024-03-18 0:50 ` john muhl
2024-03-18 7:31 ` Kévin Le Gouguec
2024-03-18 19:02 ` Kévin Le Gouguec
0 siblings, 2 replies; 5+ messages in thread
From: john muhl @ 2024-03-18 0:50 UTC (permalink / raw)
To: Kévin Le Gouguec; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 8144 bytes --]
Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:
> branch: master
> commit 8d4a8b7dfd0905defac172cc58c2252dc1b39ad7
> Author: Kévin Le Gouguec <kevin.legouguec@gmail.com>
> Commit: Kévin Le Gouguec <kevin.legouguec@gmail.com>
>
> ; Re-apply accidentally reverted commit
>
> This re-applies:
>
> 2024-03-17 "Fix vc-dir when "remote" Git branch is local"
> (21828f288ef)
>
> reverted as part of the unrelated:
>
> 2024-03-17 "Update modus-themes to their 4.4.0 version"
> (67b0c1c09ea)
>
> The original commit message follows:
>
> 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.
> ---
> lisp/vc/vc-git.el | 46 ++++++++++++++++++++++++++++++--------------
> test/lisp/vc/vc-git-tests.el | 40 ++++++++++++++++++++++++++++++++++++++
> 2 files changed, 72 insertions(+), 14 deletions(-)
>
> diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
> index 18b4a8691e9..0d54e234659 100644
> --- a/lisp/vc/vc-git.el
> +++ b/lisp/vc/vc-git.el
> @@ -817,27 +817,31 @@ or an empty string if none."
> 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 tracking-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)))
> + (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
> + (setq tracking-branch (match-string 2 merge)))
> + (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
> (let* ((len (length stash-list))
> (limit
> @@ -890,6 +894,11 @@ or an empty string if none."
> (propertize "Branch : " 'face 'vc-dir-header)
> (propertize branch
> '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
> (concat
> "\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)))
>
> (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..fd3e8ccd602 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,42 @@
> (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
The test you added here fails when run by a user that doesn’t have
Git configured. When run by such a user the ‘git commit -mFirst’
command errors which causes the test to fail:
$ git commit -mFirst
Author identity unknown
*** Please tell me who you are.
Run
git config --global user.email "you@example.com"
git config --global user.name "Your Name"
to set your account's default identity.
Omit --global to set the identity only in this repository.
fatal: empty ident name (for <build@localhost>) not allowed
Test log attached.
make bootstrap
make test/lisp/vc/vc-git-tests.log
[-- Attachment #2: vc-git-tests.log --]
[-- Type: text/plain, Size: 2787 bytes --]
Running 8 tests (2024-03-17 20:03:21-0500, selector `(not (or (tag :unstable) (tag :nativecomp)))')
passed 1/8 vc-git-test-annotate-time (0.011113 sec)
Test vc-git-test-dir-track-local-branch backtrace:
signal(error ("Failed (status 128): git --no-pager commit -mFirst ."
error("Failed (%s): %s" "status 128" "git --no-pager commit -mFirst
vc-do-command(t 0 "git" nil "--no-pager" "commit" "-mFirst")
apply(vc-do-command t 0 "git" nil "--no-pager" ("commit" "-mFirst"))
vc-git-command(t 0 nil "commit" "-mFirst")
apply(vc-git-command t 0 nil ("commit" "-mFirst"))
(progn (apply 'vc-git-command t 0 nil args) (buffer-string))
(unwind-protect (progn (apply 'vc-git-command t 0 nil args) (buffer-
(save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn
(let ((temp-buffer (generate-new-buffer " *temp*" t))) (save-current
vc-git-test--run("commit" "-mFirst")
(let ((default-directory repo)) (vc-create-repo 'Git) (write-region
(progn (let ((default-directory repo)) (vc-create-repo 'Git) (write-
(unwind-protect (progn (let ((default-directory repo)) (vc-create-re
(let* ((coding-system-for-write nil) (temp-file (file-name-as-direct
(closure (t) nil (let* ((fn-25 #'executable-find) (args-26 (conditio
#f(compiled-function () #<bytecode -0xc2b6e48c397b23a>)()
handler-bind-1(#f(compiled-function () #<bytecode -0xc2b6e48c397b23a
ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
ert-run-test(#s(ert-test :name vc-git-test-dir-track-local-branch :d
ert-run-or-rerun-test(#s(ert--stats :selector ... :tests ... :test-m
ert-run-tests((not (or (tag :unstable) (tag :nativecomp))) #f(compil
ert-run-tests-batch((not (or (tag :unstable) (tag :nativecomp))))
ert-run-tests-batch-and-exit((not (or (tag :unstable) (tag :nativeco
eval((ert-run-tests-batch-and-exit '(not (or (tag :unstable) (tag :n
command-line-1(("-L" ":." "-l" "ert" "--eval" "(setq treesit-extra-l
command-line()
normal-top-level()
Test vc-git-test-dir-track-local-branch condition:
(error "Failed (status 128): git --no-pager commit -mFirst .")
FAILED 2/8 vc-git-test-dir-track-local-branch (0.014005 sec) at lisp/vc/vc-git-tests.el:104
passed 3/8 vc-git-test-program-version-apple (0.000102 sec)
passed 4/8 vc-git-test-program-version-general (0.000067 sec)
passed 5/8 vc-git-test-program-version-invalid-leading-dot (0.000058 sec)
passed 6/8 vc-git-test-program-version-invalid-leading-string (0.000061 sec)
passed 7/8 vc-git-test-program-version-other (0.000058 sec)
passed 8/8 vc-git-test-program-version-windows (0.000058 sec)
Ran 8 tests, 7 results as expected, 1 unexpected (2024-03-17 20:03:22-0500, 0.096440 sec)
1 unexpected results:
FAILED vc-git-test-dir-track-local-branch
^ permalink raw reply [flat|nested] 5+ messages in thread