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:
parent
d670a15f25
commit
3dd25aeecb
5 changed files with 69 additions and 57 deletions
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 "/"))))
|
||||||
(substring directory 0 -1)
|
(setq directory (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))))
|
||||||
|
|
|
@ -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,10 +4618,10 @@ 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
|
(should
|
||||||
(string-match
|
(string-match
|
||||||
|
@ -4624,9 +4631,37 @@ process sentinels. They shall not disturb each other."
|
||||||
"%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 code)))))))
|
||||||
|
|
||||||
(ert-deftest tramp-test43-recursive-load ()
|
(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
|
||||||
|
(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-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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue