Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix recurrence of bug#80803 after changes in bug#80967

Browse source 
* lisp/vc/vc-dir.el (vc-dir-resynch-file): Pass only truenames
to vc-dir-recompute-file-state.
* test/lisp/vc/vc-tests/vc-test-misc.el (vc-git): Require.
(vc-test-vc-dir-on-symlink): New test.
This commit is contained in:
Sean Whitton 2026-06-08 15:29:12 +01:00
parent fff343c332
commit c244314974
2 changed files with 55 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
lisp/vc/vc-dir.el
View file

@ -1313,8 +1313,7 @@ that file."
(defun vc-dir-resynch-file (&optional fname)
"Update the entries for FNAME in any directory buffers that list it."
(let* ((file (or fname buffer-file-name))
(file-tn (file-truename file))
(let* ((file (file-truename (or fname buffer-file-name)))
(drop '()))
(save-current-buffer
;; look for a vc-dir buffer that might show this file.
@ -1333,20 +1332,20 @@ that file."
;; `default-directory' in order to do its work,
;; but that's irrelevant to us here.
(buffer-local-toplevel-value 'default-directory))))
(when (file-in-directory-p file-tn ddir)
(if (file-directory-p file-tn)
(when (file-in-directory-p file ddir)
(if (file-directory-p file)
(progn
(vc-dir-resync-directory-files file-tn)
(vc-dir-resync-directory-files file)
(ewoc-set-hf vc-ewoc
(vc-dir-headers vc-dir-backend ddir) ""))
(let* ((complete-state
;; Pass FILE not FILE-TN here. See bug#80967.
(vc-dir-recompute-file-state file ddir))
(vc-dir-recompute-file-state file
(file-truename ddir)))
(state (cadr complete-state)))
(vc-dir-update
(list complete-state)
status-buf (or (not state)
(eq state 'up-to-date)))))))))))
(vc-dir-update (list complete-state)
status-buf
(or (not state)
(eq state 'up-to-date)))))))))))
;; Remove out-of-date entries from vc-dir-buffers.
(setq vc-dir-buffers
(cl-nset-difference vc-dir-buffers drop :test #'eq))))

45
test/lisp/vc/vc-tests/vc-test-misc.el
View file

@ -25,6 +25,7 @@
(require 'ert-x)
(require 'vc)
(require 'vc-git)
(ert-deftest vc-test-buffer-sync-fileset ()
"Test `vc-buffer-sync-fileset'."
@ -242,5 +243,49 @@
(should (eq (vc--match-branch-name-regexps "master") 'topic))
(should (eq (vc--match-branch-name-regexps "foo") 'trunk)))))
(ert-deftest vc-test-vc-dir-on-symlink ()
"Test VC-Dir on a symlink to a repository.
See bug#80803 and bug#80967."
(skip-unless (executable-find vc-git-program))
(let ((vc-handled-backends '(Git)))
(ert-with-temp-directory tempdir
(let* ((default-directory tempdir)
(src (expand-file-name "src/" tempdir))
(dest (expand-file-name "dest/" tempdir))
(file (expand-file-name "foo" dest))
file-buf truename-dir symlink-dir)
(make-directory dest)
(let ((default-directory dest)
vc-async-checkin)
(vc-create-repo 'Git)
(write-region "foo\n" nil file nil 'nomessage)
(with-current-buffer (setq file-buf (find-file-noselect file))
(vc-register `(Git (,file)))
(vc-checkin (list file) 'Git)
(insert "Initial commit")
(let (vc-async-checkin)
(log-edit-done))))
(make-symbolic-link dest src)
;; Emulate an interactive call to `vc-dir'.
(vc-dir (file-truename src) 'Git)
(while (vc-dir-busy) (sit-for 0.05))
(should (equal default-directory dest))
(setq truename-dir (current-buffer))
;; Now a `vc-dir' pointed at the symlink, which is unlike an
;; interactive call to `vc-dir'.
(vc-dir src 'Git)
(while (vc-dir-busy) (sit-for 0.05))
(should (equal default-directory src))
(setq symlink-dir (current-buffer))
(with-current-buffer file-buf
(insert "bar")
(basic-save-buffer))
(dolist (buf (list truename-dir symlink-dir))
(with-current-buffer buf
(should (equal (vc-dir-fileinfo->name
(ewoc-data
(ewoc-nth vc-ewoc 1)))
(file-name-nondirectory file)))))))))
(provide 'vc-test-misc)
;;; vc-test-misc.el ends here