Fix Bug#28959

* lisp/net/tramp.el (tramp-handle-find-backup-file-name):
Use `tramp-tramp-file-p' rather than `tramp-file-name-p'.  Add
hop to backup file name.  (Bug#28959)

* test/lisp/net/tramp-tests.el (tramp-test34-find-backup-file-name):
New test.
(tramp-test35-make-nearby-temp-file)
(tramp-test36-special-characters)
(tramp-test36-special-characters-with-stat)
(tramp-test36-special-characters-with-perl)
(tramp-test36-special-characters-with-ls, tramp-test37-utf8)
(tramp-test37-utf8-with-stat, tramp-test37-utf8-with-perl)
(tramp-test37-utf8-with-ls, tramp-test38-file-system-info)
(tramp-test39-asynchronous-requests)
(tramp-test40-recursive-load, tramp-test41-remote-load-path)
(tramp-test42-delay-load, tramp-test43-unload): Rename.
This commit is contained in:
Michael Albinus 2017-10-26 16:24:28 +02:00
parent 685fd77959
commit 646e56e150
2 changed files with 115 additions and 21 deletions

View file

@ -3226,9 +3226,9 @@ User is always nil."
(car x) (car x)
(if (and (stringp (cdr x)) (if (and (stringp (cdr x))
(file-name-absolute-p (cdr x)) (file-name-absolute-p (cdr x))
(not (tramp-file-name-p (cdr x)))) (not (tramp-tramp-file-p (cdr x))))
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user domain host port (cdr x)) method user domain host port (cdr x) hop)
(cdr x)))) (cdr x))))
tramp-backup-directory-alist) tramp-backup-directory-alist)
backup-directory-alist))) backup-directory-alist)))

View file

