From 1573015fba16f8b453e87e92e982fc633bca40d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sun, 7 Jul 2024 12:16:12 +0200 Subject: [PATCH 1/3] 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. --- test/lisp/vc/vc-git-tests.el | 98 +++++++++++++++++++++++++++++------- 1 file changed, 80 insertions(+), 18 deletions(-) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index f15a0f52e8c..2dbf5a8df12 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -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 @@ vc-git-test--run (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 -- 2.39.2