diff options
| author | Michael Albinus | 2017-10-26 16:24:28 +0200 |
|---|---|---|
| committer | Michael Albinus | 2017-10-26 16:24:28 +0200 |
| commit | 646e56e150ca08978d6ce736b12867b4958a0cd8 (patch) | |
| tree | 8b4efabdad7c2dc939b1f6d835c42f1cf60fbf20 | |
| parent | 685fd779592db0019b8489a06d72ec4bebef3c9a (diff) | |
| download | emacs-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.el | 4 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 132 |
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. |
| 3960 | Use the `stat' command." | 4055 | Use 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. |
| 3978 | Use the `perl' command." | 4073 | Use 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. |
| 3999 | Use the `ls' command." | 4094 | Use 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. |
| 4047 | Use the `stat' command." | 4142 | Use 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. |
| 4067 | Use the `perl' command." | 4162 | Use 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. |
| 4090 | Use the `ls' command." | 4185 | Use 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. |
| 4135 | Such requests could arrive from timers, process filters and | 4230 | Such requests could arrive from timers, process filters and |
| 4136 | process sentinels. They shall not disturb each other." | 4231 | process 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. |
| 4360 | Since it unloads Tramp, it shall be the last test to run." | 4455 | Since 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]." |