aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2017-11-29 09:37:42 +0100
committerMichael Albinus2017-11-29 09:37:42 +0100
commit3dd25aeecb157d562f8ab3c3abca9f3f89dec7ae (patch)
treec23d07dceba61d5b90e311360024425961a2a528
parentd670a15f254e2f077fa528b3e76d31d2ca415e69 (diff)
downloademacs-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.el2
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-smb.el2
-rw-r--r--lisp/net/tramp.el20
-rw-r--r--test/lisp/net/tramp-tests.el100
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.
4704Since it unloads Tramp, it shall be the last test to run." 4712Since 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