@ -3638,8 +3638,103 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-directory tmp-name2 'recursive)))))) (ignore-errors (delete-directory tmp-name2 'recursive))))))
(ert-deftest tramp-test34-find-backup-file-name ()
"Check `find-backup-file-name'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
;; These settings are not used by Tramp, so we ignore them.
version-control delete-old-versions
(kept-old-versions (default-toplevel-value 'kept-old-versions))
(kept-new-versions (default-toplevel-value 'kept-new-versions)))
(unwind-protect
;; Use default `backup-directory-alist' mechanism.
(let (backup-directory-alist tramp-backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(format "%s~" (file-name-nondirectory tmp-name1))
tramp-test-temporary-file-directory)))))))
(unwind-protect
;; Map `backup-directory-alist'.
(let ((backup-directory-alist `(("." . ,tmp-name2)))
tramp-backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(format
"%s~"
;; This is taken from `make-backup-file-name-1'.
(subst-char-in-string
?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
tmp-name2)))))
;; The backup directory is created.
(should (file-directory-p tmp-name2)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
;; Map `tramp-backup-directory-alist'.
(let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(format
"%s~"
;; This is taken from `make-backup-file-name-1'.
(subst-char-in-string
?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
tmp-name2)))))
;; The backup directory is created.
(should (file-directory-p tmp-name2)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
;; Map `tramp-backup-directory-alist' with local file name.
(let ((tramp-backup-directory-alist
`(("." . ,(file-remote-p tmp-name2 'localname))))
backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(format
"%s~"
;; This is taken from `make-backup-file-name-1'.
(subst-char-in-string
?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
tmp-name2)))))
;; The backup directory is created.
(should (file-directory-p tmp-name2)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name2 'recursive))))))
;; The functions were introduced in Emacs 26.1. ;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test34-make-nearby-temp-file () (ert-deftest tramp-test35-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'." "Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; Since Emacs 26.1. ;; Since Emacs 26.1.
@ -3904,7 +3999,7 @@ This requires restrictions of file name syntax."
(ignore-errors (delete-directory tmp-name2 'recursive)))))) (ignore-errors (delete-directory tmp-name2 'recursive))))))
(defun tramp--test-special-characters () (defun tramp--test-special-characters ()
"Perform the test in `tramp-test35-special-characters*'." "Perform the test in `tramp-test36-special-characters*'."
;; Newlines, slashes and backslashes in file names are not ;; Newlines, slashes and backslashes in file names are not
;; supported. So we don't test. And we don't test the tab ;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is ;; character on Windows or Cygwin, because the backslash is
@ -3947,7 +4042,7 @@ This requires restrictions of file name syntax."
"{foo}bar{baz}")) "{foo}bar{baz}"))
;; These tests are inspired by Bug#17238. ;; These tests are inspired by Bug#17238.
(ert-deftest tramp-test35-special-characters () (ert-deftest tramp-test36-special-characters ()
"Check special characters in file names." "Check special characters in file names."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p))) (skip-unless (not (tramp--test-rsync-p)))
@ -3955,7 +4050,7 @@ This requires restrictions of file name syntax."
(tramp--test-special-characters)) (tramp--test-special-characters))
(ert-deftest tramp-test35-special-characters-with-stat () (ert-deftest tramp-test36-special-characters-with-stat ()
"Check special characters in file names. "Check special characters in file names.
Use the `stat' command." Use the `stat' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -3973,7 +4068,7 @@ Use the `stat' command."
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-special-characters))) (tramp--test-special-characters)))
(ert-deftest tramp-test35-special-characters-with-perl () (ert-deftest tramp-test36-special-characters-with-perl ()
"Check special characters in file names. "Check special characters in file names.
Use the `perl' command." Use the `perl' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -3994,7 +4089,7 @@ Use the `perl' command."
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-special-characters))) (tramp--test-special-characters)))
(ert-deftest tramp-test35-special-characters-with-ls () (ert-deftest tramp-test36-special-characters-with-ls ()
"Check special characters in file names. "Check special characters in file names.
Use the `ls' command." Use the `ls' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4017,7 +4112,7 @@ Use the `ls' command."
(tramp--test-special-characters))) (tramp--test-special-characters)))
(defun tramp--test-utf8 () (defun tramp--test-utf8 ()
"Perform the test in `tramp-test36-utf8*'." "Perform the test in `tramp-test37-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin) (let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list))) (memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8)) 'utf-8-hfs 'utf-8))
@ -4032,7 +4127,7 @@ Use the `ls' command."
"银河系漫游指南系列" "银河系漫游指南系列"
"Автостопом по гала́ктике"))) "Автостопом по гала́ктике")))
(ert-deftest tramp-test36-utf8 () (ert-deftest tramp-test37-utf8 ()
"Check UTF8 encoding in file names and file contents." "Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-docker-p)))
@ -4042,7 +4137,7 @@ Use the `ls' command."
(tramp--test-utf8)) (tramp--test-utf8))
(ert-deftest tramp-test36-utf8-with-stat () (ert-deftest tramp-test37-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `stat' command." Use the `stat' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4062,7 +4157,7 @@ Use the `stat' command."
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-utf8))) (tramp--test-utf8)))
(ert-deftest tramp-test36-utf8-with-perl () (ert-deftest tramp-test37-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `perl' command." Use the `perl' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4085,7 +4180,7 @@ Use the `perl' command."
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-utf8))) (tramp--test-utf8)))
(ert-deftest tramp-test36-utf8-with-ls () (ert-deftest tramp-test37-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `ls' command." Use the `ls' command."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4108,7 +4203,7 @@ Use the `ls' command."
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-utf8))) (tramp--test-utf8)))
(ert-deftest tramp-test37-file-system-info () (ert-deftest tramp-test38-file-system-info ()
"Check that `file-system-info' returns proper values." "Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; Since Emacs 27.1. ;; Since Emacs 27.1.
@ -4130,7 +4225,7 @@ Use the `ls' command."
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
;; This test is inspired by Bug#16928. ;; This test is inspired by Bug#16928.
(ert-deftest tramp-test38-asynchronous-requests () (ert-deftest tramp-test39-asynchronous-requests ()
"Check parallel asynchronous requests. "Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other." process sentinels. They shall not disturb each other."
@ -4287,7 +4382,7 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer)) (ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))) (ignore-errors (delete-directory tmp-name 'recursive)))))))
(ert-deftest tramp-test39-recursive-load () (ert-deftest tramp-test40-recursive-load ()
"Check that Tramp does not fail due to recursive load." "Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -4310,7 +4405,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))) (shell-quote-argument code))))))))
(ert-deftest tramp-test40-remote-load-path () (ert-deftest tramp-test41-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'." "Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the ;; It shall still work, when a remote file name is in the
@ -4333,7 +4428,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))) (shell-quote-argument code)))))))
(ert-deftest tramp-test41-delay-load () (ert-deftest tramp-test42-delay-load ()
"Check that Tramp is loaded lazily, only when needed." "Check that Tramp is loaded lazily, only when needed."
;; Tramp is neither loaded at Emacs startup, nor when completing a ;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
@ -4355,7 +4450,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))) (shell-quote-argument code)))))))
(ert-deftest tramp-test42-unload () (ert-deftest tramp-test43-unload ()
"Check that Tramp and its subpackages unload completely. "Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run." Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4408,7 +4503,6 @@ Since it unloads Tramp, it shall be the last test to run."
;; * file-acl ;; * file-acl
;; * file-name-case-insensitive-p ;; * file-name-case-insensitive-p
;; * file-selinux-context ;; * file-selinux-context
;; * find-backup-file-name
;; * set-file-acl ;; * set-file-acl
;; * set-file-selinux-context ;; * set-file-selinux-context
@ -4417,7 +4511,7 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably. ;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably.
;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'. ;; * Fix Bug#16928 in `tramp-test39-asynchronous-requests'.
(defun tramp-test-all (&optional interactive) (defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]." "Run all tests for \\[tramp]."