summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2017-10-26 16:24:28 +0200
committerMichael Albinus <michael.albinus@gmx.de>2017-10-26 16:24:28 +0200
commit646e56e150ca08978d6ce736b12867b4958a0cd8 (patch)
tree8b4efabdad7c2dc939b1f6d835c42f1cf60fbf20
parent685fd779592db0019b8489a06d72ec4bebef3c9a (diff)
downloademacs-646e56e150ca08978d6ce736b12867b4958a0cd8.tar.gz
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.
-rw-r--r--lisp/net/tramp.el4
-rw-r--r--test/lisp/net/tramp-tests.el132
2 files changed, 115 insertions, 21 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 736c28c4aa8..e300b3a58ed 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7e644e6a2bb..af707f85007 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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]."