diff options
| author | Michael Albinus | 2019-06-04 12:51:45 +0200 |
|---|---|---|
| committer | Michael Albinus | 2019-06-04 12:51:45 +0200 |
| commit | 7aaf500701be3b51c686b7d86c9b505ef5fa9b8f (patch) | |
| tree | 14f8c65a362a3b9059d7dcbc127d96a4cf7e6df7 /test | |
| parent | 512f036404b559ae1e3456c05301104f5c422676 (diff) | |
| download | emacs-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.el | 168 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 393 |
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'. |
| 2043 | This checks also `file-name-as-directory', `file-name-directory', | 2091 | This 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 |