aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2017-10-26 16:24:28 +0200
committerMichael Albinus2017-10-26 16:24:28 +0200
commit646e56e150ca08978d6ce736b12867b4958a0cd8 (patch)
tree8b4efabdad7c2dc939b1f6d835c42f1cf60fbf20
parent685fd779592db0019b8489a06d72ec4bebef3c9a (diff)
downloademacs-646e56e150ca08978d6ce736b12867b4958a0cd8.tar.gz
emacs-646e56e150ca08978d6ce736b12867b4958a0cd8.zip
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."
3226 (car x) 3226 (car x)
3227 (if (and (stringp (cdr x)) 3227 (if (and (stringp (cdr x))
3228 (file-name-absolute-p (cdr x)) 3228 (file-name-absolute-p (cdr x))
3229 (not (tramp-file-name-p (cdr x)))) 3229 (not (tramp-tramp-file-p (cdr x))))
3230 (tramp-make-tramp-file-name 3230 (tramp-make-tramp-file-name
3231 method user domain host port (cdr x)) 3231 method user domain host port (cdr x) hop)
3232 (cdr x)))) 3232 (cdr x))))
3233 tramp-backup-directory-alist) 3233 tramp-backup-directory-alist)
3234 backup-directory-alist))) 3234 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'."
3638 (ignore-errors (delete-file tmp-name1)) 3638 (ignore-errors (delete-file tmp-name1))
3639 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 3639 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3640 3640
3641(ert-deftest tramp-test34-find-backup-file-name ()
3642 "Check `find-backup-file-name'."
3643 (skip-unless (tramp--test-enabled))
3644
3645 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3646 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3647 (tmp-name2 (tramp--test-make-temp-name nil quoted))
3648 ;; These settings are not used by Tramp, so we ignore them.
3649 version-control delete-old-versions
3650 (kept-old-versions (default-toplevel-value 'kept-old-versions))
3651 (kept-new-versions (default-toplevel-value 'kept-new-versions)))
3652
3653 (unwind-protect
3654 ;; Use default `backup-directory-alist' mechanism.
3655 (let (backup-directory-alist tramp-backup-directory-alist)
3656 (should
3657 (equal
3658 (find-backup-file-name tmp-name1)
3659 (list
3660 (funcall
3661 (if quoted 'tramp-compat-file-name-quote 'identity)
3662 (expand-file-name
3663 (format "%s~" (file-name-nondirectory tmp-name1))
3664 tramp-test-temporary-file-directory)))))))
3665
3666 (unwind-protect
3667 ;; Map `backup-directory-alist'.
3668 (let ((backup-directory-alist `(("." . ,tmp-name2)))
3669 tramp-backup-directory-alist)
3670 (should
3671 (equal
3672 (find-backup-file-name tmp-name1)
3673 (list
3674 (funcall
3675 (if quoted 'tramp-compat-file-name-quote 'identity)
3676 (expand-file-name
3677 (format
3678 "%s~"
3679 ;; This is taken from `make-backup-file-name-1'.
3680 (subst-char-in-string
3681 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3682 tmp-name2)))))
3683 ;; The backup directory is created.
3684 (should (file-directory-p tmp-name2)))
3685
3686 ;; Cleanup.
3687 (ignore-errors (delete-directory tmp-name2 'recursive)))
3688
3689 (unwind-protect
3690 ;; Map `tramp-backup-directory-alist'.
3691 (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
3692 backup-directory-alist)
3693 (should
3694 (equal
3695 (find-backup-file-name tmp-name1)
3696 (list
3697 (funcall
3698 (if quoted 'tramp-compat-file-name-quote 'identity)
3699 (expand-file-name
3700 (format
3701 "%s~"
3702 ;; This is taken from `make-backup-file-name-1'.
3703 (subst-char-in-string
3704 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3705 tmp-name2)))))
3706 ;; The backup directory is created.
3707 (should (file-directory-p tmp-name2)))
3708
3709 ;; Cleanup.
3710 (ignore-errors (delete-directory tmp-name2 'recursive)))
3711
3712 (unwind-protect
3713 ;; Map `tramp-backup-directory-alist' with local file name.
3714 (let ((tramp-backup-directory-alist
3715 `(("." . ,(file-remote-p tmp-name2 'localname))))
3716 backup-directory-alist)
3717 (should
3718 (equal
3719 (find-backup-file-name tmp-name1)
3720 (list
3721 (funcall
3722 (if quoted 'tramp-compat-file-name-quote 'identity)
3723 (expand-file-name
3724 (format
3725 "%s~"
3726 ;; This is taken from `make-backup-file-name-1'.
3727 (subst-char-in-string
3728 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3729 tmp-name2)))))
3730 ;; The backup directory is created.
3731 (should (file-directory-p tmp-name2)))
3732
3733 ;; Cleanup.
3734 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3735
3641;; The functions were introduced in Emacs 26.1. 3736;; The functions were introduced in Emacs 26.1.
3642(ert-deftest tramp-test34-make-nearby-temp-file () 3737(ert-deftest tramp-test35-make-nearby-temp-file ()
3643 "Check `make-nearby-temp-file' and `temporary-file-directory'." 3738 "Check `make-nearby-temp-file' and `temporary-file-directory'."
3644 (skip-unless (tramp--test-enabled)) 3739 (skip-unless (tramp--test-enabled))
3645 ;; Since Emacs 26.1. 3740 ;; Since Emacs 26.1.
@@ -3904,7 +3999,7 @@ This requires restrictions of file name syntax."
3904 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 3999 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3905 4000
3906(defun tramp--test-special-characters () 4001(defun tramp--test-special-characters ()
3907 "Perform the test in `tramp-test35-special-characters*'." 4002 "Perform the test in `tramp-test36-special-characters*'."
3908 ;; Newlines, slashes and backslashes in file names are not 4003 ;; Newlines, slashes and backslashes in file names are not
3909 ;; supported. So we don't test. And we don't test the tab 4004 ;; supported. So we don't test. And we don't test the tab
3910 ;; character on Windows or Cygwin, because the backslash is 4005 ;; character on Windows or Cygwin, because the backslash is
@@ -3947,7 +4042,7 @@ This requires restrictions of file name syntax."
3947 "{foo}bar{baz}")) 4042 "{foo}bar{baz}"))
3948 4043
3949;; These tests are inspired by Bug#17238. 4044;; These tests are inspired by Bug#17238.
3950(ert-deftest tramp-test35-special-characters () 4045(ert-deftest tramp-test36-special-characters ()
3951 "Check special characters in file names." 4046 "Check special characters in file names."
3952 (skip-unless (tramp--test-enabled)) 4047 (skip-unless (tramp--test-enabled))
3953 (skip-unless (not (tramp--test-rsync-p))) 4048 (skip-unless (not (tramp--test-rsync-p)))
@@ -3955,7 +4050,7 @@ This requires restrictions of file name syntax."
3955 4050
3956 (tramp--test-special-characters)) 4051 (tramp--test-special-characters))
3957 4052
3958(ert-deftest tramp-test35-special-characters-with-stat () 4053(ert-deftest tramp-test36-special-characters-with-stat ()
3959 "Check special characters in file names. 4054 "Check special characters in file names.
3960Use the `stat' command." 4055Use the `stat' command."
3961 :tags '(:expensive-test) 4056 :tags '(:expensive-test)
@@ -3973,7 +4068,7 @@ Use the `stat' command."
3973 tramp-connection-properties))) 4068 tramp-connection-properties)))
3974 (tramp--test-special-characters))) 4069 (tramp--test-special-characters)))
3975 4070
3976(ert-deftest tramp-test35-special-characters-with-perl () 4071(ert-deftest tramp-test36-special-characters-with-perl ()
3977 "Check special characters in file names. 4072 "Check special characters in file names.
3978Use the `perl' command." 4073Use the `perl' command."
3979 :tags '(:expensive-test) 4074 :tags '(:expensive-test)
@@ -3994,7 +4089,7 @@ Use the `perl' command."
3994 tramp-connection-properties))) 4089 tramp-connection-properties)))
3995 (tramp--test-special-characters))) 4090 (tramp--test-special-characters)))
3996 4091
3997(ert-deftest tramp-test35-special-characters-with-ls () 4092(ert-deftest tramp-test36-special-characters-with-ls ()
3998 "Check special characters in file names. 4093 "Check special characters in file names.
3999Use the `ls' command." 4094Use the `ls' command."
4000 :tags '(:expensive-test) 4095 :tags '(:expensive-test)
@@ -4017,7 +4112,7 @@ Use the `ls' command."
4017 (tramp--test-special-characters))) 4112 (tramp--test-special-characters)))
4018 4113
4019(defun tramp--test-utf8 () 4114(defun tramp--test-utf8 ()
4020 "Perform the test in `tramp-test36-utf8*'." 4115 "Perform the test in `tramp-test37-utf8*'."
4021 (let* ((utf8 (if (and (eq system-type 'darwin) 4116 (let* ((utf8 (if (and (eq system-type 'darwin)
4022 (memq 'utf-8-hfs (coding-system-list))) 4117 (memq 'utf-8-hfs (coding-system-list)))
4023 'utf-8-hfs 'utf-8)) 4118 'utf-8-hfs 'utf-8))
@@ -4032,7 +4127,7 @@ Use the `ls' command."
4032 "银河系漫游指南系列" 4127 "银河系漫游指南系列"
4033 "Автостопом по гала́ктике"))) 4128 "Автостопом по гала́ктике")))
4034 4129
4035(ert-deftest tramp-test36-utf8 () 4130(ert-deftest tramp-test37-utf8 ()
4036 "Check UTF8 encoding in file names and file contents." 4131 "Check UTF8 encoding in file names and file contents."
4037 (skip-unless (tramp--test-enabled)) 4132 (skip-unless (tramp--test-enabled))
4038 (skip-unless (not (tramp--test-docker-p))) 4133 (skip-unless (not (tramp--test-docker-p)))
@@ -4042,7 +4137,7 @@ Use the `ls' command."
4042 4137
4043 (tramp--test-utf8)) 4138 (tramp--test-utf8))
4044 4139
4045(ert-deftest tramp-test36-utf8-with-stat () 4140(ert-deftest tramp-test37-utf8-with-stat ()
4046 "Check UTF8 encoding in file names and file contents. 4141 "Check UTF8 encoding in file names and file contents.
4047Use the `stat' command." 4142Use the `stat' command."
4048 :tags '(:expensive-test) 4143 :tags '(:expensive-test)
@@ -4062,7 +4157,7 @@ Use the `stat' command."
4062 tramp-connection-properties))) 4157 tramp-connection-properties)))
4063 (tramp--test-utf8))) 4158 (tramp--test-utf8)))
4064 4159
4065(ert-deftest tramp-test36-utf8-with-perl () 4160(ert-deftest tramp-test37-utf8-with-perl ()
4066 "Check UTF8 encoding in file names and file contents. 4161 "Check UTF8 encoding in file names and file contents.
4067Use the `perl' command." 4162Use the `perl' command."
4068 :tags '(:expensive-test) 4163 :tags '(:expensive-test)
@@ -4085,7 +4180,7 @@ Use the `perl' command."
4085 tramp-connection-properties))) 4180 tramp-connection-properties)))
4086 (tramp--test-utf8))) 4181 (tramp--test-utf8)))
4087 4182
4088(ert-deftest tramp-test36-utf8-with-ls () 4183(ert-deftest tramp-test37-utf8-with-ls ()
4089 "Check UTF8 encoding in file names and file contents. 4184 "Check UTF8 encoding in file names and file contents.
4090Use the `ls' command." 4185Use the `ls' command."
4091 :tags '(:expensive-test) 4186 :tags '(:expensive-test)
@@ -4108,7 +4203,7 @@ Use the `ls' command."
4108 tramp-connection-properties))) 4203 tramp-connection-properties)))
4109 (tramp--test-utf8))) 4204 (tramp--test-utf8)))
4110 4205
4111(ert-deftest tramp-test37-file-system-info () 4206(ert-deftest tramp-test38-file-system-info ()
4112 "Check that `file-system-info' returns proper values." 4207 "Check that `file-system-info' returns proper values."
4113 (skip-unless (tramp--test-enabled)) 4208 (skip-unless (tramp--test-enabled))
4114 ;; Since Emacs 27.1. 4209 ;; Since Emacs 27.1.
@@ -4130,7 +4225,7 @@ Use the `ls' command."
4130 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) 4225 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
4131 4226
4132;; This test is inspired by Bug#16928. 4227;; This test is inspired by Bug#16928.
4133(ert-deftest tramp-test38-asynchronous-requests () 4228(ert-deftest tramp-test39-asynchronous-requests ()
4134 "Check parallel asynchronous requests. 4229 "Check parallel asynchronous requests.
4135Such requests could arrive from timers, process filters and 4230Such requests could arrive from timers, process filters and
4136process sentinels. They shall not disturb each other." 4231process sentinels. They shall not disturb each other."
@@ -4287,7 +4382,7 @@ process sentinels. They shall not disturb each other."
4287 (ignore-errors (cancel-timer timer)) 4382 (ignore-errors (cancel-timer timer))
4288 (ignore-errors (delete-directory tmp-name 'recursive))))))) 4383 (ignore-errors (delete-directory tmp-name 'recursive)))))))
4289 4384
4290(ert-deftest tramp-test39-recursive-load () 4385(ert-deftest tramp-test40-recursive-load ()
4291 "Check that Tramp does not fail due to recursive load." 4386 "Check that Tramp does not fail due to recursive load."
4292 (skip-unless (tramp--test-enabled)) 4387 (skip-unless (tramp--test-enabled))
4293 4388
@@ -4310,7 +4405,7 @@ process sentinels. They shall not disturb each other."
4310 (mapconcat 'shell-quote-argument load-path " -L ") 4405 (mapconcat 'shell-quote-argument load-path " -L ")
4311 (shell-quote-argument code)))))))) 4406 (shell-quote-argument code))))))))
4312 4407
4313(ert-deftest tramp-test40-remote-load-path () 4408(ert-deftest tramp-test41-remote-load-path ()
4314 "Check that Tramp autoloads its packages with remote `load-path'." 4409 "Check that Tramp autoloads its packages with remote `load-path'."
4315 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. 4410 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
4316 ;; It shall still work, when a remote file name is in the 4411 ;; It shall still work, when a remote file name is in the
@@ -4333,7 +4428,7 @@ process sentinels. They shall not disturb each other."
4333 (mapconcat 'shell-quote-argument load-path " -L ") 4428 (mapconcat 'shell-quote-argument load-path " -L ")
4334 (shell-quote-argument code))))))) 4429 (shell-quote-argument code)))))))
4335 4430
4336(ert-deftest tramp-test41-delay-load () 4431(ert-deftest tramp-test42-delay-load ()
4337 "Check that Tramp is loaded lazily, only when needed." 4432 "Check that Tramp is loaded lazily, only when needed."
4338 ;; Tramp is neither loaded at Emacs startup, nor when completing a 4433 ;; Tramp is neither loaded at Emacs startup, nor when completing a
4339 ;; non-Tramp file name like "/foo". Completing a Tramp-alike file 4434 ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
@@ -4355,7 +4450,7 @@ process sentinels. They shall not disturb each other."
4355 (mapconcat 'shell-quote-argument load-path " -L ") 4450 (mapconcat 'shell-quote-argument load-path " -L ")
4356 (shell-quote-argument code))))))) 4451 (shell-quote-argument code)))))))
4357 4452
4358(ert-deftest tramp-test42-unload () 4453(ert-deftest tramp-test43-unload ()
4359 "Check that Tramp and its subpackages unload completely. 4454 "Check that Tramp and its subpackages unload completely.
4360Since it unloads Tramp, it shall be the last test to run." 4455Since it unloads Tramp, it shall be the last test to run."
4361 :tags '(:expensive-test) 4456 :tags '(:expensive-test)
@@ -4408,7 +4503,6 @@ Since it unloads Tramp, it shall be the last test to run."
4408;; * file-acl 4503;; * file-acl
4409;; * file-name-case-insensitive-p 4504;; * file-name-case-insensitive-p
4410;; * file-selinux-context 4505;; * file-selinux-context
4411;; * find-backup-file-name
4412;; * set-file-acl 4506;; * set-file-acl
4413;; * set-file-selinux-context 4507;; * set-file-selinux-context
4414 4508
@@ -4417,7 +4511,7 @@ Since it unloads Tramp, it shall be the last test to run."
4417;; * Fix `tramp-test06-directory-file-name' for `ftp'. 4511;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4418;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). 4512;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
4419;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably. 4513;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably.
4420;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'. 4514;; * Fix Bug#16928 in `tramp-test39-asynchronous-requests'.
4421 4515
4422(defun tramp-test-all (&optional interactive) 4516(defun tramp-test-all (&optional interactive)
4423 "Run all tests for \\[tramp]." 4517 "Run all tests for \\[tramp]."