mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 04:21:24 +00:00
Merge from origin/emacs-31
71ea4bbb6cvc-test-vc-dir-on-symlink: Use vc-test--with-author-identityb8fa2243eaFix M-RET in 'markdown-ts-in-table-mode-map'c244314974Fix recurrence of bug#80803 after changes in bug#80967
This commit is contained in:
commit
d7e7dd62ff
5 changed files with 168 additions and 85 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
100
test/lisp/vc/vc-tests/resources/vc-tests-helpers.el
Normal file
100
test/lisp/vc/vc-tests/resources/vc-tests-helpers.el
Normal 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)
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue