mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
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.
This commit is contained in:
Michael Albinus
parent
512f036404
commit
7aaf500701
8 changed files with 352 additions and 275 deletions
|
|
@ -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)))
|
||||
;; 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)))
|
||||
;; 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)))
|
||||
;; 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'."
|
||||
|
|
|
|||
|
|
@ -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:user@host:")
|
||||
: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 "/-:user@host#1234:" 'method) "default-method"))
|
||||
(should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
|
||||
(should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
|
||||
(should (string-equal
|
||||
(file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
|
||||
(should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
|
||||
(should (string-equal (file-remote-p "/-:user@host#1234:" '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:%s@%s:" "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 "/user@host:")
|
||||
: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/user@host]")
|
||||
: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 "/-:root@%s:" 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 "/-:root@%s:" 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"))
|
||||
|
||||
(let (process-environment)
|
||||
;; 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:/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") "/foo"))
|
||||
(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"))
|
||||
(substitute-in-file-name "/method:host:/path//foo") "/method:host:/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"))
|
||||
|
||||
(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"))
|
||||
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue