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.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index bf21db2e8d86d98974d4ddd2cddfea6cde051b6b..8399c02923d40eb734281c5041ec7ec58384ea4e 100644 (file)
--- 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 404af983b50693582435aa86bc5e17b33acdd6a6..fe5a98909e0e62b01385f457b5599b8d1ccdffef 100644 (file)
--- 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 f35c10b58abb362d5dab79ed6597f7d59c90eca9..eb0d6b50731a6dec237222f6f81f93b5c1a90769 100644 (file)
--- 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 13277ec6f34c630f02ec8ee0a4b43cfa33ad0ae3..6b0b1da6eb61e46a397403768abb085beb20bb17 100644 (file)
--- 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 2141f52cb208608cd0a39a59a6b769bc1b486bb6..8a551db778592d4383ecfcb8f2e4cd00df121d9d 100644 (file)
--- 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