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.
This commit is contained in:
Michael Albinus 2017-11-29 09:37:42 +01:00
parent d670a15f25
commit 3dd25aeecb
5 changed files with 69 additions and 57 deletions

View file

@ -137,7 +137,7 @@ It is used for TCP/IP devices."
(file-readable-p . tramp-handle-file-exists-p) (file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p) (file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p) (file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . ignore) (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p) (file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-adb-handle-file-system-info) (file-system-info . tramp-adb-handle-file-system-info)
(file-truename . tramp-adb-handle-file-truename) (file-truename . tramp-adb-handle-file-truename)

View file

@ -517,7 +517,7 @@ Every entry is a list (NAME ADDRESS).")
(file-readable-p . tramp-gvfs-handle-file-readable-p) (file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p) (file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p) (file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . ignore) (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p) (file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-gvfs-handle-file-system-info) (file-system-info . tramp-gvfs-handle-file-system-info)
(file-truename . tramp-handle-file-truename) (file-truename . tramp-handle-file-truename)

View file

@ -253,7 +253,7 @@ See `tramp-actions-before-shell' for more info.")
(file-readable-p . tramp-handle-file-exists-p) (file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p) (file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p) (file-remote-p . tramp-handle-file-remote-p)
;; `file-selinux-context' performed by default handler. (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p) (file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-smb-handle-file-system-info) (file-system-info . tramp-smb-handle-file-system-info)
(file-truename . tramp-handle-file-truename) (file-truename . tramp-handle-file-truename)

View file

@ -2937,14 +2937,13 @@ User is always nil."
"Like `directory-file-name' for Tramp files." "Like `directory-file-name' for Tramp files."
;; If localname component of filename is "/", leave it unchanged. ;; If localname component of filename is "/", leave it unchanged.
;; Otherwise, remove any trailing slash from localname component. ;; Otherwise, remove any trailing slash from localname component.
;; Method, host, etc, are unchanged. Does it make sense to try ;; Method, host, etc, are unchanged.
;; to avoid parsing the filename? (while (with-parsed-tramp-file-name directory nil
(with-parsed-tramp-file-name directory nil (and (not (zerop (length localname)))
(if (and (not (zerop (length localname))) (eq (aref localname (1- (length localname))) ?/)
(eq (aref localname (1- (length localname))) ?/) (not (string= localname "/"))))
(not (string= localname "/"))) (setq directory (substring directory 0 -1)))
(substring directory 0 -1) directory)
directory)))
(defun tramp-handle-directory-files (directory &optional full match nosort) (defun tramp-handle-directory-files (directory &optional full match nosort)
"Like `directory-files' for Tramp files." "Like `directory-files' for Tramp files."
@ -3172,6 +3171,11 @@ User is always nil."
(t (tramp-make-tramp-file-name (t (tramp-make-tramp-file-name
method user domain host port "" hop))))))))) method user domain host port "" hop)))))))))
(defun tramp-handle-file-selinux-context (_filename)
"Like `file-selinux-context' for Tramp files."
;; Return nil context.
'(nil nil nil nil))
(defun tramp-handle-file-symlink-p (filename) (defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files." "Like `file-symlink-p' for Tramp files."
(let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))

View file

@ -1683,6 +1683,10 @@ This checks also `file-name-as-directory', `file-name-directory',
(string-equal (string-equal
(directory-file-name "/method:host:/path/to/file/") (directory-file-name "/method:host:/path/to/file/")
"/method:host:/path/to/file")) "/method:host:/path/to/file"))
(should
(string-equal
(directory-file-name "/method:host:/path/to/file//")
"/method:host:/path/to/file"))
(should (should
(string-equal (string-equal
(file-name-as-directory "/method:host:/path/to/file") (file-name-as-directory "/method:host:/path/to/file")
@ -2341,7 +2345,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; There might be a summary line. ;; There might be a summary line.
"\\(total.+[[:digit:]]+\n\\)?" "\\(total.+[[:digit:]]+\n\\)?"
;; We don't know in which order ".", ".." and "foo" appear. ;; We don't know in which order ".", ".." and "foo" appear.
"\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) (format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tmp-name1))
(length (directory-files tmp-name1))))))))
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))))) (ignore-errors (delete-directory tmp-name1 'recursive))))))
@ -4445,8 +4452,8 @@ Use the `ls' command."
;; Since Emacs 27.1. ;; Since Emacs 27.1.
(skip-unless (fboundp 'file-system-info)) (skip-unless (fboundp 'file-system-info))
;; `file-system-info' exists since Emacs 27. We don't ;; `file-system-info' exists since Emacs 27. We don't want to see
;; want to see compiler warnings for older Emacsen. ;; compiler warnings for older Emacsen.
(let ((fsi (with-no-warnings (let ((fsi (with-no-warnings
(file-system-info tramp-test-temporary-file-directory)))) (file-system-info tramp-test-temporary-file-directory))))
(skip-unless fsi) (skip-unless fsi)
@ -4611,22 +4618,50 @@ process sentinels. They shall not disturb each other."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-mock-p))) (skip-unless (not (tramp--test-mock-p)))
(let ((default-directory (expand-file-name temporary-file-directory))) (let ((default-directory (expand-file-name temporary-file-directory))
(let ((code (code
(format (format
"(message \"Tramp loaded: %%s\" (consp (file-attributes \"%s\")))" "(message \"Tramp loaded: %%s\" (consp (file-attributes %S)))"
tramp-test-temporary-file-directory))) tramp-test-temporary-file-directory)))
(should
(string-match
"Tramp loaded: t[\n\r]+"
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(expand-file-name invocation-name invocation-directory)
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(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
;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
(let ((default-directory (expand-file-name temporary-file-directory))
(code
"(progn \
(setq tramp-mode %s) \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo:\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1.
(dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil)))
(should (should
(string-match (string-match
"Tramp loaded: t[\n\r]+" (format
"Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
tm)
(shell-command-to-string (shell-command-to-string
(format (format
"%s -batch -Q -L %s --eval %s" "%s -batch -Q -L %s --eval %s"
(expand-file-name invocation-name invocation-directory) (expand-file-name invocation-name invocation-directory)
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))) (shell-quote-argument (format code tm)))))))))
(ert-deftest tramp-test43-recursive-load () (ert-deftest tramp-test42-recursive-load ()
"Check that Tramp does not fail due to recursive load." "Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -4649,7 +4684,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))) (shell-quote-argument code))))))))
(ert-deftest tramp-test44-remote-load-path () (ert-deftest tramp-test42-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'." "Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the ;; It shall still work, when a remote file name is in the
@ -4672,34 +4707,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ") (mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))) (shell-quote-argument code)))))))
(ert-deftest tramp-test45-delay-load () (ert-deftest tramp-test43-unload ()
"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
;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
(let ((code
"(progn \
(setq tramp-mode %s) \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo:\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1.
(dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil)))
(should
(string-match
(format
"Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
tm)
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(expand-file-name invocation-name invocation-directory)
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
(ert-deftest tramp-test46-unload ()
"Check that Tramp and its subpackages unload completely. "Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run." Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test) :tags '(:expensive-test)
@ -4745,6 +4753,12 @@ Since it unloads Tramp, it shall be the last test to run."
(ignore-errors (all-completions "tramp" (symbol-value x))) (ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))) (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."
(interactive "p")
(funcall
(if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
;; TODO: ;; TODO:
;; * dired-compress-file ;; * dired-compress-file
@ -4758,11 +4772,5 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably.
;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'.
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."
(interactive "p")
(funcall
(if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
(provide 'tramp-tests) (provide 'tramp-tests)
;;; tramp-tests.el ends here ;;; tramp-tests.el ends here