aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorMichael Albinus2019-06-04 12:51:45 +0200
committerMichael Albinus2019-06-04 12:51:45 +0200
commit7aaf500701be3b51c686b7d86c9b505ef5fa9b8f (patch)
tree14f8c65a362a3b9059d7dcbc127d96a4cf7e6df7 /test
parent512f036404b559ae1e3456c05301104f5c422676 (diff)
downloademacs-7aaf500701be3b51c686b7d86c9b505ef5fa9b8f.tar.gz
emacs-7aaf500701be3b51c686b7d86c9b505ef5fa9b8f.zip
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.
Diffstat (limited to 'test')
-rw-r--r--test/lisp/net/tramp-archive-tests.el168
-rw-r--r--test/lisp/net/tramp-tests.el393
2 files changed, 312 insertions, 249 deletions
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 454279e435e..02fe8edf271 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."
157 "Check archive file name components." 157 "Check archive file name components."
158 (skip-unless tramp-archive-enabled) 158 (skip-unless tramp-archive-enabled)
159 159
160 (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil 160 ;; Suppress method name check.
161 (should (string-equal method tramp-archive-method)) 161 (let ((non-essential t))
162 (should-not user) 162 (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
163 (should-not domain) 163 (should (string-equal method tramp-archive-method))
164 (should 164 (should-not user)
165 (string-equal 165 (should-not domain)
166 host 166 (should
167 (file-remote-p 167 (string-equal
168 (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) 168 host
169 (should 169 (file-remote-p
170 (string-equal 170 (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
171 host 171 (should
172 (url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) 172 (string-equal
173 (should-not port) 173 host
174 (should (string-equal localname "/")) 174 (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
175 (should (string-equal archive tramp-archive-test-file-archive))) 175 (should-not port)
176 176 (should (string-equal localname "/"))
177 ;; Localname. 177 (should (string-equal archive tramp-archive-test-file-archive)))
178 (with-parsed-tramp-archive-file-name 178
179 (concat tramp-archive-test-archive "foo") nil 179 ;; Localname.
180 (should (string-equal method tramp-archive-method)) 180 (with-parsed-tramp-archive-file-name
181 (should-not user) 181 (concat tramp-archive-test-archive "foo") nil
182 (should-not domain) 182 (should (string-equal method tramp-archive-method))
183 (should 183 (should-not user)
184 (string-equal 184 (should-not domain)
185 host 185 (should
186 (file-remote-p 186 (string-equal
187 (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) 187 host
188 (should 188 (file-remote-p
189 (string-equal 189 (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
190 host 190 (should
191 (url-hexify-string (concat "file://" tramp-archive-test-file-archive)))) 191 (string-equal
192 (should-not port) 192 host
193 (should (string-equal localname "/foo")) 193 (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
194 (should (string-equal archive tramp-archive-test-file-archive))) 194 (should-not port)
195 195 (should (string-equal localname "/foo"))
196 ;; File archive in file archive. 196 (should (string-equal archive tramp-archive-test-file-archive)))
197 (let* ((tramp-archive-test-file-archive 197
198 (concat tramp-archive-test-archive "baz.tar")) 198 ;; File archive in file archive.
199 (tramp-archive-test-archive 199 (let* ((tramp-archive-test-file-archive
200 (file-name-as-directory tramp-archive-test-file-archive)) 200 (concat tramp-archive-test-archive "baz.tar"))
201 (tramp-methods (cons `(,tramp-archive-method) tramp-methods)) 201 (tramp-archive-test-archive
202 (tramp-gvfs-methods tramp-archive-all-gvfs-methods)) 202 (file-name-as-directory tramp-archive-test-file-archive))
203 (unwind-protect 203 (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
204 (with-parsed-tramp-archive-file-name 204 (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
205 (expand-file-name "bar" tramp-archive-test-archive) nil 205 (unwind-protect
206 (should (string-equal method tramp-archive-method)) 206 (with-parsed-tramp-archive-file-name
207 (should-not user) 207 (expand-file-name "bar" tramp-archive-test-archive) nil
208 (should-not domain) 208 (should (string-equal method tramp-archive-method))
209 (should 209 (should-not user)
210 (string-equal 210 (should-not domain)
211 host 211 (should
212 (file-remote-p 212 (string-equal
213 (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host))) 213 host
214 ;; We reimplement the logic of tramp-archive.el here. Don't 214 (file-remote-p
215 ;; know, whether it is worth the test. 215 (tramp-archive-gvfs-file-name tramp-archive-test-archive)
216 (should 216 'host)))
217 (string-equal 217 ;; We reimplement the logic of tramp-archive.el here.
218 host 218 ;; Don't know, whether it is worth the test.
219 (url-hexify-string 219 (should
220 (concat 220 (string-equal
221 (tramp-gvfs-url-file-name 221 host
222 (tramp-make-tramp-file-name 222 (url-hexify-string
223 tramp-archive-method 223 (concat
224 ;; User and Domain. 224 (tramp-gvfs-url-file-name
225 nil nil 225 (tramp-make-tramp-file-name
226 ;; Host. 226 tramp-archive-method
227 (url-hexify-string 227 ;; User and Domain.
228 (concat 228 nil nil
229 "file://" 229 ;; Host.
230 ;; `directory-file-name' does not leave file archive 230 (url-hexify-string
231 ;; boundaries. So we must cut the trailing slash 231 (concat
232 ;; ourselves. 232 "file://"
233 (substring 233 ;; `directory-file-name' does not leave file
234 (file-name-directory tramp-archive-test-file-archive) 0 -1))) 234 ;; archive boundaries. So we must cut the
235 nil "/")) 235 ;; trailing slash ourselves.
236 (file-name-nondirectory tramp-archive-test-file-archive))))) 236 (substring
237 (should-not port) 237 (file-name-directory tramp-archive-test-file-archive)
238 (should (string-equal localname "/bar")) 238 0 -1)))
239 (should (string-equal archive tramp-archive-test-file-archive))) 239 nil "/"))
240 (file-name-nondirectory tramp-archive-test-file-archive)))))
241 (should-not port)
242 (should (string-equal localname "/bar"))
243 (should (string-equal archive tramp-archive-test-file-archive)))
240 244
241 ;; Cleanup. 245 ;; Cleanup.
242 (tramp-archive-cleanup-hash)))) 246 (tramp-archive-cleanup-hash)))))
243 247
244(ert-deftest tramp-archive-test05-expand-file-name () 248(ert-deftest tramp-archive-test05-expand-file-name ()
245 "Check `expand-file-name'." 249 "Check `expand-file-name'."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5fc37c1934f..38f9af230a3 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."
176 (let ((tramp--test-instrument-test-case-p t)) ,@body) 176 (let ((tramp--test-instrument-test-case-p t)) ,@body)
177 ;; Unwind forms. 177 ;; Unwind forms.
178 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) 178 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
179 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 179 (dolist (buf (tramp-list-tramp-buffers))
180 (with-current-buffer (tramp-get-connection-buffer v) 180 (message ";; %s" buf)
181 (message "%s" (buffer-string))) 181 (with-current-buffer buf
182 (with-current-buffer (tramp-get-debug-buffer v)
183 (message "%s" (buffer-string)))))))) 182 (message "%s" (buffer-string))))))))
184 183
185(defsubst tramp--test-message (fmt-string &rest arguments) 184(defsubst tramp--test-message (fmt-string &rest arguments)
@@ -412,15 +411,26 @@ properly. BODY shall not contain a timeout."
412 411
413(ert-deftest tramp-test02-file-name-dissect () 412(ert-deftest tramp-test02-file-name-dissect ()
414 "Check remote file name components." 413 "Check remote file name components."
414 ;; `user-error' has appeared in Emacs 24.3.
415 (skip-unless (fboundp 'user-error))
416
415 (let ((tramp-default-method "default-method") 417 (let ((tramp-default-method "default-method")
416 (tramp-default-user "default-user") 418 (tramp-default-user "default-user")
417 (tramp-default-host "default-host") 419 (tramp-default-host "default-host")
418 tramp-default-method-alist 420 tramp-default-method-alist
419 tramp-default-user-alist 421 tramp-default-user-alist
420 tramp-default-host-alist 422 tramp-default-host-alist
423 ;; Suppress method name check.
424 (non-essential t)
421 ;; Suppress check for multihops. 425 ;; Suppress check for multihops.
422 (tramp-cache-data (make-hash-table :test #'equal)) 426 (tramp-cache-data (make-hash-table :test #'equal))
423 (tramp-connection-properties '((nil "login-program" t)))) 427 (tramp-connection-properties '((nil "login-program" t))))
428 ;; An unknown method shall raise an error.
429 (let (non-essential)
430 (should-error
431 (expand-file-name "/method:user@host:")
432 :type 'user-error))
433
424 ;; Expand `tramp-default-user' and `tramp-default-host'. 434 ;; Expand `tramp-default-user' and `tramp-default-host'.
425 (should (string-equal 435 (should (string-equal
426 (file-remote-p "/method::") 436 (file-remote-p "/method::")
@@ -527,7 +537,8 @@ properly. BODY shall not contain a timeout."
527 (should (string-equal 537 (should (string-equal
528 (file-remote-p "/-:user@host#1234:" 'method) "default-method")) 538 (file-remote-p "/-:user@host#1234:" 'method) "default-method"))
529 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user")) 539 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
530 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234")) 540 (should (string-equal
541 (file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
531 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) "")) 542 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
532 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil)) 543 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
533 544
@@ -563,7 +574,8 @@ properly. BODY shall not contain a timeout."
563 (should (string-equal 574 (should (string-equal
564 (file-remote-p "/-:1.2.3.4:") 575 (file-remote-p "/-:1.2.3.4:")
565 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) 576 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
566 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method) "default-method")) 577 (should (string-equal
578 (file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
567 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user")) 579 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
568 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4")) 580 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
569 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) "")) 581 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
@@ -852,11 +864,16 @@ properly. BODY shall not contain a timeout."
852(ert-deftest tramp-test02-file-name-dissect-simplified () 864(ert-deftest tramp-test02-file-name-dissect-simplified ()
853 "Check simplified file name components." 865 "Check simplified file name components."
854 :tags '(:expensive-test) 866 :tags '(:expensive-test)
867 ;; `user-error' has appeared in Emacs 24.3.
868 (skip-unless (fboundp 'user-error))
869
855 (let ((tramp-default-method "default-method") 870 (let ((tramp-default-method "default-method")
856 (tramp-default-user "default-user") 871 (tramp-default-user "default-user")
857 (tramp-default-host "default-host") 872 (tramp-default-host "default-host")
858 tramp-default-user-alist 873 tramp-default-user-alist
859 tramp-default-host-alist 874 tramp-default-host-alist
875 ;; Suppress method name check.
876 (non-essential t)
860 ;; Suppress check for multihops. 877 ;; Suppress check for multihops.
861 (tramp-cache-data (make-hash-table :test #'equal)) 878 (tramp-cache-data (make-hash-table :test #'equal))
862 (tramp-connection-properties '((nil "login-program" t))) 879 (tramp-connection-properties '((nil "login-program" t)))
@@ -864,6 +881,12 @@ properly. BODY shall not contain a timeout."
864 (unwind-protect 881 (unwind-protect
865 (progn 882 (progn
866 (tramp-change-syntax 'simplified) 883 (tramp-change-syntax 'simplified)
884 ;; An unknown default method shall raise an error.
885 (let (non-essential)
886 (should-error
887 (expand-file-name "/user@host:")
888 :type 'user-error))
889
867 ;; Expand `tramp-default-method' and `tramp-default-user'. 890 ;; Expand `tramp-default-method' and `tramp-default-user'.
868 (should (string-equal 891 (should (string-equal
869 (file-remote-p "/host:") 892 (file-remote-p "/host:")
@@ -1175,12 +1198,17 @@ properly. BODY shall not contain a timeout."
1175(ert-deftest tramp-test02-file-name-dissect-separate () 1198(ert-deftest tramp-test02-file-name-dissect-separate ()
1176 "Check separate file name components." 1199 "Check separate file name components."
1177 :tags '(:expensive-test) 1200 :tags '(:expensive-test)
1201 ;; `user-error' has appeared in Emacs 24.3.
1202 (skip-unless (fboundp 'user-error))
1203
1178 (let ((tramp-default-method "default-method") 1204 (let ((tramp-default-method "default-method")
1179 (tramp-default-user "default-user") 1205 (tramp-default-user "default-user")
1180 (tramp-default-host "default-host") 1206 (tramp-default-host "default-host")
1181 tramp-default-method-alist 1207 tramp-default-method-alist
1182 tramp-default-user-alist 1208 tramp-default-user-alist
1183 tramp-default-host-alist 1209 tramp-default-host-alist
1210 ;; Suppress method name check.
1211 (non-essential t)
1184 ;; Suppress check for multihops. 1212 ;; Suppress check for multihops.
1185 (tramp-cache-data (make-hash-table :test #'equal)) 1213 (tramp-cache-data (make-hash-table :test #'equal))
1186 (tramp-connection-properties '((nil "login-program" t))) 1214 (tramp-connection-properties '((nil "login-program" t)))
@@ -1188,6 +1216,12 @@ properly. BODY shall not contain a timeout."
1188 (unwind-protect 1216 (unwind-protect
1189 (progn 1217 (progn
1190 (tramp-change-syntax 'separate) 1218 (tramp-change-syntax 'separate)
1219 ;; An unknown method shall raise an error.
1220 (let (non-essential)
1221 (should-error
1222 (expand-file-name "/[method/user@host]")
1223 :type 'user-error))
1224
1191 ;; Expand `tramp-default-user' and `tramp-default-host'. 1225 ;; Expand `tramp-default-user' and `tramp-default-host'.
1192 (should (string-equal 1226 (should (string-equal
1193 (file-remote-p "/[method/]") 1227 (file-remote-p "/[method/]")
@@ -1826,24 +1860,30 @@ properly. BODY shall not contain a timeout."
1826(ert-deftest tramp-test03-file-name-defaults () 1860(ert-deftest tramp-test03-file-name-defaults ()
1827 "Check default values for some methods." 1861 "Check default values for some methods."
1828 ;; Default values in tramp-adb.el. 1862 ;; Default values in tramp-adb.el.
1829 (should (string-equal (file-remote-p "/adb::" 'host) "")) 1863 (when (assoc "adb" tramp-methods)
1864 (should (string-equal (file-remote-p "/adb::" 'host) "")))
1830 ;; Default values in tramp-ftp.el. 1865 ;; Default values in tramp-ftp.el.
1831 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp")) 1866 (when (assoc "ftp" tramp-methods)
1832 (dolist (u '("ftp" "anonymous")) 1867 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
1833 (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))) 1868 (dolist (u '("ftp" "anonymous"))
1869 (should
1870 (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))))
1834 ;; Default values in tramp-sh.el and tramp-sudoedit.el. 1871 ;; Default values in tramp-sh.el and tramp-sudoedit.el.
1835 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) 1872 (when (assoc "su" tramp-methods)
1836 (should 1873 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1837 (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))) 1874 (should
1838 (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) 1875 (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
1839 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")) 1876 (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
1840 (should 1877 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
1841 (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))) 1878 (should
1842 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) 1879 (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
1843 (should 1880 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
1844 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) 1881 (should
1882 (string-equal
1883 (file-remote-p (format "/%s::" m) 'user) (user-login-name)))))
1845 ;; Default values in tramp-smb.el. 1884 ;; Default values in tramp-smb.el.
1846 (should (string-equal (file-remote-p "/smb::" 'user) nil))) 1885 (when (assoc "smb" tramp-methods)
1886 (should (string-equal (file-remote-p "/smb::" 'user) nil))))
1847 1887
1848;; The following test is inspired by Bug#30946. 1888;; The following test is inspired by Bug#30946.
1849(ert-deftest tramp-test03-file-name-host-rules () 1889(ert-deftest tramp-test03-file-name-host-rules ()
@@ -1898,121 +1938,129 @@ properly. BODY shall not contain a timeout."
1898 1938
1899(ert-deftest tramp-test04-substitute-in-file-name () 1939(ert-deftest tramp-test04-substitute-in-file-name ()
1900 "Check `substitute-in-file-name'." 1940 "Check `substitute-in-file-name'."
1901 (should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo")) 1941 ;; Suppress method name check.
1902 (should 1942 (let ((tramp-methods (cons '("method") tramp-methods)))
1903 (string-equal 1943 (should
1904 (substitute-in-file-name "/method:host://foo") "/method:host:/foo")) 1944 (string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
1905 (should 1945 (should
1906 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) 1946 (string-equal
1907 (should 1947 (substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
1908 (string-equal 1948 (should
1909 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) 1949 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1910 ;; Quoting local part. 1950 (should
1911 (should 1951 (string-equal
1912 (string-equal 1952 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1913 (substitute-in-file-name "/method:host:/:///foo") "/method:host:/:///foo")) 1953 ;; Quoting local part.
1914 (should 1954 (should
1915 (string-equal 1955 (string-equal
1916 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) 1956 (substitute-in-file-name "/method:host:/:///foo")
1917 (should 1957 "/method:host:/:///foo"))
1918 (string-equal 1958 (should
1919 (substitute-in-file-name "/method:host:/:/path///foo") 1959 (string-equal
1920 "/method:host:/:/path///foo")) 1960 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1921 (should 1961 (should
1922 (string-equal 1962 (string-equal
1923 (substitute-in-file-name "/method:host:/:/path//foo") 1963 (substitute-in-file-name "/method:host:/:/path///foo")
1924 "/method:host:/:/path//foo")) 1964 "/method:host:/:/path///foo"))
1925 1965 (should
1926 (should 1966 (string-equal
1927 (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo")) 1967 (substitute-in-file-name "/method:host:/:/path//foo")
1928 (should 1968 "/method:host:/:/path//foo"))
1929 (string-equal
1930 (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
1931 (should
1932 (string-equal (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
1933 ;; (substitute-in-file-name "/path/~foo") expands only for a local
1934 ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
1935 (should
1936 (string-equal
1937 (substitute-in-file-name
1938 "/method:host:/path/~foo") "/method:host:/path/~foo"))
1939 ;; Quoting local part.
1940 (should
1941 (string-equal
1942 (substitute-in-file-name "/method:host:/://~foo") "/method:host:/://~foo"))
1943 (should
1944 (string-equal
1945 (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
1946 (should
1947 (string-equal
1948 (substitute-in-file-name
1949 "/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
1950 (should
1951 (string-equal
1952 (substitute-in-file-name
1953 "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
1954 1969
1955 (let (process-environment) 1970 (should
1971 (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
1956 (should 1972 (should
1957 (string-equal 1973 (string-equal
1958 (substitute-in-file-name "/method:host:/path/$FOO") 1974 (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
1959 "/method:host:/path/$FOO"))
1960 (setenv "FOO" "bla")
1961 (should 1975 (should
1962 (string-equal 1976 (string-equal
1963 (substitute-in-file-name "/method:host:/path/$FOO") 1977 (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
1964 "/method:host:/path/bla")) 1978 ;; (substitute-in-file-name "/path/~foo") expands only for a local
1979 ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
1965 (should 1980 (should
1966 (string-equal 1981 (string-equal
1967 (substitute-in-file-name "/method:host:/path/$$FOO") 1982 (substitute-in-file-name
1968 "/method:host:/path/$FOO")) 1983 "/method:host:/path/~foo") "/method:host:/path/~foo"))
1969 ;; Quoting local part. 1984 ;; Quoting local part.
1970 (should 1985 (should
1971 (string-equal 1986 (string-equal
1972 (substitute-in-file-name "/method:host:/:/path/$FOO") 1987 (substitute-in-file-name "/method:host:/://~foo")
1973 "/method:host:/:/path/$FOO")) 1988 "/method:host:/://~foo"))
1974 (setenv "FOO" "bla")
1975 (should 1989 (should
1976 (string-equal 1990 (string-equal
1977 (substitute-in-file-name "/method:host:/:/path/$FOO") 1991 (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
1978 "/method:host:/:/path/$FOO"))
1979 (should 1992 (should
1980 (string-equal 1993 (string-equal
1981 (substitute-in-file-name "/method:host:/:/path/$$FOO") 1994 (substitute-in-file-name
1982 "/method:host:/:/path/$$FOO")))) 1995 "/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
1996 (should
1997 (string-equal
1998 (substitute-in-file-name
1999 "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
2000
2001 (let (process-environment)
2002 (should
2003 (string-equal
2004 (substitute-in-file-name "/method:host:/path/$FOO")
2005 "/method:host:/path/$FOO"))
2006 (setenv "FOO" "bla")
2007 (should
2008 (string-equal
2009 (substitute-in-file-name "/method:host:/path/$FOO")
2010 "/method:host:/path/bla"))
2011 (should
2012 (string-equal
2013 (substitute-in-file-name "/method:host:/path/$$FOO")
2014 "/method:host:/path/$FOO"))
2015 ;; Quoting local part.
2016 (should
2017 (string-equal
2018 (substitute-in-file-name "/method:host:/:/path/$FOO")
2019 "/method:host:/:/path/$FOO"))
2020 (setenv "FOO" "bla")
2021 (should
2022 (string-equal
2023 (substitute-in-file-name "/method:host:/:/path/$FOO")
2024 "/method:host:/:/path/$FOO"))
2025 (should
2026 (string-equal
2027 (substitute-in-file-name "/method:host:/:/path/$$FOO")
2028 "/method:host:/:/path/$$FOO")))))
1983 2029
1984(ert-deftest tramp-test05-expand-file-name () 2030(ert-deftest tramp-test05-expand-file-name ()
1985 "Check `expand-file-name'." 2031 "Check `expand-file-name'."
1986 (should 2032 ;; Suppress method name check.
1987 (string-equal 2033 (let ((tramp-methods (cons '("method") tramp-methods)))
1988 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) 2034 (should
1989 (should 2035 (string-equal
1990 (string-equal 2036 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1991 (expand-file-name "/method:host:/path/../file") "/method:host:/file")) 2037 (should
1992 (should 2038 (string-equal
1993 (string-equal 2039 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1994 (expand-file-name "/method:host:/path/.") "/method:host:/path")) 2040 (should
1995 (should 2041 (string-equal
1996 (string-equal 2042 (expand-file-name "/method:host:/path/.") "/method:host:/path"))
1997 (expand-file-name "/method:host:/path/..") "/method:host:/")) 2043 (should
1998 (should 2044 (string-equal
1999 (string-equal 2045 (expand-file-name "/method:host:/path/..") "/method:host:/"))
2000 (expand-file-name "." "/method:host:/path/") "/method:host:/path")) 2046 (should
2001 (should 2047 (string-equal
2002 (string-equal 2048 (expand-file-name "." "/method:host:/path/") "/method:host:/path"))
2003 (expand-file-name "" "/method:host:/path/") "/method:host:/path")) 2049 (should
2004 ;; Quoting local part. 2050 (string-equal
2005 (should 2051 (expand-file-name "" "/method:host:/path/") "/method:host:/path"))
2006 (string-equal 2052 ;; Quoting local part.
2007 (expand-file-name "/method:host:/:/path/./file") 2053 (should
2008 "/method:host:/:/path/file")) 2054 (string-equal
2009 (should 2055 (expand-file-name "/method:host:/:/path/./file")
2010 (string-equal 2056 "/method:host:/:/path/file"))
2011 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file")) 2057 (should
2012 (should 2058 (string-equal
2013 (string-equal 2059 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
2014 (expand-file-name "/method:host:/:/~/path/./file") 2060 (should
2015 "/method:host:/:/~/path/file"))) 2061 (string-equal
2062 (expand-file-name "/method:host:/:/~/path/./file")
2063 "/method:host:/:/~/path/file"))))
2016 2064
2017;; The following test is inspired by Bug#26911 and Bug#34834. They 2065;; The following test is inspired by Bug#26911 and Bug#34834. They
2018;; are rather bugs in `expand-file-name', and it fails for all Emacs 2066;; are rather bugs in `expand-file-name', and it fails for all Emacs
@@ -2042,48 +2090,51 @@ properly. BODY shall not contain a timeout."
2042 "Check `directory-file-name'. 2090 "Check `directory-file-name'.
2043This checks also `file-name-as-directory', `file-name-directory', 2091This checks also `file-name-as-directory', `file-name-directory',
2044`file-name-nondirectory' and `unhandled-file-name-directory'." 2092`file-name-nondirectory' and `unhandled-file-name-directory'."
2045 (should 2093 ;; Suppress method name check.
2046 (string-equal 2094 (let ((tramp-methods (cons '("method") tramp-methods)))
2047 (directory-file-name "/method:host:/path/to/file") 2095 (should
2048 "/method:host:/path/to/file")) 2096 (string-equal
2049 (should 2097 (directory-file-name "/method:host:/path/to/file")
2050 (string-equal 2098 "/method:host:/path/to/file"))
2051 (directory-file-name "/method:host:/path/to/file/") 2099 (should
2052 "/method:host:/path/to/file")) 2100 (string-equal
2053 (should 2101 (directory-file-name "/method:host:/path/to/file/")
2054 (string-equal 2102 "/method:host:/path/to/file"))
2055 (directory-file-name "/method:host:/path/to/file//") 2103 (should
2056 "/method:host:/path/to/file")) 2104 (string-equal
2057 (should 2105 (directory-file-name "/method:host:/path/to/file//")
2058 (string-equal 2106 "/method:host:/path/to/file"))
2059 (file-name-as-directory "/method:host:/path/to/file") 2107 (should
2060 "/method:host:/path/to/file/")) 2108 (string-equal
2061 (should 2109 (file-name-as-directory "/method:host:/path/to/file")
2062 (string-equal 2110 "/method:host:/path/to/file/"))
2063 (file-name-as-directory "/method:host:/path/to/file/") 2111 (should
2064 "/method:host:/path/to/file/")) 2112 (string-equal
2065 (should 2113 (file-name-as-directory "/method:host:/path/to/file/")
2066 (string-equal 2114 "/method:host:/path/to/file/"))
2067 (file-name-directory "/method:host:/path/to/file") 2115 (should
2068 "/method:host:/path/to/")) 2116 (string-equal
2069 (should 2117 (file-name-directory "/method:host:/path/to/file")
2070 (string-equal 2118 "/method:host:/path/to/"))
2071 (file-name-directory "/method:host:/path/to/file/") 2119 (should
2072 "/method:host:/path/to/file/")) 2120 (string-equal
2073 (should 2121 (file-name-directory "/method:host:/path/to/file/")
2074 (string-equal (file-name-directory "/method:host:file") "/method:host:")) 2122 "/method:host:/path/to/file/"))
2075 (should 2123 (should
2076 (string-equal 2124 (string-equal (file-name-directory "/method:host:file") "/method:host:"))
2077 (file-name-directory "/method:host:path/") "/method:host:path/")) 2125 (should
2078 (should 2126 (string-equal
2079 (string-equal 2127 (file-name-directory "/method:host:path/") "/method:host:path/"))
2080 (file-name-directory "/method:host:path/to") "/method:host:path/")) 2128 (should
2081 (should 2129 (string-equal
2082 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) 2130 (file-name-directory "/method:host:path/to") "/method:host:path/"))
2083 (should 2131 (should
2084 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) 2132 (string-equal
2085 (should-not 2133 (file-name-nondirectory "/method:host:/path/to/file") "file"))
2086 (unhandled-file-name-directory "/method:host:/path/to/file")) 2134 (should
2135 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
2136 (should-not
2137 (unhandled-file-name-directory "/method:host:/path/to/file")))
2087 2138
2088 ;; Bug#10085. 2139 ;; Bug#10085.
2089 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. 2140 (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'."
3968 ;; name handlers since Emacs 27. 4019 ;; name handlers since Emacs 27.
3969 (skip-unless (tramp--test-emacs27-p)) 4020 (skip-unless (tramp--test-emacs27-p))
3970 4021
3971 (tramp--test-instrument-test-case 0
3972 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 4022 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
3973 (let ((default-directory tramp-test-temporary-file-directory) 4023 (let ((default-directory tramp-test-temporary-file-directory)
3974 (tmp-name (tramp--test-make-temp-name nil quoted)) 4024 (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'."
4097 4147
4098 ;; Cleanup. 4148 ;; Cleanup.
4099 (ignore-errors (delete-process proc)) 4149 (ignore-errors (delete-process proc))
4100 (ignore-errors (kill-buffer stderr))))))))) 4150 (ignore-errors (kill-buffer stderr))))))))
4101 4151
4102(ert-deftest tramp-test31-interrupt-process () 4152(ert-deftest tramp-test31-interrupt-process ()
4103 "Check `interrupt-process'." 4153 "Check `interrupt-process'."
@@ -4107,7 +4157,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4107 ;; Since Emacs 26.1. 4157 ;; Since Emacs 26.1.
4108 (skip-unless (boundp 'interrupt-process-functions)) 4158 (skip-unless (boundp 'interrupt-process-functions))
4109 4159
4110 (let ((default-directory tramp-test-temporary-file-directory) 4160 ;; We must use `file-truename' for the temporary directory, in
4161 ;; order to establish the connection prior running an asynchronous
4162 ;; process.
4163 (let ((default-directory (file-truename tramp-test-temporary-file-directory))
4111 kill-buffer-query-functions proc) 4164 kill-buffer-query-functions proc)
4112 (unwind-protect 4165 (unwind-protect
4113 (with-temp-buffer 4166 (with-temp-buffer
@@ -4602,7 +4655,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4602 (skip-unless (tramp--test-sh-p)) 4655 (skip-unless (tramp--test-sh-p))
4603 4656
4604 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 4657 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
4605 (let* ((default-directory tramp-test-temporary-file-directory) 4658 ;; We must use `file-truename' for the temporary directory, in
4659 ;; order to establish the connection prior running an asynchronous
4660 ;; process.
4661 (let* ((default-directory
4662 (file-truename tramp-test-temporary-file-directory))
4606 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 4663 (tmp-name1 (tramp--test-make-temp-name nil quoted))
4607 (tmp-name2 (expand-file-name "foo" tmp-name1)) 4664 (tmp-name2 (expand-file-name "foo" tmp-name1))
4608 (tramp-remote-process-environment tramp-remote-process-environment) 4665 (tramp-remote-process-environment tramp-remote-process-environment)
@@ -5625,7 +5682,9 @@ process sentinels. They shall not disturb each other."
5625 (let ((default-directory (expand-file-name temporary-file-directory)) 5682 (let ((default-directory (expand-file-name temporary-file-directory))
5626 (code 5683 (code
5627 (format 5684 (format
5628 "(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t))" 5685 ;; Suppress method name check.
5686 "(let ((non-essential t)) \
5687 (message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
5629 tramp-test-temporary-file-directory))) 5688 tramp-test-temporary-file-directory)))
5630 (should 5689 (should
5631 (string-match 5690 (string-match
@@ -5804,9 +5863,9 @@ Since it unloads Tramp, it shall be the last test to run."
5804;; do not work properly for `nextcloud'. 5863;; do not work properly for `nextcloud'.
5805;; * Fix `tramp-test29-start-file-process' and 5864;; * Fix `tramp-test29-start-file-process' and
5806;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). 5865;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
5866;; * Implement `tramp-test31-interrupt-process' for `adb'.
5807;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks 5867;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks
5808;; like it is resolved now. Remove `:unstable' tag? 5868;; like it is resolved now. Remove `:unstable' tag?
5809;; * Implement `tramp-test31-interrupt-process' for `adb'.
5810 5869
5811(provide 'tramp-tests) 5870(provide 'tramp-tests)
5812;;; tramp-tests.el ends here 5871;;; tramp-tests.el ends here