Test more vc-dir scenarios with Git (bug#68183)

* test/lisp/vc/vc-git-tests.el
(vc-git-test-dir-track-local-branch): Remove in favor of new
test.
(vc-git-test--start-branch): New helper to get a repository
going.
(vc-git-test--dir-headers): New helper to get a list of headers
in the current vc-dir buffer.
(vc-git-test-dir-branch-headers): New test, exercising the
original bug recipe plus more common scenarios.
This commit is contained in:
Kévin Le Gouguec 2024-07-07 12:16:12 +02:00 committed by Dmitry Gutov
parent a268496727
commit 2f710af5bf

View file

@ -26,6 +26,7 @@
(require 'ert-x)
(require 'vc)
(require 'vc-dir)
(require 'vc-git)
(ert-deftest vc-git-test-program-version-general ()
@ -108,24 +109,85 @@ allow `git commit' to determine identities for authors and committers."
(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."
(defun vc-git-test--start-branch ()
"Get a branch started in a freshly initialized repository.
This returns the name of the current branch, so that tests can remain
agnostic of init.defaultbranch."
(write-region "hello" nil "README")
(vc-git-test--run "add" "README")
(vc-git-test--run "commit" "-mFirst")
(string-trim (vc-git-test--run "branch" "--show-current")))
(defun vc-git-test--dir-headers (headers)
"Return an alist of header values for the current `vc-dir' buffer.
HEADERS should be a list of (NAME ...) strings. This function will
return a list of (NAME . VALUE) pairs, where VALUE is nil if the header
is absent."
;; FIXME: to reproduce interactive sessions faithfully, we would need
;; to wait for the dir-status-files process to terminate; have not
;; found a reliable way to do this. As a workaround, kill pending
;; processes and revert the `vc-dir' buffer.
(vc-dir-kill-dir-status-process)
(revert-buffer)
(mapcar
(lambda (header)
(let* ((pattern
(rx bol
(literal header) (* space) ": " (group (+ nonl))
eol))
(value (and (goto-char (point-min))
(re-search-forward pattern nil t)
(match-string 1))))
(cons header value)))
headers))
(ert-deftest vc-git-test-dir-branch-headers ()
"Check that `vc-dir' shows expected branch-related headers."
(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))))))
;; Create a repository that will serve as the "remote".
(vc-git-test--with-repo origin-repo
(let ((main-branch (vc-git-test--start-branch)))
;; 'git clone' this repository and test things in this clone.
(ert-with-temp-directory clone-repo
(vc-git-test--run "clone" origin-repo clone-repo)
(vc-dir clone-repo)
(should
(equal
(vc-git-test--dir-headers
'("Branch" "Tracking" "Remote"))
`(("Branch" . ,main-branch)
("Tracking" . ,(concat "origin/" main-branch))
("Remote" . ,origin-repo))))
;; Checkout a new branch: no tracking information.
(vc-git-test--run "checkout" "-b" "feature/foo" main-branch)
(should
(equal
(vc-git-test--dir-headers
'("Branch" "Tracking" "Remote"))
'(("Branch" . "feature/foo")
("Tracking" . nil)
("Remote" . nil))))
;; Push with '--set-upstream origin': tracking information
;; should be updated.
(vc-git-test--run "push" "--set-upstream" "origin" "feature/foo")
(should
(equal
(vc-git-test--dir-headers
'("Branch" "Tracking" "Remote"))
`(("Branch" . "feature/foo")
("Tracking" . "origin/feature/foo")
("Remote" . ,origin-repo))))
;; Checkout a new branch tracking the _local_ main branch.
;; Bug#68183.
(vc-git-test--run "checkout" "-b" "feature/bar" "--track" main-branch)
(should
(equal
(vc-git-test--dir-headers
'("Branch" "Tracking" "Remote"))
`(("Branch" . "feature/bar")
("Tracking" . ,main-branch)
("Remote" . "none (tracking local branch)"))))))))
;;; vc-git-tests.el ends here