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)
(if (and (stringp (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
method user domain host port (cdr x))
method user domain host port (cdr x) hop)
(cdr x))))
tramp-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-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.
(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'."
(skip-unless (tramp--test-enabled))
;; Since Emacs 26.1.
@ -3904,7 +3999,7 @@ This requires restrictions of file name syntax."
(ignore-errors (delete-directory tmp-name2 'recursive))))))
(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
;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is
@ -3947,7 +4042,7 @@ This requires restrictions of file name syntax."
"{foo}bar{baz}"))
;; 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."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
@ -3955,7 +4050,7 @@ This requires restrictions of file name syntax."
(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.
Use the `stat' command."
:tags '(:expensive-test)
@ -3973,7 +4068,7 @@ Use the `stat' command."
tramp-connection-properties)))
(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.
Use the `perl' command."
:tags '(:expensive-test)
@ -3994,7 +4089,7 @@ Use the `perl' command."
tramp-connection-properties)))
(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.
Use the `ls' command."
:tags '(:expensive-test)
@ -4017,7 +4112,7 @@ Use the `ls' command."
(tramp--test-special-characters)))
(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)
(memq 'utf-8-hfs (coding-system-list)))
'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."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
@ -4042,7 +4137,7 @@ Use the `ls' command."
(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.
Use the `stat' command."
:tags '(:expensive-test)
@ -4062,7 +4157,7 @@ Use the `stat' command."
tramp-connection-properties)))
(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.
Use the `perl' command."
:tags '(:expensive-test)
@ -4085,7 +4180,7 @@ Use the `perl' command."
tramp-connection-properties)))
(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.
Use the `ls' command."
:tags '(:expensive-test)
@ -4108,7 +4203,7 @@ Use the `ls' command."
tramp-connection-properties)))
(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."
(skip-unless (tramp--test-enabled))
;; Since Emacs 27.1.
@ -4130,7 +4225,7 @@ Use the `ls' command."
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test38-asynchronous-requests ()
(ert-deftest tramp-test39-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
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 (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."
(skip-unless (tramp--test-enabled))
@ -4310,7 +4405,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(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'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; 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 ")
(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."
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; 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 ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test42-unload ()
(ert-deftest tramp-test43-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@ -4408,7 +4503,6 @@ Since it unloads Tramp, it shall be the last test to run."
;; * file-acl
;; * file-name-case-insensitive-p
;; * file-selinux-context
;; * find-backup-file-name
;; * set-file-acl
;; * 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-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * 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)
"Run all tests for \\[tramp]."