[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 7aaf500: Stronger check for Tramp method
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 7aaf500: Stronger check for Tramp method |
|
Date: |
Tue, 4 Jun 2019 06:51:53 -0400 (EDT) |
branch: master
commit 7aaf500701be3b51c686b7d86c9b505ef5fa9b8f
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Stronger check for Tramp method
* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection):
Use `tramp-get-connection-name'.
* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link):
Don't check remote TARGET.
* lisp/net/tramp.el (tramp-dissect-file-name): Check for proper method.
(tramp-file-name-for-operation): Take only 2nd argument into
account for file name handler.
(tramp-file-name-handler): Suppress checks for `file-remote-p'.
* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test02-file-name-dissect): Suppress check for wrong
method.
* test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case):
Dump *all* Tramp buffers.
(tramp-test02-file-name-dissect)
(tramp-test02-file-name-dissect-simplified)
(tramp-test02-file-name-dissect-separate): Check also wrong method.
(tramp-test03-file-name-defaults): Check, that the respective
Tramp package is loaded.
(tramp-test04-substitute-in-file-name)
(tramp-test05-expand-file-name)
(tramp-test06-directory-file-name, tramp-test44-auto-load):
Suppress check for wrong method.
(tramp-test30-make-process): Remove instrumentation code.
(tramp-test31-interrupt-process, tramp-test36-vc-registered):
Guarantee that connection is established prior starting process.
---
lisp/net/tramp-gvfs.el | 2 +-
lisp/net/tramp-rclone.el | 2 +-
lisp/net/tramp-sh.el | 12 +-
lisp/net/tramp-smb.el | 12 +-
lisp/net/tramp-sudoedit.el | 14 +-
lisp/net/tramp.el | 22 +-
test/lisp/net/tramp-archive-tests.el | 168 +++++++--------
test/lisp/net/tramp-tests.el | 393 ++++++++++++++++++++---------------
8 files changed, 351 insertions(+), 274 deletions(-)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 3810231..17c2e79 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1765,7 +1765,7 @@ connection if a previous connection has died for some
reason."
;; better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process
- :name (tramp-buffer-name vec)
+ :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(process-put p 'vector vec)
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 0148116..9e99493 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -543,7 +543,7 @@ connection if a previous connection has died for some
reason."
;; we create a dummy process. Maybe there is a better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process
- :name (tramp-buffer-name vec)
+ :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(process-put p 'vector vec)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2d27baf..34fda5a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1027,11 +1027,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 9d15c05..84725db 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1161,11 +1161,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0d9e04d..f056e73 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -607,11 +607,13 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil
;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target))))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -780,7 +782,7 @@ connection if a previous connection has died for some
reason."
(throw 'non-essential 'non-essential))
(let ((p (make-network-process
- :name (tramp-buffer-name vec)
+ :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(process-put p 'vector vec)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a255818..f6dd6b5 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1435,6 +1435,12 @@ default values are used."
(setq v (make-tramp-file-name
:method method :user user :domain domain :host host
:port port :localname localname :hop hop))
+ ;; The method must be known.
+ (unless (or (tramp-completion-mode-p)
+ (string-equal method tramp-default-method-marker)
+ (assoc method tramp-methods))
+ (tramp-user-error
+ v "Method `%s' is not known." method))
;; Only some methods from tramp-sh.el do support multi-hops.
(when (and
hop
@@ -2175,17 +2181,16 @@ Must be handled by the callers."
(if (file-name-absolute-p (nth 0 args))
(nth 0 args)
default-directory))
+ ;; STRING FILE.
+ ;; Starting with Emacs 26.1, just the 2nd argument of
+ ;; `make-symbolic-link' matters.
+ ((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2.
((member operation
'(add-name-to-file copy-directory copy-file
file-equal-p file-in-directory-p
file-name-all-completions file-name-completion
- ;; Starting with Emacs 26.1, just the 2nd argument of
- ;; `make-symbolic-link' matters. For backward
- ;; compatibility, we still accept the first argument as
- ;; file name to be checked. Handled properly in
- ;; `tramp-handle-*-make-symbolic-link'.
- file-newer-than-file-p make-symbolic-link rename-file))
+ file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
@@ -2280,7 +2285,10 @@ preventing reentrant calls of Tramp.")
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
Falls back to normal file name handler if no Tramp file name handler exists."
- (let ((filename (apply #'tramp-file-name-for-operation operation args)))
+ (let ((filename (apply #'tramp-file-name-for-operation operation args))
+ ;; `file-remote-p' is called for everything, even for symbolic
+ ;; links which look remote. We don't want to get an error.
+ (non-essential (or non-essential (eq operation 'file-remote-p))))
(if (tramp-tramp-file-p filename)
(save-match-data
(setq filename (tramp-replace-environment-variables filename))
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 454279e..02fe8ed 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -157,89 +157,93 @@ variables, so we check the Emacs version directly."
"Check archive file name components."
(skip-unless tramp-archive-enabled)
- (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- (should
- (string-equal
- host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
- (should-not port)
- (should (string-equal localname "/"))
- (should (string-equal archive tramp-archive-test-file-archive)))
-
- ;; Localname.
- (with-parsed-tramp-archive-file-name
- (concat tramp-archive-test-archive "foo") nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- (should
- (string-equal
- host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
- (should-not port)
- (should (string-equal localname "/foo"))
- (should (string-equal archive tramp-archive-test-file-archive)))
-
- ;; File archive in file archive.
- (let* ((tramp-archive-test-file-archive
- (concat tramp-archive-test-archive "baz.tar"))
- (tramp-archive-test-archive
- (file-name-as-directory tramp-archive-test-file-archive))
- (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
- (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
- (unwind-protect
- (with-parsed-tramp-archive-file-name
- (expand-file-name "bar" tramp-archive-test-archive) nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- ;; We reimplement the logic of tramp-archive.el here. Don't
- ;; know, whether it is worth the test.
- (should
- (string-equal
- host
- (url-hexify-string
- (concat
- (tramp-gvfs-url-file-name
- (tramp-make-tramp-file-name
- tramp-archive-method
- ;; User and Domain.
- nil nil
- ;; Host.
- (url-hexify-string
- (concat
- "file://"
- ;; `directory-file-name' does not leave file archive
- ;; boundaries. So we must cut the trailing slash
- ;; ourselves.
- (substring
- (file-name-directory tramp-archive-test-file-archive) 0 -1)))
- nil "/"))
- (file-name-nondirectory tramp-archive-test-file-archive)))))
- (should-not port)
- (should (string-equal localname "/bar"))
- (should (string-equal archive tramp-archive-test-file-archive)))
+ ;; Suppress method name check.
+ (let ((non-essential t))
+ (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
+ (should (string-equal method tramp-archive-method))
+ (should-not user)
+ (should-not domain)
+ (should
+ (string-equal
+ host
+ (file-remote-p
+ (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
+ (should
+ (string-equal
+ host
+ (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (should-not port)
+ (should (string-equal localname "/"))
+ (should (string-equal archive tramp-archive-test-file-archive)))
+
+ ;; Localname.
+ (with-parsed-tramp-archive-file-name
+ (concat tramp-archive-test-archive "foo") nil
+ (should (string-equal method tramp-archive-method))
+ (should-not user)
+ (should-not domain)
+ (should
+ (string-equal
+ host
+ (file-remote-p
+ (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
+ (should
+ (string-equal
+ host
+ (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (should-not port)
+ (should (string-equal localname "/foo"))
+ (should (string-equal archive tramp-archive-test-file-archive)))
+
+ ;; File archive in file archive.
+ (let* ((tramp-archive-test-file-archive
+ (concat tramp-archive-test-archive "baz.tar"))
+ (tramp-archive-test-archive
+ (file-name-as-directory tramp-archive-test-file-archive))
+ (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
+ (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
+ (unwind-protect
+ (with-parsed-tramp-archive-file-name
+ (expand-file-name "bar" tramp-archive-test-archive) nil
+ (should (string-equal method tramp-archive-method))
+ (should-not user)
+ (should-not domain)
+ (should
+ (string-equal
+ host
+ (file-remote-p
+ (tramp-archive-gvfs-file-name tramp-archive-test-archive)
+ 'host)))
+ ;; We reimplement the logic of tramp-archive.el here.
+ ;; Don't know, whether it is worth the test.
+ (should
+ (string-equal
+ host
+ (url-hexify-string
+ (concat
+ (tramp-gvfs-url-file-name
+ (tramp-make-tramp-file-name
+ tramp-archive-method
+ ;; User and Domain.
+ nil nil
+ ;; Host.
+ (url-hexify-string
+ (concat
+ "file://"
+ ;; `directory-file-name' does not leave file
+ ;; archive boundaries. So we must cut the
+ ;; trailing slash ourselves.
+ (substring
+ (file-name-directory tramp-archive-test-file-archive)
+ 0 -1)))
+ nil "/"))
+ (file-name-nondirectory tramp-archive-test-file-archive)))))
+ (should-not port)
+ (should (string-equal localname "/bar"))
+ (should (string-equal archive tramp-archive-test-file-archive)))
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
+ ;; Cleanup.
+ (tramp-archive-cleanup-hash)))))
(ert-deftest tramp-archive-test05-expand-file-name ()
"Check `expand-file-name'."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5fc37c1..38f9af2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -176,10 +176,9 @@ properly. BODY shall not contain a timeout."
(let ((tramp--test-instrument-test-case-p t)) ,@body)
;; Unwind forms.
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose
3))
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (with-current-buffer (tramp-get-connection-buffer v)
- (message "%s" (buffer-string)))
- (with-current-buffer (tramp-get-debug-buffer v)
+ (dolist (buf (tramp-list-tramp-buffers))
+ (message ";; %s" buf)
+ (with-current-buffer buf
(message "%s" (buffer-string))))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
@@ -412,15 +411,26 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect ()
"Check remote file name components."
+ ;; `user-error' has appeared in Emacs 24.3.
+ (skip-unless (fboundp 'user-error))
+
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
+ ;; Suppress method name check.
+ (non-essential t)
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t))))
+ ;; An unknown method shall raise an error.
+ (let (non-essential)
+ (should-error
+ (expand-file-name "/method:address@hidden:")
+ :type 'user-error))
+
;; Expand `tramp-default-user' and `tramp-default-host'.
(should (string-equal
(file-remote-p "/method::")
@@ -527,7 +537,8 @@ properly. BODY shall not contain a timeout."
(should (string-equal
(file-remote-p "/-:address@hidden:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:address@hidden:" 'user) "user"))
- (should (string-equal (file-remote-p "/-:address@hidden:" 'host)
"host#1234"))
+ (should (string-equal
+ (file-remote-p "/-:address@hidden:" 'host) "host#1234"))
(should (string-equal (file-remote-p "/-:address@hidden:" 'localname) ""))
(should (string-equal (file-remote-p "/-:address@hidden:" 'hop) nil))
@@ -563,7 +574,8 @@ properly. BODY shall not contain a timeout."
(should (string-equal
(file-remote-p "/-:1.2.3.4:")
(format "/%s:address@hidden:" "default-method" "default-user"
"1.2.3.4")))
- (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method)
"default-method"))
+ (should (string-equal
+ (file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
@@ -852,11 +864,16 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect-simplified ()
"Check simplified file name components."
:tags '(:expensive-test)
+ ;; `user-error' has appeared in Emacs 24.3.
+ (skip-unless (fboundp 'user-error))
+
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-user-alist
tramp-default-host-alist
+ ;; Suppress method name check.
+ (non-essential t)
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))
@@ -864,6 +881,12 @@ properly. BODY shall not contain a timeout."
(unwind-protect
(progn
(tramp-change-syntax 'simplified)
+ ;; An unknown default method shall raise an error.
+ (let (non-essential)
+ (should-error
+ (expand-file-name "/address@hidden:")
+ :type 'user-error))
+
;; Expand `tramp-default-method' and `tramp-default-user'.
(should (string-equal
(file-remote-p "/host:")
@@ -1175,12 +1198,17 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test02-file-name-dissect-separate ()
"Check separate file name components."
:tags '(:expensive-test)
+ ;; `user-error' has appeared in Emacs 24.3.
+ (skip-unless (fboundp 'user-error))
+
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
+ ;; Suppress method name check.
+ (non-essential t)
;; Suppress check for multihops.
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))
@@ -1188,6 +1216,12 @@ properly. BODY shall not contain a timeout."
(unwind-protect
(progn
(tramp-change-syntax 'separate)
+ ;; An unknown method shall raise an error.
+ (let (non-essential)
+ (should-error
+ (expand-file-name "/[method/address@hidden")
+ :type 'user-error))
+
;; Expand `tramp-default-user' and `tramp-default-host'.
(should (string-equal
(file-remote-p "/[method/]")
@@ -1826,24 +1860,30 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test03-file-name-defaults ()
"Check default values for some methods."
;; Default values in tramp-adb.el.
- (should (string-equal (file-remote-p "/adb::" 'host) ""))
+ (when (assoc "adb" tramp-methods)
+ (should (string-equal (file-remote-p "/adb::" 'host) "")))
;; Default values in tramp-ftp.el.
- (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
- (dolist (u '("ftp" "anonymous"))
- (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))
+ (when (assoc "ftp" tramp-methods)
+ (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
+ (dolist (u '("ftp" "anonymous"))
+ (should
+ (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))))
;; Default values in tramp-sh.el and tramp-sudoedit.el.
- (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
- (should
- (string-equal (file-remote-p (format "/-:address@hidden:" h) 'method)
"su")))
- (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
- (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
- (should
- (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
- (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
- (should
- (string-equal (file-remote-p (format "/%s::" m) 'user)
(user-login-name))))
+ (when (assoc "su" tramp-methods)
+ (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
+ (should
+ (string-equal (file-remote-p (format "/-:address@hidden:" h) 'method)
"su")))
+ (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
+ (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
+ (should
+ (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
+ (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
+ (should
+ (string-equal
+ (file-remote-p (format "/%s::" m) 'user) (user-login-name)))))
;; Default values in tramp-smb.el.
- (should (string-equal (file-remote-p "/smb::" 'user) nil)))
+ (when (assoc "smb" tramp-methods)
+ (should (string-equal (file-remote-p "/smb::" 'user) nil))))
;; The following test is inspired by Bug#30946.
(ert-deftest tramp-test03-file-name-host-rules ()
@@ -1898,121 +1938,129 @@ properly. BODY shall not contain a timeout."
(ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'."
- (should (string-equal (substitute-in-file-name "/method:host:///foo")
"/foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
- (should
- (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
- ;; Quoting local part.
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/:///foo") "/method:host:/:///foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/:/path///foo")
- "/method:host:/:/path///foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/:/path//foo")
- "/method:host:/:/path//foo"))
-
- (should
- (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
- (should
- (string-equal (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
- ;; (substitute-in-file-name "/path/~foo") expands only for a local
- ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
- (should
- (string-equal
- (substitute-in-file-name
- "/method:host:/path/~foo") "/method:host:/path/~foo"))
- ;; Quoting local part.
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/://~foo") "/method:host:/://~foo"))
- (should
- (string-equal
- (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
- (should
- (string-equal
- (substitute-in-file-name
- "/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
- (should
- (string-equal
- (substitute-in-file-name
- "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
+ ;; Suppress method name check.
+ (let ((tramp-methods (cons '("method") tramp-methods)))
+ (should
+ (string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
+ (should
+ (string-equal (substitute-in-file-name "/method:host:/path///foo")
"/foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
+ ;; Quoting local part.
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:///foo")
+ "/method:host:/:///foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:/path///foo")
+ "/method:host:/:/path///foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:/path//foo")
+ "/method:host:/:/path//foo"))
- (let (process-environment)
+ (should
+ (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
(should
(string-equal
- (substitute-in-file-name "/method:host:/path/$FOO")
- "/method:host:/path/$FOO"))
- (setenv "FOO" "bla")
+ (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
(should
(string-equal
- (substitute-in-file-name "/method:host:/path/$FOO")
- "/method:host:/path/bla"))
+ (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
+ ;; (substitute-in-file-name "/path/~foo") expands only for a local
+ ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should
(string-equal
- (substitute-in-file-name "/method:host:/path/$$FOO")
- "/method:host:/path/$FOO"))
+ (substitute-in-file-name
+ "/method:host:/path/~foo") "/method:host:/path/~foo"))
;; Quoting local part.
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path/$FOO")
- "/method:host:/:/path/$FOO"))
- (setenv "FOO" "bla")
+ (substitute-in-file-name "/method:host:/://~foo")
+ "/method:host:/://~foo"))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path/$FOO")
- "/method:host:/:/path/$FOO"))
+ (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path/$$FOO")
- "/method:host:/:/path/$$FOO"))))
+ (substitute-in-file-name
+ "/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name
+ "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
+
+ (let (process-environment)
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$FOO")
+ "/method:host:/path/$FOO"))
+ (setenv "FOO" "bla")
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$FOO")
+ "/method:host:/path/bla"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$$FOO")
+ "/method:host:/path/$FOO"))
+ ;; Quoting local part.
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:/path/$FOO")
+ "/method:host:/:/path/$FOO"))
+ (setenv "FOO" "bla")
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:/path/$FOO")
+ "/method:host:/:/path/$FOO"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/:/path/$$FOO")
+ "/method:host:/:/path/$$FOO")))))
(ert-deftest tramp-test05-expand-file-name ()
"Check `expand-file-name'."
- (should
- (string-equal
- (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
- (should
- (string-equal
- (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
- (should
- (string-equal
- (expand-file-name "/method:host:/path/.") "/method:host:/path"))
- (should
- (string-equal
- (expand-file-name "/method:host:/path/..") "/method:host:/"))
- (should
- (string-equal
- (expand-file-name "." "/method:host:/path/") "/method:host:/path"))
- (should
- (string-equal
- (expand-file-name "" "/method:host:/path/") "/method:host:/path"))
- ;; Quoting local part.
- (should
- (string-equal
- (expand-file-name "/method:host:/:/path/./file")
- "/method:host:/:/path/file"))
- (should
- (string-equal
- (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
- (should
- (string-equal
- (expand-file-name "/method:host:/:/~/path/./file")
- "/method:host:/:/~/path/file")))
+ ;; Suppress method name check.
+ (let ((tramp-methods (cons '("method") tramp-methods)))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/./file")
"/method:host:/path/file"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/.") "/method:host:/path"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/..") "/method:host:/"))
+ (should
+ (string-equal
+ (expand-file-name "." "/method:host:/path/") "/method:host:/path"))
+ (should
+ (string-equal
+ (expand-file-name "" "/method:host:/path/") "/method:host:/path"))
+ ;; Quoting local part.
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/:/path/./file")
+ "/method:host:/:/path/file"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/:/path/../file")
"/method:host:/:/file"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/:/~/path/./file")
+ "/method:host:/:/~/path/file"))))
;; The following test is inspired by Bug#26911 and Bug#34834. They
;; are rather bugs in `expand-file-name', and it fails for all Emacs
@@ -2042,48 +2090,51 @@ properly. BODY shall not contain a timeout."
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
`file-name-nondirectory' and `unhandled-file-name-directory'."
- (should
- (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
- (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")
- "/method:host:/path/to/file/"))
- (should
- (string-equal
- (file-name-as-directory "/method:host:/path/to/file/")
- "/method:host:/path/to/file/"))
- (should
- (string-equal
- (file-name-directory "/method:host:/path/to/file")
- "/method:host:/path/to/"))
- (should
- (string-equal
- (file-name-directory "/method:host:/path/to/file/")
- "/method:host:/path/to/file/"))
- (should
- (string-equal (file-name-directory "/method:host:file") "/method:host:"))
- (should
- (string-equal
- (file-name-directory "/method:host:path/") "/method:host:path/"))
- (should
- (string-equal
- (file-name-directory "/method:host:path/to") "/method:host:path/"))
- (should
- (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
- (should
- (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
- (should-not
- (unhandled-file-name-directory "/method:host:/path/to/file"))
+ ;; Suppress method name check.
+ (let ((tramp-methods (cons '("method") tramp-methods)))
+ (should
+ (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
+ (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")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal
+ (file-name-as-directory "/method:host:/path/to/file/")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:/path/to/file")
+ "/method:host:/path/to/"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:/path/to/file/")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal (file-name-directory "/method:host:file") "/method:host:"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:path/") "/method:host:path/"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:path/to") "/method:host:path/"))
+ (should
+ (string-equal
+ (file-name-nondirectory "/method:host:/path/to/file") "file"))
+ (should
+ (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
+ (should-not
+ (unhandled-file-name-directory "/method:host:/path/to/file")))
;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
@@ -3968,7 +4019,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
- (tramp--test-instrument-test-case 0
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
@@ -4097,7 +4147,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc))
- (ignore-errors (kill-buffer stderr)))))))))
+ (ignore-errors (kill-buffer stderr))))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
@@ -4107,7 +4157,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Since Emacs 26.1.
(skip-unless (boundp 'interrupt-process-functions))
- (let ((default-directory tramp-test-temporary-file-directory)
+ ;; We must use `file-truename' for the temporary directory, in
+ ;; order to establish the connection prior running an asynchronous
+ ;; process.
+ (let ((default-directory (file-truename tramp-test-temporary-file-directory))
kill-buffer-query-functions proc)
(unwind-protect
(with-temp-buffer
@@ -4602,7 +4655,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(skip-unless (tramp--test-sh-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let* ((default-directory tramp-test-temporary-file-directory)
+ ;; We must use `file-truename' for the temporary directory, in
+ ;; order to establish the connection prior running an asynchronous
+ ;; process.
+ (let* ((default-directory
+ (file-truename tramp-test-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tramp-remote-process-environment tramp-remote-process-environment)
@@ -5625,7 +5682,9 @@ process sentinels. They shall not disturb each other."
(let ((default-directory (expand-file-name temporary-file-directory))
(code
(format
- "(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t))"
+ ;; Suppress method name check.
+ "(let ((non-essential t)) \
+ (message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
tramp-test-temporary-file-directory)))
(should
(string-match
@@ -5804,9 +5863,9 @@ Since it unloads Tramp, it shall be the last test to run."
;; do not work properly for `nextcloud'.
;; * Fix `tramp-test29-start-file-process' and
;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
+;; * Implement `tramp-test31-interrupt-process' for `adb'.
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks
;; like it is resolved now. Remove `:unstable' tag?
-;; * Implement `tramp-test31-interrupt-process' for `adb'.
(provide 'tramp-tests)
;;; tramp-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 7aaf500: Stronger check for Tramp method,
Michael Albinus <=