Merge from origin/emacs-31

71ea4bbb6c vc-test-vc-dir-on-symlink: Use vc-test--with-author-identity
b8fa2243ea Fix M-RET in 'markdown-ts-in-table-mode-map'
c244314974 Fix recurrence of bug#80803 after changes in bug#80967
This commit is contained in:
Sean Whitton 2026-06-09 11:33:26 +01:00
commit d7e7dd62ff
5 changed files with 168 additions and 85 deletions

View file

@ -5133,6 +5133,7 @@ commands in a table context."
:menu nil
"<return>" #'markdown-ts-table-next-row
"S-<return>" #'markdown-ts-table-previous-row
"M-RET" #'markdown-ts-table-insert-row-below
"<tab>" #'markdown-ts-table-next-cell
"<backtab>" #'markdown-ts-table-previous-cell
"M-<up>" #'markdown-ts-table-move-row-up

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))))

View file

@ -0,0 +1,100 @@
;;; vc-test-helper.el --- VC test suite helpers -*- lexical-binding:t -*-
;; Copyright (C) 2014-2026 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Sean Whitton <spwhitton@spwhitton.name>
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(defun vc-test--create-repo-function (backend)
"Run the `vc-create-repo' backend function.
For backends which don't support it, it is emulated."
(cond
((eq backend 'CVS)
(let ((tmp-dir
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(make-directory (expand-file-name "module" tmp-dir) 'parents)
(make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents)
(if (not (fboundp 'w32-application-type))
(shell-command-to-string (format "cvs -Q -d:local:%s co module"
tmp-dir))
(let ((cvs-prog (executable-find "cvs"))
(tdir tmp-dir))
;; If CVS executable is an MSYS program, reformat the file
;; name of TMP-DIR to have the /d/foo/bar form supported by
;; MSYS programs. (FIXME: What about Cygwin cvs.exe?)
(if (eq (w32-application-type cvs-prog) 'msys)
(setq tdir
(concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2))))
(shell-command-to-string (format "cvs -Q -d:local:%s co module"
tdir))))
(rename-file "module/CVS" default-directory)
(delete-directory "module" 'recursive)
;; We must cleanup the "remote" CVS repo as well.
(add-hook 'vc-test--cleanup-hook
(lambda () (delete-directory tmp-dir 'recursive)))))
((eq backend 'Arch)
(let ((archive-name (format "%s--%s" user-mail-address (random))))
(when (string-match
"no arch user id set" (shell-command-to-string "tla my-id"))
(shell-command-to-string
(format "tla my-id \"<%s>\"" user-mail-address)))
(shell-command-to-string
(format "tla make-archive %s %s" archive-name default-directory))
(shell-command-to-string
(format "tla my-default-archive %s" archive-name))))
((eq backend 'Mtn)
(let ((archive-name "foo.mtn"))
(shell-command-to-string
(format
"mtn db init --db=%s"
(expand-file-name archive-name default-directory)))
(shell-command-to-string
(format "mtn --db=%s --branch=foo setup ." archive-name))))
(t (vc-create-repo backend))))
(defvar vc-hg-global-switches)
(defmacro vc-test--with-author-identity (backend &rest body)
(declare (indent 1) (debug t))
`(let ((process-environment process-environment)
(vc-hg-global-switches (bound-and-true-p vc-hg-global-switches)))
;; git tries various approaches to guess a user name and email,
;; which can fail depending on how the system is configured.
;; Eg if the user account has no GECOS, git commit can fail with
;; status 128 "fatal: empty ident name".
(when (memq ,backend '(Bzr Git))
(push "EMAIL=joh.doe@example.com" process-environment))
(when (eq ,backend 'Git)
(setq process-environment (append '("GIT_AUTHOR_NAME=A"
"GIT_COMMITTER_NAME=C")
process-environment)))
;; Mercurial fails to autodetect an identity on MS-Windows.
(when (eq ,backend 'Hg)
(push "--config=ui.username=john@doe.ee" vc-hg-global-switches))
,@body))
(provide 'vc-tests-helpers)

View file

@ -25,6 +25,14 @@
(require 'ert-x)
(require 'vc)
(require 'vc-git)
(require 'vc-dir)
(require 'log-edit)
(require 'vc-tests-helpers
(ert-resource-file "vc-tests-helpers"))
(defvar vc-hg-global-switches)
(ert-deftest vc-test-buffer-sync-fileset ()
"Test `vc-buffer-sync-fileset'."
@ -242,5 +250,50 @@
(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))
(vc-test--with-author-identity 'Git
(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-test--create-repo-function '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

View file

@ -120,6 +120,10 @@
(require 'project)
(require 'cl-lib)
(require 'vc-tests-helpers
(ert-resource-file "vc-tests-helpers"))
(defvar vc-hg-global-switches)
(declare-function w32-application-type "w32proc.c")
;; The working horses.
@ -132,58 +136,6 @@ Don't set it globally, the functions should be let-bound.")
"Run the `revision-granularity' backend function."
(vc-call-backend backend 'revision-granularity))
(defun vc-test--create-repo-function (backend)
"Run the `vc-create-repo' backend function.
For backends which don't support it, it is emulated."
(cond
((eq backend 'CVS)
(let ((tmp-dir
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(make-directory (expand-file-name "module" tmp-dir) 'parents)
(make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents)
(if (not (fboundp 'w32-application-type))
(shell-command-to-string (format "cvs -Q -d:local:%s co module"
tmp-dir))
(let ((cvs-prog (executable-find "cvs"))
(tdir tmp-dir))
;; If CVS executable is an MSYS program, reformat the file
;; name of TMP-DIR to have the /d/foo/bar form supported by
;; MSYS programs. (FIXME: What about Cygwin cvs.exe?)
(if (eq (w32-application-type cvs-prog) 'msys)
(setq tdir
(concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2))))
(shell-command-to-string (format "cvs -Q -d:local:%s co module"
tdir))))
(rename-file "module/CVS" default-directory)
(delete-directory "module" 'recursive)
;; We must cleanup the "remote" CVS repo as well.
(add-hook 'vc-test--cleanup-hook
(lambda () (delete-directory tmp-dir 'recursive)))))
((eq backend 'Arch)
(let ((archive-name (format "%s--%s" user-mail-address (random))))
(when (string-match
"no arch user id set" (shell-command-to-string "tla my-id"))
(shell-command-to-string
(format "tla my-id \"<%s>\"" user-mail-address)))
(shell-command-to-string
(format "tla make-archive %s %s" archive-name default-directory))
(shell-command-to-string
(format "tla my-default-archive %s" archive-name))))
((eq backend 'Mtn)
(let ((archive-name "foo.mtn"))
(shell-command-to-string
(format
"mtn db init --db=%s"
(expand-file-name archive-name default-directory)))
(shell-command-to-string
(format "mtn --db=%s --branch=foo setup ." archive-name))))
(t (vc-create-repo backend))))
(defmacro vc--fix-home-for-bzr (tempdir)
;; See the comment in `vc-bzr-test-bug9726'.
`(when (eq backend 'Bzr)
@ -718,28 +670,6 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(defvar vc-hg-global-switches)
(defmacro vc-test--with-author-identity (backend &rest body)
(declare (indent 1) (debug t))
`(let ((process-environment process-environment)
(vc-hg-global-switches vc-hg-global-switches))
;; git tries various approaches to guess a user name and email,
;; which can fail depending on how the system is configured.
;; Eg if the user account has no GECOS, git commit can fail with
;; status 128 "fatal: empty ident name".
(when (memq ,backend '(Bzr Git))
(push "EMAIL=joh.doe@example.com" process-environment))
(when (eq ,backend 'Git)
(setq process-environment (append '("GIT_AUTHOR_NAME=A"
"GIT_COMMITTER_NAME=C")
process-environment)))
;; Mercurial fails to autodetect an identity on MS-Windows.
(when (eq ,backend 'Hg)
(push "--config=ui.username=john@doe.ee" vc-hg-global-switches))
,@body))
(declare-function log-edit-done "vc/log-edit")
(defun vc-test--version-diff (backend)