diff options
| author | Michael Albinus | 2017-11-29 09:37:42 +0100 |
|---|---|---|
| committer | Michael Albinus | 2017-11-29 09:37:42 +0100 |
| commit | 3dd25aeecb157d562f8ab3c3abca9f3f89dec7ae (patch) | |
| tree | c23d07dceba61d5b90e311360024425961a2a528 | |
| parent | d670a15f254e2f077fa528b3e76d31d2ca415e69 (diff) | |
| download | emacs-3dd25aeecb157d562f8ab3c3abca9f3f89dec7ae.tar.gz emacs-3dd25aeecb157d562f8ab3c3abca9f3f89dec7ae.zip | |
Some minor Tramp corrections
* lisp/net/tramp.el (tramp-handle-directory-file-name):
Handle several trailing slashes correctly.
(tramp-handle-file-selinux-context): New defun.
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
Use `tramp-handle-file-selinux-context'.
* test/lisp/net/tramp-tests.el (tramp-test06-directory-file-name):
Extend test.
(tramp-test17-insert-directory): Make check more robust.
(tramp-test42-auto-load): Combine several let forms.
(tramp-test42-delay-load, tramp-test42-recursive-load)
(tramp-test42-remote-load-path, tramp-test43-unload): Rename.
| -rw-r--r-- | lisp/net/tramp-adb.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 20 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 100 |
5 files changed, 69 insertions, 57 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index bf21db2e8d8..8399c02923d 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -137,7 +137,7 @@ It is used for TCP/IP devices." | |||
| 137 | (file-readable-p . tramp-handle-file-exists-p) | 137 | (file-readable-p . tramp-handle-file-exists-p) |
| 138 | (file-regular-p . tramp-handle-file-regular-p) | 138 | (file-regular-p . tramp-handle-file-regular-p) |
| 139 | (file-remote-p . tramp-handle-file-remote-p) | 139 | (file-remote-p . tramp-handle-file-remote-p) |
| 140 | (file-selinux-context . ignore) | 140 | (file-selinux-context . tramp-handle-file-selinux-context) |
| 141 | (file-symlink-p . tramp-handle-file-symlink-p) | 141 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 142 | (file-system-info . tramp-adb-handle-file-system-info) | 142 | (file-system-info . tramp-adb-handle-file-system-info) |
| 143 | (file-truename . tramp-adb-handle-file-truename) | 143 | (file-truename . tramp-adb-handle-file-truename) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 404af983b50..fe5a98909e0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -517,7 +517,7 @@ Every entry is a list (NAME ADDRESS).") | |||
| 517 | (file-readable-p . tramp-gvfs-handle-file-readable-p) | 517 | (file-readable-p . tramp-gvfs-handle-file-readable-p) |
| 518 | (file-regular-p . tramp-handle-file-regular-p) | 518 | (file-regular-p . tramp-handle-file-regular-p) |
| 519 | (file-remote-p . tramp-handle-file-remote-p) | 519 | (file-remote-p . tramp-handle-file-remote-p) |
| 520 | (file-selinux-context . ignore) | 520 | (file-selinux-context . tramp-handle-file-selinux-context) |
| 521 | (file-symlink-p . tramp-handle-file-symlink-p) | 521 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 522 | (file-system-info . tramp-gvfs-handle-file-system-info) | 522 | (file-system-info . tramp-gvfs-handle-file-system-info) |
| 523 | (file-truename . tramp-handle-file-truename) | 523 | (file-truename . tramp-handle-file-truename) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f35c10b58ab..eb0d6b50731 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -253,7 +253,7 @@ See `tramp-actions-before-shell' for more info.") | |||
| 253 | (file-readable-p . tramp-handle-file-exists-p) | 253 | (file-readable-p . tramp-handle-file-exists-p) |
| 254 | (file-regular-p . tramp-handle-file-regular-p) | 254 | (file-regular-p . tramp-handle-file-regular-p) |
| 255 | (file-remote-p . tramp-handle-file-remote-p) | 255 | (file-remote-p . tramp-handle-file-remote-p) |
| 256 | ;; `file-selinux-context' performed by default handler. | 256 | (file-selinux-context . tramp-handle-file-selinux-context) |
| 257 | (file-symlink-p . tramp-handle-file-symlink-p) | 257 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 258 | (file-system-info . tramp-smb-handle-file-system-info) | 258 | (file-system-info . tramp-smb-handle-file-system-info) |
| 259 | (file-truename . tramp-handle-file-truename) | 259 | (file-truename . tramp-handle-file-truename) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 13277ec6f34..6b0b1da6eb6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2937,14 +2937,13 @@ User is always nil." | |||
| 2937 | "Like `directory-file-name' for Tramp files." | 2937 | "Like `directory-file-name' for Tramp files." |
| 2938 | ;; If localname component of filename is "/", leave it unchanged. | 2938 | ;; If localname component of filename is "/", leave it unchanged. |
| 2939 | ;; Otherwise, remove any trailing slash from localname component. | 2939 | ;; Otherwise, remove any trailing slash from localname component. |
| 2940 | ;; Method, host, etc, are unchanged. Does it make sense to try | 2940 | ;; Method, host, etc, are unchanged. |
| 2941 | ;; to avoid parsing the filename? | 2941 | (while (with-parsed-tramp-file-name directory nil |
| 2942 | (with-parsed-tramp-file-name directory nil | 2942 | (and (not (zerop (length localname))) |
| 2943 | (if (and (not (zerop (length localname))) | 2943 | (eq (aref localname (1- (length localname))) ?/) |
| 2944 | (eq (aref localname (1- (length localname))) ?/) | 2944 | (not (string= localname "/")))) |
| 2945 | (not (string= localname "/"))) | 2945 | (setq directory (substring directory 0 -1))) |
| 2946 | (substring directory 0 -1) | 2946 | directory) |
| 2947 | directory))) | ||
| 2948 | 2947 | ||
| 2949 | (defun tramp-handle-directory-files (directory &optional full match nosort) | 2948 | (defun tramp-handle-directory-files (directory &optional full match nosort) |
| 2950 | "Like `directory-files' for Tramp files." | 2949 | "Like `directory-files' for Tramp files." |
| @@ -3172,6 +3171,11 @@ User is always nil." | |||
| 3172 | (t (tramp-make-tramp-file-name | 3171 | (t (tramp-make-tramp-file-name |
| 3173 | method user domain host port "" hop))))))))) | 3172 | method user domain host port "" hop))))))))) |
| 3174 | 3173 | ||
| 3174 | (defun tramp-handle-file-selinux-context (_filename) | ||
| 3175 | "Like `file-selinux-context' for Tramp files." | ||
| 3176 | ;; Return nil context. | ||
| 3177 | '(nil nil nil nil)) | ||
| 3178 | |||
| 3175 | (defun tramp-handle-file-symlink-p (filename) | 3179 | (defun tramp-handle-file-symlink-p (filename) |
| 3176 | "Like `file-symlink-p' for Tramp files." | 3180 | "Like `file-symlink-p' for Tramp files." |
| 3177 | (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) | 3181 | (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2141f52cb20..8a551db7785 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -1685,6 +1685,10 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 1685 | "/method:host:/path/to/file")) | 1685 | "/method:host:/path/to/file")) |
| 1686 | (should | 1686 | (should |
| 1687 | (string-equal | 1687 | (string-equal |
| 1688 | (directory-file-name "/method:host:/path/to/file//") | ||
| 1689 | "/method:host:/path/to/file")) | ||
| 1690 | (should | ||
| 1691 | (string-equal | ||
| 1688 | (file-name-as-directory "/method:host:/path/to/file") | 1692 | (file-name-as-directory "/method:host:/path/to/file") |
| 1689 | "/method:host:/path/to/file/")) | 1693 | "/method:host:/path/to/file/")) |
| 1690 | (should | 1694 | (should |
| @@ -2341,7 +2345,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 2341 | ;; There might be a summary line. | 2345 | ;; There might be a summary line. |
| 2342 | "\\(total.+[[:digit:]]+\n\\)?" | 2346 | "\\(total.+[[:digit:]]+\n\\)?" |
| 2343 | ;; We don't know in which order ".", ".." and "foo" appear. | 2347 | ;; We don't know in which order ".", ".." and "foo" appear. |
| 2344 | "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) | 2348 | (format |
| 2349 | "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" | ||
| 2350 | (regexp-opt (directory-files tmp-name1)) | ||
| 2351 | (length (directory-files tmp-name1)))))))) | ||
| 2345 | 2352 | ||
| 2346 | ;; Cleanup. | 2353 | ;; Cleanup. |
| 2347 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) | 2354 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) |
| @@ -4445,8 +4452,8 @@ Use the `ls' command." | |||
| 4445 | ;; Since Emacs 27.1. | 4452 | ;; Since Emacs 27.1. |
| 4446 | (skip-unless (fboundp 'file-system-info)) | 4453 | (skip-unless (fboundp 'file-system-info)) |
| 4447 | 4454 | ||
| 4448 | ;; `file-system-info' exists since Emacs 27. We don't | 4455 | ;; `file-system-info' exists since Emacs 27. We don't want to see |
| 4449 | ;; want to see compiler warnings for older Emacsen. | 4456 | ;; compiler warnings for older Emacsen. |
| 4450 | (let ((fsi (with-no-warnings | 4457 | (let ((fsi (with-no-warnings |
| 4451 | (file-system-info tramp-test-temporary-file-directory)))) | 4458 | (file-system-info tramp-test-temporary-file-directory)))) |
| 4452 | (skip-unless fsi) | 4459 | (skip-unless fsi) |
| @@ -4611,22 +4618,50 @@ process sentinels. They shall not disturb each other." | |||
| 4611 | (skip-unless (tramp--test-enabled)) | 4618 | (skip-unless (tramp--test-enabled)) |
| 4612 | (skip-unless (not (tramp--test-mock-p))) | 4619 | (skip-unless (not (tramp--test-mock-p))) |
| 4613 | 4620 | ||
| 4614 | (let ((default-directory (expand-file-name temporary-file-directory))) | 4621 | (let ((default-directory (expand-file-name temporary-file-directory)) |
| 4615 | (let ((code | 4622 | (code |
| 4616 | (format | 4623 | (format |
| 4617 | "(message \"Tramp loaded: %%s\" (consp (file-attributes \"%s\")))" | 4624 | "(message \"Tramp loaded: %%s\" (consp (file-attributes %S)))" |
| 4618 | tramp-test-temporary-file-directory))) | 4625 | tramp-test-temporary-file-directory))) |
| 4626 | (should | ||
| 4627 | (string-match | ||
| 4628 | "Tramp loaded: t[\n\r]+" | ||
| 4629 | (shell-command-to-string | ||
| 4630 | (format | ||
| 4631 | "%s -batch -Q -L %s --eval %s" | ||
| 4632 | (expand-file-name invocation-name invocation-directory) | ||
| 4633 | (mapconcat 'shell-quote-argument load-path " -L ") | ||
| 4634 | (shell-quote-argument code))))))) | ||
| 4635 | |||
| 4636 | (ert-deftest tramp-test42-delay-load () | ||
| 4637 | "Check that Tramp is loaded lazily, only when needed." | ||
| 4638 | ;; Tramp is neither loaded at Emacs startup, nor when completing a | ||
| 4639 | ;; non-Tramp file name like "/foo". Completing a Tramp-alike file | ||
| 4640 | ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t. | ||
| 4641 | (let ((default-directory (expand-file-name temporary-file-directory)) | ||
| 4642 | (code | ||
| 4643 | "(progn \ | ||
| 4644 | (setq tramp-mode %s) \ | ||
| 4645 | (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ | ||
| 4646 | (file-name-all-completions \"/foo\" \"/\") \ | ||
| 4647 | (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ | ||
| 4648 | (file-name-all-completions \"/foo:\" \"/\") \ | ||
| 4649 | (message \"Tramp loaded: %%s\" (featurep 'tramp)))")) | ||
| 4650 | ;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1. | ||
| 4651 | (dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil))) | ||
| 4619 | (should | 4652 | (should |
| 4620 | (string-match | 4653 | (string-match |
| 4621 | "Tramp loaded: t[\n\r]+" | 4654 | (format |
| 4655 | "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" | ||
| 4656 | tm) | ||
| 4622 | (shell-command-to-string | 4657 | (shell-command-to-string |
| 4623 | (format | 4658 | (format |
| 4624 | "%s -batch -Q -L %s --eval %s" | 4659 | "%s -batch -Q -L %s --eval %s" |
| 4625 | (expand-file-name invocation-name invocation-directory) | 4660 | (expand-file-name invocation-name invocation-directory) |
| 4626 | (mapconcat 'shell-quote-argument load-path " -L ") | 4661 | (mapconcat 'shell-quote-argument load-path " -L ") |
| 4627 | (shell-quote-argument code)))))))) | 4662 | (shell-quote-argument (format code tm))))))))) |
| 4628 | 4663 | ||
| 4629 | (ert-deftest tramp-test43-recursive-load () | 4664 | (ert-deftest tramp-test42-recursive-load () |
| 4630 | "Check that Tramp does not fail due to recursive load." | 4665 | "Check that Tramp does not fail due to recursive load." |
| 4631 | (skip-unless (tramp--test-enabled)) | 4666 | (skip-unless (tramp--test-enabled)) |
| 4632 | 4667 | ||
| @@ -4649,7 +4684,7 @@ process sentinels. They shall not disturb each other." | |||
| 4649 | (mapconcat 'shell-quote-argument load-path " -L ") | 4684 | (mapconcat 'shell-quote-argument load-path " -L ") |
| 4650 | (shell-quote-argument code)))))))) | 4685 | (shell-quote-argument code)))))))) |
| 4651 | 4686 | ||
| 4652 | (ert-deftest tramp-test44-remote-load-path () | 4687 | (ert-deftest tramp-test42-remote-load-path () |
| 4653 | "Check that Tramp autoloads its packages with remote `load-path'." | 4688 | "Check that Tramp autoloads its packages with remote `load-path'." |
| 4654 | ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. | 4689 | ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. |
| 4655 | ;; It shall still work, when a remote file name is in the | 4690 | ;; It shall still work, when a remote file name is in the |
| @@ -4672,34 +4707,7 @@ process sentinels. They shall not disturb each other." | |||
| 4672 | (mapconcat 'shell-quote-argument load-path " -L ") | 4707 | (mapconcat 'shell-quote-argument load-path " -L ") |
| 4673 | (shell-quote-argument code))))))) | 4708 | (shell-quote-argument code))))))) |
| 4674 | 4709 | ||
| 4675 | (ert-deftest tramp-test45-delay-load () | 4710 | (ert-deftest tramp-test43-unload () |
| 4676 | "Check that Tramp is loaded lazily, only when needed." | ||
| 4677 | ;; Tramp is neither loaded at Emacs startup, nor when completing a | ||
| 4678 | ;; non-Tramp file name like "/foo". Completing a Tramp-alike file | ||
| 4679 | ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t. | ||
| 4680 | (let ((code | ||
| 4681 | "(progn \ | ||
| 4682 | (setq tramp-mode %s) \ | ||
| 4683 | (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ | ||
| 4684 | (file-name-all-completions \"/foo\" \"/\") \ | ||
| 4685 | (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ | ||
| 4686 | (file-name-all-completions \"/foo:\" \"/\") \ | ||
| 4687 | (message \"Tramp loaded: %%s\" (featurep 'tramp)))")) | ||
| 4688 | ;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1. | ||
| 4689 | (dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil))) | ||
| 4690 | (should | ||
| 4691 | (string-match | ||
| 4692 | (format | ||
| 4693 | "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" | ||
| 4694 | tm) | ||
| 4695 | (shell-command-to-string | ||
| 4696 | (format | ||
| 4697 | "%s -batch -Q -L %s --eval %s" | ||
| 4698 | (expand-file-name invocation-name invocation-directory) | ||
| 4699 | (mapconcat 'shell-quote-argument load-path " -L ") | ||
| 4700 | (shell-quote-argument (format code tm))))))))) | ||
| 4701 | |||
| 4702 | (ert-deftest tramp-test46-unload () | ||
| 4703 | "Check that Tramp and its subpackages unload completely. | 4711 | "Check that Tramp and its subpackages unload completely. |
| 4704 | Since it unloads Tramp, it shall be the last test to run." | 4712 | Since it unloads Tramp, it shall be the last test to run." |
| 4705 | :tags '(:expensive-test) | 4713 | :tags '(:expensive-test) |
| @@ -4745,6 +4753,12 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 4745 | (ignore-errors (all-completions "tramp" (symbol-value x))) | 4753 | (ignore-errors (all-completions "tramp" (symbol-value x))) |
| 4746 | (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) | 4754 | (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) |
| 4747 | 4755 | ||
| 4756 | (defun tramp-test-all (&optional interactive) | ||
| 4757 | "Run all tests for \\[tramp]." | ||
| 4758 | (interactive "p") | ||
| 4759 | (funcall | ||
| 4760 | (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) | ||
| 4761 | |||
| 4748 | ;; TODO: | 4762 | ;; TODO: |
| 4749 | 4763 | ||
| 4750 | ;; * dired-compress-file | 4764 | ;; * dired-compress-file |
| @@ -4758,11 +4772,5 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 4758 | ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. | 4772 | ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. |
| 4759 | ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. | 4773 | ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. |
| 4760 | 4774 | ||
| 4761 | (defun tramp-test-all (&optional interactive) | ||
| 4762 | "Run all tests for \\[tramp]." | ||
| 4763 | (interactive "p") | ||
| 4764 | (funcall | ||
| 4765 | (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) | ||
| 4766 | |||
| 4767 | (provide 'tramp-tests) | 4775 | (provide 'tramp-tests) |
| 4768 | ;;; tramp-tests.el ends here | 4776 | ;;; tramp-tests.el ends here |