From 3dd25aeecb157d562f8ab3c3abca9f3f89dec7ae Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 29 Nov 2017 09:37:42 +0100 Subject: [PATCH] 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. --- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-gvfs.el | 2 +- lisp/net/tramp-smb.el | 2 +- lisp/net/tramp.el | 20 ++++--- 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." (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-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-system-info . tramp-adb-handle-file-system-info) (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).") (file-readable-p . tramp-gvfs-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-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-system-info . tramp-gvfs-handle-file-system-info) (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.") (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-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-system-info . tramp-smb-handle-file-system-info) (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." "Like `directory-file-name' for Tramp files." ;; If localname component of filename is "/", leave it unchanged. ;; Otherwise, remove any trailing slash from localname component. - ;; Method, host, etc, are unchanged. Does it make sense to try - ;; to avoid parsing the filename? - (with-parsed-tramp-file-name directory nil - (if (and (not (zerop (length localname))) - (eq (aref localname (1- (length localname))) ?/) - (not (string= localname "/"))) - (substring directory 0 -1) - directory))) + ;; Method, host, etc, are unchanged. + (while (with-parsed-tramp-file-name directory nil + (and (not (zerop (length localname))) + (eq (aref localname (1- (length localname))) ?/) + (not (string= localname "/")))) + (setq directory (substring directory 0 -1))) + directory) (defun tramp-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for Tramp files." @@ -3172,6 +3171,11 @@ User is always nil." (t (tramp-make-tramp-file-name 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) "Like `file-symlink-p' for Tramp files." (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 @@ -1683,6 +1683,10 @@ This checks also `file-name-as-directory', `file-name-directory', (string-equal (directory-file-name "/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 (string-equal (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. "\\(total.+[[:digit:]]+\n\\)?" ;; 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. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -4445,8 +4452,8 @@ Use the `ls' command." ;; Since Emacs 27.1. (skip-unless (fboundp 'file-system-info)) - ;; `file-system-info' exists since Emacs 27. We don't - ;; want to see compiler warnings for older Emacsen. + ;; `file-system-info' exists since Emacs 27. We don't want to see + ;; compiler warnings for older Emacsen. (let ((fsi (with-no-warnings (file-system-info tramp-test-temporary-file-directory)))) (skip-unless fsi) @@ -4611,22 +4618,50 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-mock-p))) - (let ((default-directory (expand-file-name temporary-file-directory))) - (let ((code - (format - "(message \"Tramp loaded: %%s\" (consp (file-attributes \"%s\")))" - tramp-test-temporary-file-directory))) + (let ((default-directory (expand-file-name temporary-file-directory)) + (code + (format + "(message \"Tramp loaded: %%s\" (consp (file-attributes %S)))" + 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 (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 (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)))))))) + (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." (skip-unless (tramp--test-enabled)) @@ -4649,7 +4684,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (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'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; 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 ") (shell-quote-argument code))))))) -(ert-deftest tramp-test45-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 ((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 () +(ert-deftest tramp-test43-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :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))) (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: ;; * 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 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) ;;; tramp-tests.el ends here -- 2.39.2