1 ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `https://www.gnu.org/licenses/'.
22 ;; The tests require a recent ert.el from Emacs 24.4.
24 ;; Some of the tests require access to a remote host files. Since
25 ;; this could be problematic, a mock-up connection method "mock" is
26 ;; used. Emulating a remote connection, it simply calls "sh -i".
27 ;; Tramp's file name handlers still run, so this test is sufficient
28 ;; except for connection establishing.
30 ;; If you want to test a real Tramp connection, set
31 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
32 ;; overwrite the default value. If you want to skip tests accessing a
33 ;; remote host, set this environment variable to "/dev/null" or
34 ;; whatever is appropriate on your system.
36 ;; For slow remote connections, `tramp-test41-asynchronous-requests'
37 ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
38 ;; value less than 10 could help.
40 ;; A whole test run can be performed calling the command `tramp-test-all'.
53 (declare-function tramp-find-executable
"tramp-sh")
54 (declare-function tramp-get-remote-path
"tramp-sh")
55 (declare-function tramp-get-remote-stat
"tramp-sh")
56 (declare-function tramp-get-remote-perl
"tramp-sh")
57 (defvar auto-save-file-name-transforms
)
58 (defvar tramp-copy-size-limit
)
59 (defvar tramp-persistency-file-name
)
60 (defvar tramp-remote-process-environment
)
62 ;; Beautify batch mode.
64 ;; Suppress nasty messages.
65 (fset 'shell-command-sentinel
'ignore
)
66 ;; We do not want to be interrupted.
67 (eval-after-load 'tramp-gvfs
68 '(fset 'tramp-gvfs-handler-askquestion
69 (lambda (_message _choices
) '(t nil
0)))))
71 ;; There is no default value on w32 systems, which could work out of the box.
72 (defconst tramp-test-temporary-file-directory
74 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
75 ((eq system-type
'windows-nt
) null-device
)
79 (tramp-login-program "sh")
80 (tramp-login-args (("-i")))
81 (tramp-remote-shell "/bin/sh")
82 (tramp-remote-shell-args ("-c"))
83 (tramp-connection-timeout 10)))
85 'tramp-default-host-alist
86 `("\\`mock\\'" nil
,(system-name)))
87 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
88 ;; batch mode only, therefore.
89 (unless (and (null noninteractive
) (file-directory-p "~/"))
90 (setenv "HOME" temporary-file-directory
))
91 (format "/mock::%s" temporary-file-directory
)))
92 "Temporary directory for Tramp tests.")
94 (setq password-cache-expiry nil
96 tramp-cache-read-persistent-data t
;; For auth-sources.
97 tramp-copy-size-limit nil
98 tramp-message-show-message nil
99 tramp-persistency-file-name nil
)
101 ;; This should happen on hydra only.
102 (when (getenv "EMACS_HYDRA_CI")
103 (add-to-list 'tramp-remote-path
'tramp-own-remote-path
))
105 (defvar tramp--test-enabled-checked nil
106 "Cached result of `tramp--test-enabled'.
107 If the function did run, the value is a cons cell, the `cdr'
110 (defun tramp--test-enabled ()
111 "Whether remote file access is enabled."
112 (unless (consp tramp--test-enabled-checked
)
114 tramp--test-enabled-checked
118 (file-remote-p tramp-test-temporary-file-directory
)
119 (file-directory-p tramp-test-temporary-file-directory
)
120 (file-writable-p tramp-test-temporary-file-directory
))))))
122 (when (cdr tramp--test-enabled-checked
)
123 ;; Cleanup connection.
125 (tramp-cleanup-connection
126 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
127 nil
'keep-password
)))
130 (cdr tramp--test-enabled-checked
))
132 (defsubst tramp--test-expensive-test
()
133 "Whether expensive tests are run."
135 (ert--stats-selector ert--current-run-stats
)
136 (list (make-ert-test :name
(ert-test-name (ert-running-test))
137 :body nil
:tags
'(:expensive-test
)))))
139 (defun tramp--test-make-temp-name (&optional local quoted
)
140 "Return a temporary file name for test.
141 If LOCAL is non-nil, a local file name is returned.
142 If QUOTED is non-nil, the local part of the file name is quoted.
143 The temporary file is not created."
145 (if quoted
'tramp-compat-file-name-quote
'identity
)
147 (make-temp-name "tramp-test")
148 (if local temporary-file-directory tramp-test-temporary-file-directory
))))
150 ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
151 (defvar tramp--test-instrument-test-case-p nil
152 "Whether `tramp--test-instrument-test-case' run.
153 This shall used dynamically bound only.")
155 (defmacro tramp--test-instrument-test-case
(verbose &rest body
)
156 "Run BODY with `tramp-verbose' equal VERBOSE.
157 Print the content of the Tramp debug buffer, if BODY does not
158 eval properly in `should' or `should-not'. `should-error' is not
159 handled properly. BODY shall not contain a timeout."
160 (declare (indent 1) (debug (natnump body
)))
161 `(let ((tramp-verbose (max (or ,verbose
0) (or tramp-verbose
0)))
162 (tramp-message-show-message t
)
163 (tramp-debug-on-error t
)
164 (debug-ignored-errors
165 (cons "^make-symbolic-link not supported$" debug-ignored-errors
))
168 (let ((tramp--test-instrument-test-case-p t
)) ,@body
)
170 (when (and (null tramp--test-instrument-test-case-p
) (> tramp-verbose
3))
171 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
172 (with-current-buffer (tramp-get-connection-buffer v
)
173 (message "%s" (buffer-string)))
174 (with-current-buffer (tramp-get-debug-buffer v
)
175 (message "%s" (buffer-string))))))))
177 (defsubst tramp--test-message
(fmt-string &rest arguments
)
178 "Emit a message into ERT *Messages*."
179 (tramp--test-instrument-test-case 0
182 (tramp-dissect-file-name tramp-test-temporary-file-directory
) 0
183 fmt-string arguments
)))
185 (defsubst tramp--test-backtrace
()
186 "Dump a backtrace into ERT *Messages*."
187 (tramp--test-instrument-test-case 10
189 (tramp-dissect-file-name tramp-test-temporary-file-directory
))))
191 (defmacro tramp--test-print-duration
(message &rest body
)
192 "Run BODY and print a message with duration, prompted by MESSAGE."
193 (declare (indent 1) (debug (stringp body
)))
194 `(let ((start (current-time)))
199 ,message
(float-time (time-subtract (current-time) start
))))))
201 (ert-deftest tramp-test00-availability
()
202 "Test availability of Tramp functions."
203 :expected-result
(if (tramp--test-enabled) :passed
:failed
)
205 "Remote directory: `%s'" tramp-test-temporary-file-directory
)
206 (should (ignore-errors
208 (file-remote-p tramp-test-temporary-file-directory
)
209 (file-directory-p tramp-test-temporary-file-directory
)
210 (file-writable-p tramp-test-temporary-file-directory
)))))
212 (ert-deftest tramp-test01-file-name-syntax
()
213 "Check remote file name syntax."
215 (should (tramp-tramp-file-p "/method::"))
216 (should (tramp-tramp-file-p "/method:host:"))
217 (should (tramp-tramp-file-p "/method:user@:"))
218 (should (tramp-tramp-file-p "/method:user@host:"))
219 (should (tramp-tramp-file-p "/method:user@email@host:"))
222 (should (tramp-tramp-file-p "/method:host#1234:"))
223 (should (tramp-tramp-file-p "/method:user@host#1234:"))
225 ;; Using an IPv4 address.
226 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
227 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
229 ;; Using an IPv6 address.
230 (should (tramp-tramp-file-p "/method:[::1]:"))
231 (should (tramp-tramp-file-p "/method:user@[::1]:"))
233 ;; Local file name part.
234 (should (tramp-tramp-file-p "/method:::"))
235 (should (tramp-tramp-file-p "/method::/:"))
236 (should (tramp-tramp-file-p "/method::/path/to/file"))
237 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
238 (should (tramp-tramp-file-p "/method::file"))
239 (should (tramp-tramp-file-p "/method::/:file"))
242 (should (tramp-tramp-file-p "/method1:|method2::"))
243 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
244 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
245 (should (tramp-tramp-file-p
246 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
249 (should-not (tramp-tramp-file-p nil
))
250 (should-not (tramp-tramp-file-p 'symbol
))
252 (should-not (tramp-tramp-file-p "/host:"))
253 (should-not (tramp-tramp-file-p "/user@host:"))
254 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
255 (should-not (tramp-tramp-file-p "/[]:"))
256 (should-not (tramp-tramp-file-p "/[::1]:"))
257 (should-not (tramp-tramp-file-p "/host:/:"))
258 (should-not (tramp-tramp-file-p "/host1|host2:"))
259 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
260 ;; Quote with "/:" suppresses file name handlers.
261 (should-not (tramp-tramp-file-p "/::"))
262 (should-not (tramp-tramp-file-p "/:@:"))
263 (should-not (tramp-tramp-file-p "/:[]:"))
264 ;; Methods shall be at least two characters on MS Windows, except
265 ;; the default method.
266 (let ((system-type 'windows-nt
))
267 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
268 (should-not (tramp-tramp-file-p "/c::/path/to/file"))
269 (should (tramp-tramp-file-p "/-::/path/to/file")))
270 (let ((system-type 'gnu
/linux
))
271 (should (tramp-tramp-file-p "/-:h:/path/to/file"))
272 (should (tramp-tramp-file-p "/m::/path/to/file"))))
274 (ert-deftest tramp-test01-file-name-syntax-simplified
()
275 "Check simplified file name syntax."
276 :tags
'(:expensive-test
)
277 (let ((syntax tramp-syntax
))
280 (tramp-change-syntax 'simplified
)
282 (should (tramp-tramp-file-p "/host:"))
283 (should (tramp-tramp-file-p "/user@:"))
284 (should (tramp-tramp-file-p "/user@host:"))
285 (should (tramp-tramp-file-p "/user@email@host:"))
288 (should (tramp-tramp-file-p "/host#1234:"))
289 (should (tramp-tramp-file-p "/user@host#1234:"))
291 ;; Using an IPv4 address.
292 (should (tramp-tramp-file-p "/1.2.3.4:"))
293 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
295 ;; Using an IPv6 address.
296 (should (tramp-tramp-file-p "/[::1]:"))
297 (should (tramp-tramp-file-p "/user@[::1]:"))
299 ;; Local file name part.
300 (should (tramp-tramp-file-p "/host::"))
301 (should (tramp-tramp-file-p "/host:/:"))
302 (should (tramp-tramp-file-p "/host:/path/to/file"))
303 (should (tramp-tramp-file-p "/host:/:/path/to/file"))
304 (should (tramp-tramp-file-p "/host:file"))
305 (should (tramp-tramp-file-p "/host:/:file"))
308 (should (tramp-tramp-file-p "/host1|host2:"))
309 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
310 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
313 (should-not (tramp-tramp-file-p nil
))
314 (should-not (tramp-tramp-file-p 'symbol
))
315 ;; Quote with "/:" suppresses file name handlers.
316 (should-not (tramp-tramp-file-p "/::"))
317 (should-not (tramp-tramp-file-p "/:@:"))
318 (should-not (tramp-tramp-file-p "/:[]:")))
321 (tramp-change-syntax syntax
))))
323 (ert-deftest tramp-test01-file-name-syntax-separate
()
324 "Check separate file name syntax."
325 :tags
'(:expensive-test
)
326 (let ((syntax tramp-syntax
))
329 (tramp-change-syntax 'separate
)
331 (should (tramp-tramp-file-p "/[method/]"))
332 (should (tramp-tramp-file-p "/[method/host]"))
333 (should (tramp-tramp-file-p "/[method/user@]"))
334 (should (tramp-tramp-file-p "/[method/user@host]"))
335 (should (tramp-tramp-file-p "/[method/user@email@host]"))
338 (should (tramp-tramp-file-p "/[method/host#1234]"))
339 (should (tramp-tramp-file-p "/[method/user@host#1234]"))
341 ;; Using an IPv4 address.
342 (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
343 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
345 ;; Using an IPv6 address.
346 (should (tramp-tramp-file-p "/[method/::1]"))
347 (should (tramp-tramp-file-p "/[method/user@::1]"))
349 ;; Local file name part.
350 (should (tramp-tramp-file-p "/[method/]"))
351 (should (tramp-tramp-file-p "/[method/]/:"))
352 (should (tramp-tramp-file-p "/[method/]/path/to/file"))
353 (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
354 (should (tramp-tramp-file-p "/[method/]file"))
355 (should (tramp-tramp-file-p "/[method/]/:file"))
358 (should (tramp-tramp-file-p "/[method1/|method2/]"))
359 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
362 "/[method1/user1@host1|method2/user2@host2]"))
365 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
368 (should-not (tramp-tramp-file-p nil
))
369 (should-not (tramp-tramp-file-p 'symbol
))
371 (should-not (tramp-tramp-file-p "/host:"))
372 (should-not (tramp-tramp-file-p "/user@host:"))
373 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
374 (should-not (tramp-tramp-file-p "/host:/:"))
375 (should-not (tramp-tramp-file-p "/host1|host2:"))
376 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
377 ;; Quote with "/:" suppresses file name handlers.
378 (should-not (tramp-tramp-file-p "/:[]")))
381 (tramp-change-syntax syntax
))))
383 (ert-deftest tramp-test02-file-name-dissect
()
384 "Check remote file name components."
385 (let ((tramp-default-method "default-method")
386 (tramp-default-user "default-user")
387 (tramp-default-host "default-host")
388 tramp-default-method-alist
389 tramp-default-user-alist
390 tramp-default-host-alist
)
391 ;; Expand `tramp-default-user' and `tramp-default-host'.
392 (should (string-equal
393 (file-remote-p "/method::")
394 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
395 (should (string-equal (file-remote-p "/method::" 'method
) "method"))
396 (should (string-equal (file-remote-p "/method::" 'user
) "default-user"))
397 (should (string-equal (file-remote-p "/method::" 'host
) "default-host"))
398 (should (string-equal (file-remote-p "/method::" 'localname
) ""))
399 (should (string-equal (file-remote-p "/method::" 'hop
) nil
))
401 ;; Expand `tramp-default-method' and `tramp-default-user'.
402 (should (string-equal
403 (file-remote-p "/-:host:")
404 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
405 (should (string-equal (file-remote-p "/-:host:" 'method
) "default-method"))
406 (should (string-equal (file-remote-p "/-:host:" 'user
) "default-user"))
407 (should (string-equal (file-remote-p "/-:host:" 'host
) "host"))
408 (should (string-equal (file-remote-p "/-:host:" 'localname
) ""))
409 (should (string-equal (file-remote-p "/-:host:" 'hop
) nil
))
411 ;; Expand `tramp-default-method' and `tramp-default-host'.
412 (should (string-equal
413 (file-remote-p "/-:user@:")
414 (format "/%s:%s@%s:" "default-method" "user" "default-host")))
415 (should (string-equal (file-remote-p "/-:user@:" 'method
) "default-method"))
416 (should (string-equal (file-remote-p "/-:user@:" 'user
) "user"))
417 (should (string-equal (file-remote-p "/-:user@:" 'host
) "default-host"))
418 (should (string-equal (file-remote-p "/-:user@:" 'localname
) ""))
419 (should (string-equal (file-remote-p "/-:user@:" 'hop
) nil
))
421 ;; Expand `tramp-default-method'.
422 (should (string-equal
423 (file-remote-p "/-:user@host:")
424 (format "/%s:%s@%s:" "default-method" "user" "host")))
425 (should (string-equal
426 (file-remote-p "/-:user@host:" 'method
) "default-method"))
427 (should (string-equal (file-remote-p "/-:user@host:" 'user
) "user"))
428 (should (string-equal (file-remote-p "/-:user@host:" 'host
) "host"))
429 (should (string-equal (file-remote-p "/-:user@host:" 'localname
) ""))
430 (should (string-equal (file-remote-p "/-:user@host:" 'hop
) nil
))
432 ;; Expand `tramp-default-user'.
433 (should (string-equal
434 (file-remote-p "/method:host:")
435 (format "/%s:%s@%s:" "method" "default-user" "host")))
436 (should (string-equal (file-remote-p "/method:host:" 'method
) "method"))
437 (should (string-equal (file-remote-p "/method:host:" 'user
) "default-user"))
438 (should (string-equal (file-remote-p "/method:host:" 'host
) "host"))
439 (should (string-equal (file-remote-p "/method:host:" 'localname
) ""))
440 (should (string-equal (file-remote-p "/method:host:" 'hop
) nil
))
442 ;; Expand `tramp-default-host'.
443 (should (string-equal
444 (file-remote-p "/method:user@:")
445 (format "/%s:%s@%s:" "method" "user" "default-host")))
446 (should (string-equal (file-remote-p "/method:user@:" 'method
) "method"))
447 (should (string-equal (file-remote-p "/method:user@:" 'user
) "user"))
448 (should (string-equal (file-remote-p "/method:user@:" 'host
)
450 (should (string-equal (file-remote-p "/method:user@:" 'localname
) ""))
451 (should (string-equal (file-remote-p "/method:user@:" 'hop
) nil
))
454 (should (string-equal
455 (file-remote-p "/method:user@host:")
456 (format "/%s:%s@%s:" "method" "user" "host")))
457 (should (string-equal
458 (file-remote-p "/method:user@host:" 'method
) "method"))
459 (should (string-equal (file-remote-p "/method:user@host:" 'user
) "user"))
460 (should (string-equal (file-remote-p "/method:user@host:" 'host
) "host"))
461 (should (string-equal (file-remote-p "/method:user@host:" 'localname
) ""))
462 (should (string-equal (file-remote-p "/method:user@host:" 'hop
) nil
))
465 (should (string-equal
466 (file-remote-p "/method:user@email@host:")
467 (format "/%s:%s@%s:" "method" "user@email" "host")))
468 (should (string-equal
469 (file-remote-p "/method:user@email@host:" 'method
) "method"))
470 (should (string-equal
471 (file-remote-p "/method:user@email@host:" 'user
) "user@email"))
472 (should (string-equal
473 (file-remote-p "/method:user@email@host:" 'host
) "host"))
474 (should (string-equal
475 (file-remote-p "/method:user@email@host:" 'localname
) ""))
476 (should (string-equal
477 (file-remote-p "/method:user@email@host:" 'hop
) nil
))
479 ;; Expand `tramp-default-method' and `tramp-default-user'.
480 (should (string-equal
481 (file-remote-p "/-:host#1234:")
482 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
483 (should (string-equal
484 (file-remote-p "/-:host#1234:" 'method
) "default-method"))
485 (should (string-equal (file-remote-p "/-:host#1234:" 'user
) "default-user"))
486 (should (string-equal (file-remote-p "/-:host#1234:" 'host
) "host#1234"))
487 (should (string-equal (file-remote-p "/-:host#1234:" 'localname
) ""))
488 (should (string-equal (file-remote-p "/-:host#1234:" 'hop
) nil
))
490 ;; Expand `tramp-default-method'.
491 (should (string-equal
492 (file-remote-p "/-:user@host#1234:")
493 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
494 (should (string-equal
495 (file-remote-p "/-:user@host#1234:" 'method
) "default-method"))
496 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user
) "user"))
497 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host
) "host#1234"))
498 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname
) ""))
499 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop
) nil
))
501 ;; Expand `tramp-default-user'.
502 (should (string-equal
503 (file-remote-p "/method:host#1234:")
504 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
505 (should (string-equal
506 (file-remote-p "/method:host#1234:" 'method
) "method"))
507 (should (string-equal
508 (file-remote-p "/method:host#1234:" 'user
) "default-user"))
509 (should (string-equal
510 (file-remote-p "/method:host#1234:" 'host
) "host#1234"))
511 (should (string-equal (file-remote-p "/method:host#1234:" 'localname
) ""))
512 (should (string-equal (file-remote-p "/method:host#1234:" 'hop
) nil
))
515 (should (string-equal
516 (file-remote-p "/method:user@host#1234:")
517 (format "/%s:%s@%s:" "method" "user" "host#1234")))
518 (should (string-equal
519 (file-remote-p "/method:user@host#1234:" 'method
) "method"))
520 (should (string-equal
521 (file-remote-p "/method:user@host#1234:" 'user
) "user"))
522 (should (string-equal
523 (file-remote-p "/method:user@host#1234:" 'host
) "host#1234"))
524 (should (string-equal
525 (file-remote-p "/method:user@host#1234:" 'localname
) ""))
526 (should (string-equal
527 (file-remote-p "/method:user@host#1234:" 'hop
) nil
))
529 ;; Expand `tramp-default-method' and `tramp-default-user'.
530 (should (string-equal
531 (file-remote-p "/-:1.2.3.4:")
532 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
533 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method
) "default-method"))
534 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user
) "default-user"))
535 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host
) "1.2.3.4"))
536 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname
) ""))
537 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop
) nil
))
539 ;; Expand `tramp-default-method'.
540 (should (string-equal
541 (file-remote-p "/-:user@1.2.3.4:")
542 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
543 (should (string-equal
544 (file-remote-p "/-:user@1.2.3.4:" 'method
) "default-method"))
545 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user
) "user"))
546 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host
) "1.2.3.4"))
547 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname
) ""))
548 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop
) nil
))
550 ;; Expand `tramp-default-user'.
551 (should (string-equal
552 (file-remote-p "/method:1.2.3.4:")
553 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
554 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method
) "method"))
555 (should (string-equal
556 (file-remote-p "/method:1.2.3.4:" 'user
) "default-user"))
557 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host
) "1.2.3.4"))
558 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname
) ""))
559 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop
) nil
))
562 (should (string-equal
563 (file-remote-p "/method:user@1.2.3.4:")
564 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
565 (should (string-equal
566 (file-remote-p "/method:user@1.2.3.4:" 'method
) "method"))
567 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user
) "user"))
568 (should (string-equal
569 (file-remote-p "/method:user@1.2.3.4:" 'host
) "1.2.3.4"))
570 (should (string-equal
571 (file-remote-p "/method:user@1.2.3.4:" 'localname
) ""))
572 (should (string-equal
573 (file-remote-p "/method:user@1.2.3.4:" 'hop
) nil
))
575 ;; Expand `tramp-default-method', `tramp-default-user' and
576 ;; `tramp-default-host'.
577 (should (string-equal
578 (file-remote-p "/-:[]:")
580 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
581 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
582 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
583 (should (string-equal (file-remote-p "/-:[]:" 'host
) "default-host"))
584 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
585 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
))
587 ;; Expand `tramp-default-method' and `tramp-default-user'.
588 (let ((tramp-default-host "::1"))
589 (should (string-equal
590 (file-remote-p "/-:[]:")
591 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
592 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
593 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
594 (should (string-equal (file-remote-p "/-:[]:" 'host
) "::1"))
595 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
596 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
)))
598 ;; Expand `tramp-default-method' and `tramp-default-user'.
599 (should (string-equal
600 (file-remote-p "/-:[::1]:")
601 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
602 (should (string-equal (file-remote-p "/-:[::1]:" 'method
) "default-method"))
603 (should (string-equal (file-remote-p "/-:[::1]:" 'user
) "default-user"))
604 (should (string-equal (file-remote-p "/-:[::1]:" 'host
) "::1"))
605 (should (string-equal (file-remote-p "/-:[::1]:" 'localname
) ""))
606 (should (string-equal (file-remote-p "/-:[::1]:" 'hop
) nil
))
608 ;; Expand `tramp-default-method'.
609 (should (string-equal
610 (file-remote-p "/-:user@[::1]:")
611 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
612 (should (string-equal
613 (file-remote-p "/-:user@[::1]:" 'method
) "default-method"))
614 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user
) "user"))
615 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host
) "::1"))
616 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname
) ""))
617 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop
) nil
))
619 ;; Expand `tramp-default-user'.
620 (should (string-equal
621 (file-remote-p "/method:[::1]:")
622 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
623 (should (string-equal (file-remote-p "/method:[::1]:" 'method
) "method"))
624 (should (string-equal
625 (file-remote-p "/method:[::1]:" 'user
) "default-user"))
626 (should (string-equal (file-remote-p "/method:[::1]:" 'host
) "::1"))
627 (should (string-equal (file-remote-p "/method:[::1]:" 'localname
) ""))
628 (should (string-equal (file-remote-p "/method:[::1]:" 'hop
) nil
))
631 (should (string-equal
632 (file-remote-p "/method:user@[::1]:")
633 (format "/%s:%s@%s:" "method" "user" "[::1]")))
634 (should (string-equal
635 (file-remote-p "/method:user@[::1]:" 'method
) "method"))
636 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user
) "user"))
637 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host
) "::1"))
638 (should (string-equal
639 (file-remote-p "/method:user@[::1]:" 'localname
) ""))
640 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop
) nil
))
642 ;; Local file name part.
643 (should (string-equal (file-remote-p "/-:host:/:" 'localname
) "/:"))
644 (should (string-equal (file-remote-p "/method:::" 'localname
) ":"))
645 (should (string-equal (file-remote-p "/method:: " 'localname
) " "))
646 (should (string-equal (file-remote-p "/method::file" 'localname
) "file"))
647 (should (string-equal
648 (file-remote-p "/method::/path/to/file" 'localname
)
654 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
655 (format "/%s:%s@%s|%s:%s@%s:"
656 "method1" "user1" "host1" "method2" "user2" "host2")))
660 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method
)
665 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user
)
670 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host
)
675 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname
)
680 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop
)
682 "method1" "user1" "host1")))
688 "/method1:user1@host1"
689 "|method2:user2@host2"
690 "|method3:user3@host3:/path/to/file"))
691 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
692 "method1" "user1" "host1"
693 "method2" "user2" "host2"
694 "method3" "user3" "host3")))
699 "/method1:user1@host1"
700 "|method2:user2@host2"
701 "|method3:user3@host3:/path/to/file")
708 "/method1:user1@host1"
709 "|method2:user2@host2"
710 "|method3:user3@host3:/path/to/file")
717 "/method1:user1@host1"
718 "|method2:user2@host2"
719 "|method3:user3@host3:/path/to/file")
726 "/method1:user1@host1"
727 "|method2:user2@host2"
728 "|method3:user3@host3:/path/to/file")
735 "/method1:user1@host1"
736 "|method2:user2@host2"
737 "|method3:user3@host3:/path/to/file")
739 (format "%s:%s@%s|%s:%s@%s|"
740 "method1" "user1" "host1" "method2" "user2" "host2")))
742 ;; Expand `tramp-default-method-alist'.
743 (add-to-list 'tramp-default-method-alist
'("host1" "user1" "method1"))
744 (add-to-list 'tramp-default-method-alist
'("host2" "user2" "method2"))
745 (add-to-list 'tramp-default-method-alist
'("host3" "user3" "method3"))
752 "|-:user3@host3:/path/to/file"))
753 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
756 "method3" "user3" "host3")))
758 ;; Expand `tramp-default-user-alist'.
759 (add-to-list 'tramp-default-user-alist
'("method1" "host1" "user1"))
760 (add-to-list 'tramp-default-user-alist
'("method2" "host2" "user2"))
761 (add-to-list 'tramp-default-user-alist
'("method3" "host3" "user3"))
768 "|method3:host3:/path/to/file"))
769 (format "/%s:%s|%s:%s|%s:%s@%s:"
772 "method3" "user3" "host3")))
774 ;; Expand `tramp-default-host-alist'.
775 (add-to-list 'tramp-default-host-alist
'("method1" "user1" "host1"))
776 (add-to-list 'tramp-default-host-alist
'("method2" "user2" "host2"))
777 (add-to-list 'tramp-default-host-alist
'("method3" "user3" "host3"))
784 "|method3:user3@:/path/to/file"))
785 (format "/%s:%s@|%s:%s@|%s:%s@%s:"
788 "method3" "user3" "host3")))))
790 (ert-deftest tramp-test02-file-name-dissect-simplified
()
791 "Check simplified file name components."
792 :tags
'(:expensive-test
)
793 (let ((tramp-default-method "default-method")
794 (tramp-default-user "default-user")
795 (tramp-default-host "default-host")
796 tramp-default-user-alist
797 tramp-default-host-alist
798 (syntax tramp-syntax
))
801 (tramp-change-syntax 'simplified
)
802 ;; Expand `tramp-default-method' and `tramp-default-user'.
803 (should (string-equal
804 (file-remote-p "/host:")
805 (format "/%s@%s:" "default-user" "host")))
806 (should (string-equal
807 (file-remote-p "/host:" 'method
) "default-method"))
808 (should (string-equal (file-remote-p "/host:" 'user
) "default-user"))
809 (should (string-equal (file-remote-p "/host:" 'host
) "host"))
810 (should (string-equal (file-remote-p "/host:" 'localname
) ""))
811 (should (string-equal (file-remote-p "/host:" 'hop
) nil
))
813 ;; Expand `tramp-default-method' and `tramp-default-host'.
814 (should (string-equal
815 (file-remote-p "/user@:")
816 (format "/%s@%s:" "user" "default-host")))
817 (should (string-equal
818 (file-remote-p "/user@:" 'method
) "default-method"))
819 (should (string-equal (file-remote-p "/user@:" 'user
) "user"))
820 (should (string-equal (file-remote-p "/user@:" 'host
) "default-host"))
821 (should (string-equal (file-remote-p "/user@:" 'localname
) ""))
822 (should (string-equal (file-remote-p "/user@:" 'hop
) nil
))
824 ;; Expand `tramp-default-method'.
825 (should (string-equal
826 (file-remote-p "/user@host:")
827 (format "/%s@%s:" "user" "host")))
828 (should (string-equal
829 (file-remote-p "/user@host:" 'method
) "default-method"))
830 (should (string-equal (file-remote-p "/user@host:" 'user
) "user"))
831 (should (string-equal (file-remote-p "/user@host:" 'host
) "host"))
832 (should (string-equal (file-remote-p "/user@host:" 'localname
) ""))
833 (should (string-equal (file-remote-p "/user@host:" 'hop
) nil
))
836 (should (string-equal
837 (file-remote-p "/user@email@host:")
838 (format "/%s@%s:" "user@email" "host")))
839 (should (string-equal
841 "/user@email@host:" 'method
) "default-method"))
842 (should (string-equal
843 (file-remote-p "/user@email@host:" 'user
) "user@email"))
844 (should (string-equal
845 (file-remote-p "/user@email@host:" 'host
) "host"))
846 (should (string-equal
847 (file-remote-p "/user@email@host:" 'localname
) ""))
848 (should (string-equal
849 (file-remote-p "/user@email@host:" 'hop
) nil
))
851 ;; Expand `tramp-default-method' and `tramp-default-user'.
852 (should (string-equal
853 (file-remote-p "/host#1234:")
854 (format "/%s@%s:" "default-user" "host#1234")))
855 (should (string-equal
856 (file-remote-p "/host#1234:" 'method
) "default-method"))
857 (should (string-equal
858 (file-remote-p "/host#1234:" 'user
) "default-user"))
859 (should (string-equal
860 (file-remote-p "/host#1234:" 'host
) "host#1234"))
861 (should (string-equal (file-remote-p "/host#1234:" 'localname
) ""))
862 (should (string-equal (file-remote-p "/host#1234:" 'hop
) nil
))
864 ;; Expand `tramp-default-method'.
865 (should (string-equal
866 (file-remote-p "/user@host#1234:")
867 (format "/%s@%s:" "user" "host#1234")))
868 (should (string-equal
869 (file-remote-p "/user@host#1234:" 'method
) "default-method"))
870 (should (string-equal
871 (file-remote-p "/user@host#1234:" 'user
) "user"))
872 (should (string-equal
873 (file-remote-p "/user@host#1234:" 'host
) "host#1234"))
874 (should (string-equal
875 (file-remote-p "/user@host#1234:" 'localname
) ""))
876 (should (string-equal (file-remote-p "/user@host#1234:" 'hop
) nil
))
878 ;; Expand `tramp-default-method' and `tramp-default-user'.
879 (should (string-equal
880 (file-remote-p "/1.2.3.4:")
881 (format "/%s@%s:" "default-user" "1.2.3.4")))
882 (should (string-equal
883 (file-remote-p "/1.2.3.4:" 'method
) "default-method"))
884 (should (string-equal
885 (file-remote-p "/1.2.3.4:" 'user
) "default-user"))
886 (should (string-equal (file-remote-p "/1.2.3.4:" 'host
) "1.2.3.4"))
887 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname
) ""))
888 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop
) nil
))
890 ;; Expand `tramp-default-method'.
891 (should (string-equal
892 (file-remote-p "/user@1.2.3.4:")
893 (format "/%s@%s:" "user" "1.2.3.4")))
894 (should (string-equal
895 (file-remote-p "/user@1.2.3.4:" 'method
) "default-method"))
896 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user
) "user"))
897 (should (string-equal
898 (file-remote-p "/user@1.2.3.4:" 'host
) "1.2.3.4"))
899 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname
) ""))
900 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop
) nil
))
902 ;; Expand `tramp-default-method', `tramp-default-user' and
903 ;; `tramp-default-host'.
904 (should (string-equal
905 (file-remote-p "/[]:")
907 "/%s@%s:" "default-user" "default-host")))
908 (should (string-equal
909 (file-remote-p "/[]:" 'method
) "default-method"))
910 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
911 (should (string-equal (file-remote-p "/[]:" 'host
) "default-host"))
912 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
913 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
))
915 ;; Expand `tramp-default-method' and `tramp-default-user'.
916 (let ((tramp-default-host "::1"))
917 (should (string-equal
918 (file-remote-p "/[]:")
919 (format "/%s@%s:" "default-user" "[::1]")))
920 (should (string-equal
921 (file-remote-p "/[]:" 'method
) "default-method"))
922 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
923 (should (string-equal (file-remote-p "/[]:" 'host
) "::1"))
924 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
925 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
)))
927 ;; Expand `tramp-default-method' and `tramp-default-user'.
928 (should (string-equal
929 (file-remote-p "/[::1]:")
930 (format "/%s@%s:" "default-user" "[::1]")))
931 (should (string-equal
932 (file-remote-p "/[::1]:" 'method
) "default-method"))
933 (should (string-equal (file-remote-p "/[::1]:" 'user
) "default-user"))
934 (should (string-equal (file-remote-p "/[::1]:" 'host
) "::1"))
935 (should (string-equal (file-remote-p "/[::1]:" 'localname
) ""))
936 (should (string-equal (file-remote-p "/[::1]:" 'hop
) nil
))
938 ;; Expand `tramp-default-method'.
939 (should (string-equal
940 (file-remote-p "/user@[::1]:")
941 (format "/%s@%s:" "user" "[::1]")))
942 (should (string-equal
943 (file-remote-p "/user@[::1]:" 'method
) "default-method"))
944 (should (string-equal (file-remote-p "/user@[::1]:" 'user
) "user"))
945 (should (string-equal (file-remote-p "/user@[::1]:" 'host
) "::1"))
946 (should (string-equal (file-remote-p "/user@[::1]:" 'localname
) ""))
947 (should (string-equal (file-remote-p "/user@[::1]:" 'hop
) nil
))
949 ;; Local file name part.
950 (should (string-equal (file-remote-p "/host:/:" 'localname
) "/:"))
951 (should (string-equal (file-remote-p "/host::" 'localname
) ":"))
952 (should (string-equal (file-remote-p "/host: " 'localname
) " "))
953 (should (string-equal (file-remote-p "/host:file" 'localname
) "file"))
954 (should (string-equal
955 (file-remote-p "/host:/path/to/file" 'localname
)
961 (file-remote-p "/user1@host1|user2@host2:/path/to/file")
962 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
966 "/user1@host1|user2@host2:/path/to/file" 'method
)
971 "/user1@host1|user2@host2:/path/to/file" 'user
)
976 "/user1@host1|user2@host2:/path/to/file" 'host
)
981 "/user1@host1|user2@host2:/path/to/file" 'localname
)
986 "/user1@host1|user2@host2:/path/to/file" 'hop
)
987 (format "%s@%s|" "user1" "host1")))
995 "|user3@host3:/path/to/file"))
996 (format "/%s@%s|%s@%s|%s@%s:"
1006 "|user3@host3:/path/to/file")
1015 "|user3@host3:/path/to/file")
1024 "|user3@host3:/path/to/file")
1033 "|user3@host3:/path/to/file")
1042 "|user3@host3:/path/to/file")
1044 (format "%s@%s|%s@%s|"
1045 "user1" "host1" "user2" "host2")))
1047 ;; Expand `tramp-default-user-alist'.
1048 (add-to-list 'tramp-default-user-alist
'(nil "host1" "user1"))
1049 (add-to-list 'tramp-default-user-alist
'(nil "host2" "user2"))
1050 (add-to-list 'tramp-default-user-alist
'(nil "host3" "user3"))
1057 "|host3:/path/to/file"))
1058 (format "/%s|%s|%s@%s:"
1063 ;; Expand `tramp-default-host-alist'.
1064 (add-to-list 'tramp-default-host-alist
'(nil "user1" "host1"))
1065 (add-to-list 'tramp-default-host-alist
'(nil "user2" "host2"))
1066 (add-to-list 'tramp-default-host-alist
'(nil "user3" "host3"))
1073 "|user3@:/path/to/file"))
1074 (format "/%s@|%s@|%s@%s:"
1080 (tramp-change-syntax syntax
))))
1082 (ert-deftest tramp-test02-file-name-dissect-separate
()
1083 "Check separate file name components."
1084 :tags
'(:expensive-test
)
1085 (let ((tramp-default-method "default-method")
1086 (tramp-default-user "default-user")
1087 (tramp-default-host "default-host")
1088 tramp-default-method-alist
1089 tramp-default-user-alist
1090 tramp-default-host-alist
1091 (syntax tramp-syntax
))
1094 (tramp-change-syntax 'separate
)
1095 ;; Expand `tramp-default-user' and `tramp-default-host'.
1096 (should (string-equal
1097 (file-remote-p "/[method/]")
1099 "/[%s/%s@%s]" "method" "default-user" "default-host")))
1100 (should (string-equal (file-remote-p "/[method/]" 'method
) "method"))
1101 (should (string-equal
1102 (file-remote-p "/[method/]" 'user
) "default-user"))
1103 (should (string-equal
1104 (file-remote-p "/[method/]" 'host
) "default-host"))
1105 (should (string-equal (file-remote-p "/[method/]" 'localname
) ""))
1106 (should (string-equal (file-remote-p "/[method/]" 'hop
) nil
))
1108 ;; Expand `tramp-default-method' and `tramp-default-user'.
1109 (should (string-equal
1110 (file-remote-p "/[/host]")
1112 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1113 (should (string-equal
1114 (file-remote-p "/[/host]" 'method
) "default-method"))
1115 (should (string-equal
1116 (file-remote-p "/[/host]" 'user
) "default-user"))
1117 (should (string-equal (file-remote-p "/[/host]" 'host
) "host"))
1118 (should (string-equal (file-remote-p "/[/host]" 'localname
) ""))
1119 (should (string-equal (file-remote-p "/[/host]" 'hop
) nil
))
1121 ;; Expand `tramp-default-method' and `tramp-default-host'.
1122 (should (string-equal
1123 (file-remote-p "/[/user@]")
1125 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1126 (should (string-equal
1127 (file-remote-p "/[/user@]" 'method
) "default-method"))
1128 (should (string-equal (file-remote-p "/[/user@]" 'user
) "user"))
1129 (should (string-equal
1130 (file-remote-p "/[/user@]" 'host
) "default-host"))
1131 (should (string-equal (file-remote-p "/[/user@]" 'localname
) ""))
1132 (should (string-equal (file-remote-p "/[/user@]" 'hop
) nil
))
1134 ;; Expand `tramp-default-method'.
1135 (should (string-equal
1136 (file-remote-p "/[/user@host]")
1137 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1138 (should (string-equal
1139 (file-remote-p "/[/user@host]" 'method
) "default-method"))
1140 (should (string-equal (file-remote-p "/[/user@host]" 'user
) "user"))
1141 (should (string-equal (file-remote-p "/[/user@host]" 'host
) "host"))
1142 (should (string-equal (file-remote-p "/[/user@host]" 'localname
) ""))
1143 (should (string-equal (file-remote-p "/[/user@host]" 'hop
) nil
))
1145 ;; Expand `tramp-default-method' and `tramp-default-user'.
1146 (should (string-equal
1147 (file-remote-p "/[-/host]")
1149 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1150 (should (string-equal
1151 (file-remote-p "/[-/host]" 'method
) "default-method"))
1152 (should (string-equal
1153 (file-remote-p "/[-/host]" 'user
) "default-user"))
1154 (should (string-equal (file-remote-p "/[-/host]" 'host
) "host"))
1155 (should (string-equal (file-remote-p "/[-/host]" 'localname
) ""))
1156 (should (string-equal (file-remote-p "/[-/host]" 'hop
) nil
))
1158 ;; Expand `tramp-default-method' and `tramp-default-host'.
1159 (should (string-equal
1160 (file-remote-p "/[-/user@]")
1162 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1163 (should (string-equal
1164 (file-remote-p "/[-/user@]" 'method
) "default-method"))
1165 (should (string-equal (file-remote-p "/[-/user@]" 'user
) "user"))
1166 (should (string-equal
1167 (file-remote-p "/[-/user@]" 'host
) "default-host"))
1168 (should (string-equal (file-remote-p "/[-/user@]" 'localname
) ""))
1169 (should (string-equal (file-remote-p "/[-/user@]" 'hop
) nil
))
1171 ;; Expand `tramp-default-method'.
1172 (should (string-equal
1173 (file-remote-p "/[-/user@host]")
1174 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1175 (should (string-equal
1176 (file-remote-p "/[-/user@host]" 'method
) "default-method"))
1177 (should (string-equal (file-remote-p "/[-/user@host]" 'user
) "user"))
1178 (should (string-equal (file-remote-p "/[-/user@host]" 'host
) "host"))
1179 (should (string-equal (file-remote-p "/[-/user@host]" 'localname
) ""))
1180 (should (string-equal (file-remote-p "/[-/user@host]" 'hop
) nil
))
1182 ;; Expand `tramp-default-user'.
1183 (should (string-equal
1184 (file-remote-p "/[method/host]")
1185 (format "/[%s/%s@%s]" "method" "default-user" "host")))
1186 (should (string-equal
1187 (file-remote-p "/[method/host]" 'method
) "method"))
1188 (should (string-equal
1189 (file-remote-p "/[method/host]" 'user
) "default-user"))
1190 (should (string-equal (file-remote-p "/[method/host]" 'host
) "host"))
1191 (should (string-equal (file-remote-p "/[method/host]" 'localname
) ""))
1192 (should (string-equal (file-remote-p "/[method/host]" 'hop
) nil
))
1194 ;; Expand `tramp-default-host'.
1195 (should (string-equal
1196 (file-remote-p "/[method/user@]")
1197 (format "/[%s/%s@%s]" "method" "user" "default-host")))
1198 (should (string-equal
1199 (file-remote-p "/[method/user@]" 'method
) "method"))
1200 (should (string-equal (file-remote-p "/[method/user@]" 'user
) "user"))
1201 (should (string-equal
1202 (file-remote-p "/[method/user@]" 'host
) "default-host"))
1203 (should (string-equal
1204 (file-remote-p "/[method/user@]" 'localname
) ""))
1205 (should (string-equal (file-remote-p "/[method/user@]" 'hop
) nil
))
1208 (should (string-equal
1209 (file-remote-p "/[method/user@host]")
1210 (format "/[%s/%s@%s]" "method" "user" "host")))
1211 (should (string-equal
1212 (file-remote-p "/[method/user@host]" 'method
) "method"))
1213 (should (string-equal
1214 (file-remote-p "/[method/user@host]" 'user
) "user"))
1215 (should (string-equal
1216 (file-remote-p "/[method/user@host]" 'host
) "host"))
1217 (should (string-equal
1218 (file-remote-p "/[method/user@host]" 'localname
) ""))
1219 (should (string-equal
1220 (file-remote-p "/[method/user@host]" 'hop
) nil
))
1223 (should (string-equal
1224 (file-remote-p "/[method/user@email@host]")
1225 (format "/[%s/%s@%s]" "method" "user@email" "host")))
1226 (should (string-equal
1228 "/[method/user@email@host]" 'method
) "method"))
1229 (should (string-equal
1231 "/[method/user@email@host]" 'user
) "user@email"))
1232 (should (string-equal
1233 (file-remote-p "/[method/user@email@host]" 'host
) "host"))
1234 (should (string-equal
1235 (file-remote-p "/[method/user@email@host]" 'localname
) ""))
1236 (should (string-equal
1237 (file-remote-p "/[method/user@email@host]" 'hop
) nil
))
1239 ;; Expand `tramp-default-method' and `tramp-default-user'.
1240 (should (string-equal
1241 (file-remote-p "/[/host#1234]")
1243 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1244 (should (string-equal
1245 (file-remote-p "/[/host#1234]" 'method
) "default-method"))
1246 (should (string-equal
1247 (file-remote-p "/[/host#1234]" 'user
) "default-user"))
1248 (should (string-equal
1249 (file-remote-p "/[/host#1234]" 'host
) "host#1234"))
1250 (should (string-equal (file-remote-p "/[/host#1234]" 'localname
) ""))
1251 (should (string-equal (file-remote-p "/[/host#1234]" 'hop
) nil
))
1253 ;; Expand `tramp-default-method'.
1254 (should (string-equal
1255 (file-remote-p "/[/user@host#1234]")
1256 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1257 (should (string-equal
1259 "/[/user@host#1234]" 'method
) "default-method"))
1260 (should (string-equal
1262 "/[/user@host#1234]" 'user
) "user"))
1263 (should (string-equal
1264 (file-remote-p "/[/user@host#1234]" 'host
) "host#1234"))
1265 (should (string-equal
1266 (file-remote-p "/[/user@host#1234]" 'localname
) ""))
1267 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop
) nil
))
1269 ;; Expand `tramp-default-method' and `tramp-default-user'.
1270 (should (string-equal
1271 (file-remote-p "/[-/host#1234]")
1273 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1274 (should (string-equal
1275 (file-remote-p "/[-/host#1234]" 'method
) "default-method"))
1276 (should (string-equal
1277 (file-remote-p "/[-/host#1234]" 'user
) "default-user"))
1278 (should (string-equal
1279 (file-remote-p "/[-/host#1234]" 'host
) "host#1234"))
1280 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname
) ""))
1281 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop
) nil
))
1283 ;; Expand `tramp-default-method'.
1284 (should (string-equal
1285 (file-remote-p "/[-/user@host#1234]")
1286 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1287 (should (string-equal
1289 "/[-/user@host#1234]" 'method
) "default-method"))
1290 (should (string-equal
1292 "/[-/user@host#1234]" 'user
) "user"))
1293 (should (string-equal
1294 (file-remote-p "/[-/user@host#1234]" 'host
) "host#1234"))
1295 (should (string-equal
1296 (file-remote-p "/[-/user@host#1234]" 'localname
) ""))
1297 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop
) nil
))
1299 ;; Expand `tramp-default-user'.
1300 (should (string-equal
1301 (file-remote-p "/[method/host#1234]")
1302 (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1303 (should (string-equal
1304 (file-remote-p "/[method/host#1234]" 'method
) "method"))
1305 (should (string-equal
1306 (file-remote-p "/[method/host#1234]" 'user
) "default-user"))
1307 (should (string-equal
1308 (file-remote-p "/[method/host#1234]" 'host
) "host#1234"))
1309 (should (string-equal
1310 (file-remote-p "/[method/host#1234]" 'localname
) ""))
1311 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop
) nil
))
1314 (should (string-equal
1315 (file-remote-p "/[method/user@host#1234]")
1316 (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1317 (should (string-equal
1318 (file-remote-p "/[method/user@host#1234]" 'method
) "method"))
1319 (should (string-equal
1320 (file-remote-p "/[method/user@host#1234]" 'user
) "user"))
1321 (should (string-equal
1323 "/[method/user@host#1234]" 'host
) "host#1234"))
1324 (should (string-equal
1325 (file-remote-p "/[method/user@host#1234]" 'localname
) ""))
1326 (should (string-equal
1327 (file-remote-p "/[method/user@host#1234]" 'hop
) nil
))
1329 ;; Expand `tramp-default-method' and `tramp-default-user'.
1330 (should (string-equal
1331 (file-remote-p "/[/1.2.3.4]")
1333 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1334 (should (string-equal
1335 (file-remote-p "/[/1.2.3.4]" 'method
) "default-method"))
1336 (should (string-equal
1337 (file-remote-p "/[/1.2.3.4]" 'user
) "default-user"))
1338 (should (string-equal
1339 (file-remote-p "/[/1.2.3.4]" 'host
) "1.2.3.4"))
1340 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname
) ""))
1341 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop
) nil
))
1343 ;; Expand `tramp-default-method'.
1344 (should (string-equal
1345 (file-remote-p "/[/user@1.2.3.4]")
1346 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1347 (should (string-equal
1349 "/[/user@1.2.3.4]" 'method
) "default-method"))
1350 (should (string-equal
1351 (file-remote-p "/[/user@1.2.3.4]" 'user
) "user"))
1352 (should (string-equal
1353 (file-remote-p "/[/user@1.2.3.4]" 'host
) "1.2.3.4"))
1354 (should (string-equal
1355 (file-remote-p "/[/user@1.2.3.4]" 'localname
) ""))
1356 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop
) nil
))
1358 ;; Expand `tramp-default-method' and `tramp-default-user'.
1359 (should (string-equal
1360 (file-remote-p "/[-/1.2.3.4]")
1362 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1363 (should (string-equal
1364 (file-remote-p "/[-/1.2.3.4]" 'method
) "default-method"))
1365 (should (string-equal
1366 (file-remote-p "/[-/1.2.3.4]" 'user
) "default-user"))
1367 (should (string-equal
1368 (file-remote-p "/[-/1.2.3.4]" 'host
) "1.2.3.4"))
1369 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname
) ""))
1370 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop
) nil
))
1372 ;; Expand `tramp-default-method'.
1373 (should (string-equal
1374 (file-remote-p "/[-/user@1.2.3.4]")
1375 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1376 (should (string-equal
1378 "/[-/user@1.2.3.4]" 'method
) "default-method"))
1379 (should (string-equal
1380 (file-remote-p "/[-/user@1.2.3.4]" 'user
) "user"))
1381 (should (string-equal
1382 (file-remote-p "/[-/user@1.2.3.4]" 'host
) "1.2.3.4"))
1383 (should (string-equal
1384 (file-remote-p "/[-/user@1.2.3.4]" 'localname
) ""))
1385 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop
) nil
))
1387 ;; Expand `tramp-default-user'.
1388 (should (string-equal
1389 (file-remote-p "/[method/1.2.3.4]")
1390 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1391 (should (string-equal
1392 (file-remote-p "/[method/1.2.3.4]" 'method
) "method"))
1393 (should (string-equal
1394 (file-remote-p "/[method/1.2.3.4]" 'user
) "default-user"))
1395 (should (string-equal
1396 (file-remote-p "/[method/1.2.3.4]" 'host
) "1.2.3.4"))
1397 (should (string-equal
1398 (file-remote-p "/[method/1.2.3.4]" 'localname
) ""))
1399 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop
) nil
))
1402 (should (string-equal
1403 (file-remote-p "/[method/user@1.2.3.4]")
1404 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1405 (should (string-equal
1406 (file-remote-p "/[method/user@1.2.3.4]" 'method
) "method"))
1407 (should (string-equal
1408 (file-remote-p "/[method/user@1.2.3.4]" 'user
) "user"))
1409 (should (string-equal
1410 (file-remote-p "/[method/user@1.2.3.4]" 'host
) "1.2.3.4"))
1411 (should (string-equal
1412 (file-remote-p "/[method/user@1.2.3.4]" 'localname
) ""))
1413 (should (string-equal
1414 (file-remote-p "/[method/user@1.2.3.4]" 'hop
) nil
))
1416 ;; Expand `tramp-default-method', `tramp-default-user' and
1417 ;; `tramp-default-host'.
1418 (should (string-equal
1419 (file-remote-p "/[/]")
1422 "default-method" "default-user" "default-host")))
1423 (should (string-equal
1424 (file-remote-p "/[/]" 'method
) "default-method"))
1425 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1426 (should (string-equal (file-remote-p "/[/]" 'host
) "default-host"))
1427 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1428 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
))
1430 ;; Expand `tramp-default-method' and `tramp-default-user'.
1431 (let ((tramp-default-host "::1"))
1432 (should (string-equal
1433 (file-remote-p "/[/]")
1436 "default-method" "default-user" "::1")))
1437 (should (string-equal
1438 (file-remote-p "/[/]" 'method
) "default-method"))
1439 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1440 (should (string-equal (file-remote-p "/[/]" 'host
) "::1"))
1441 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1442 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
)))
1444 ;; Expand `tramp-default-method' and `tramp-default-user'.
1445 (should (string-equal
1446 (file-remote-p "/[/::1]")
1448 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1449 (should (string-equal
1450 (file-remote-p "/[/::1]" 'method
) "default-method"))
1451 (should (string-equal
1452 (file-remote-p "/[/::1]" 'user
) "default-user"))
1453 (should (string-equal (file-remote-p "/[/::1]" 'host
) "::1"))
1454 (should (string-equal (file-remote-p "/[/::1]" 'localname
) ""))
1455 (should (string-equal (file-remote-p "/[/::1]" 'hop
) nil
))
1457 ;; Expand `tramp-default-method'.
1458 (should (string-equal
1459 (file-remote-p "/[/user@::1]")
1460 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1461 (should (string-equal
1462 (file-remote-p "/[/user@::1]" 'method
) "default-method"))
1463 (should (string-equal (file-remote-p "/[/user@::1]" 'user
) "user"))
1464 (should (string-equal (file-remote-p "/[/user@::1]" 'host
) "::1"))
1465 (should (string-equal (file-remote-p "/[/user@::1]" 'localname
) ""))
1466 (should (string-equal (file-remote-p "/[/user@::1]" 'hop
) nil
))
1468 ;; Expand `tramp-default-method', `tramp-default-user' and
1469 ;; `tramp-default-host'.
1470 (should (string-equal
1471 (file-remote-p "/[-/]")
1474 "default-method" "default-user" "default-host")))
1475 (should (string-equal
1476 (file-remote-p "/[-/]" 'method
) "default-method"))
1477 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1478 (should (string-equal (file-remote-p "/[-/]" 'host
) "default-host"))
1479 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1480 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
))
1482 ;; Expand `tramp-default-method' and `tramp-default-user'.
1483 (let ((tramp-default-host "::1"))
1484 (should (string-equal
1485 (file-remote-p "/[-/]")
1488 "default-method" "default-user" "::1")))
1489 (should (string-equal
1490 (file-remote-p "/[-/]" 'method
) "default-method"))
1491 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1492 (should (string-equal (file-remote-p "/[-/]" 'host
) "::1"))
1493 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1494 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
)))
1496 ;; Expand `tramp-default-method' and `tramp-default-user'.
1497 (should (string-equal
1498 (file-remote-p "/[-/::1]")
1500 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1501 (should (string-equal
1502 (file-remote-p "/[-/::1]" 'method
) "default-method"))
1503 (should (string-equal
1504 (file-remote-p "/[-/::1]" 'user
) "default-user"))
1505 (should (string-equal (file-remote-p "/[-/::1]" 'host
) "::1"))
1506 (should (string-equal (file-remote-p "/[-/::1]" 'localname
) ""))
1507 (should (string-equal (file-remote-p "/[-/::1]" 'hop
) nil
))
1509 ;; Expand `tramp-default-method'.
1510 (should (string-equal
1511 (file-remote-p "/[-/user@::1]")
1512 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1513 (should (string-equal
1514 (file-remote-p "/[-/user@::1]" 'method
) "default-method"))
1515 (should (string-equal (file-remote-p "/[-/user@::1]" 'user
) "user"))
1516 (should (string-equal (file-remote-p "/[-/user@::1]" 'host
) "::1"))
1517 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname
) ""))
1518 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop
) nil
))
1520 ;; Expand `tramp-default-user'.
1521 (should (string-equal
1522 (file-remote-p "/[method/::1]")
1523 (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1524 (should (string-equal
1525 (file-remote-p "/[method/::1]" 'method
) "method"))
1526 (should (string-equal
1527 (file-remote-p "/[method/::1]" 'user
) "default-user"))
1528 (should (string-equal (file-remote-p "/[method/::1]" 'host
) "::1"))
1529 (should (string-equal (file-remote-p "/[method/::1]" 'localname
) ""))
1530 (should (string-equal (file-remote-p "/[method/::1]" 'hop
) nil
))
1533 (should (string-equal
1534 (file-remote-p "/[method/user@::1]")
1535 (format "/[%s/%s@%s]" "method" "user" "::1")))
1536 (should (string-equal
1537 (file-remote-p "/[method/user@::1]" 'method
) "method"))
1538 (should (string-equal
1539 (file-remote-p "/[method/user@::1]" 'user
) "user"))
1540 (should (string-equal
1541 (file-remote-p "/[method/user@::1]" 'host
) "::1"))
1542 (should (string-equal
1543 (file-remote-p "/[method/user@::1]" 'localname
) ""))
1544 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop
) nil
))
1546 ;; Local file name part.
1547 (should (string-equal (file-remote-p "/[/host]/:" 'localname
) "/:"))
1548 (should (string-equal (file-remote-p "/[-/host]/:" 'localname
) "/:"))
1549 (should (string-equal (file-remote-p "/[method/]:" 'localname
) ":"))
1550 (should (string-equal (file-remote-p "/[method/] " 'localname
) " "))
1551 (should (string-equal
1552 (file-remote-p "/[method/]file" 'localname
) "file"))
1553 (should (string-equal
1554 (file-remote-p "/[method/]/path/to/file" 'localname
)
1561 "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1562 (format "/[%s/%s@%s|%s/%s@%s]"
1563 "method1" "user1" "host1" "method2" "user2" "host2")))
1567 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method
)
1572 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user
)
1577 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host
)
1582 "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1588 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop
)
1590 "method1" "user1" "host1")))
1596 "/[method1/user1@host1"
1597 "|method2/user2@host2"
1598 "|method3/user3@host3]/path/to/file"))
1599 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1600 "method1" "user1" "host1"
1601 "method2" "user2" "host2"
1602 "method3" "user3" "host3")))
1607 "/[method1/user1@host1"
1608 "|method2/user2@host2"
1609 "|method3/user3@host3]/path/to/file")
1616 "/[method1/user1@host1"
1617 "|method2/user2@host2"
1618 "|method3/user3@host3]/path/to/file")
1625 "/[method1/user1@host1"
1626 "|method2/user2@host2"
1627 "|method3/user3@host3]/path/to/file")
1634 "/[method1/user1@host1"
1635 "|method2/user2@host2"
1636 "|method3/user3@host3]/path/to/file")
1643 "/[method1/user1@host1"
1644 "|method2/user2@host2"
1645 "|method3/user3@host3]/path/to/file")
1647 (format "%s/%s@%s|%s/%s@%s|"
1648 "method1" "user1" "host1" "method2" "user2" "host2")))
1650 ;; Expand `tramp-default-method-alist'.
1651 (add-to-list 'tramp-default-method-alist
'("host1" "user1" "method1"))
1652 (add-to-list 'tramp-default-method-alist
'("host2" "user2" "method2"))
1653 (add-to-list 'tramp-default-method-alist
'("host3" "user3" "method3"))
1660 "|/user3@host3]/path/to/file"))
1661 (format "/[/%s@%s|/%s@%s|%s/%s@%s]"
1664 "method3" "user3" "host3")))
1666 ;; Expand `tramp-default-user-alist'.
1667 (add-to-list 'tramp-default-user-alist
'("method1" "host1" "user1"))
1668 (add-to-list 'tramp-default-user-alist
'("method2" "host2" "user2"))
1669 (add-to-list 'tramp-default-user-alist
'("method3" "host3" "user3"))
1676 "|method3/host3]/path/to/file"))
1677 (format "/[%s/%s|%s/%s|%s/%s@%s]"
1680 "method3" "user3" "host3")))
1682 ;; Expand `tramp-default-host-alist'.
1683 (add-to-list 'tramp-default-host-alist
'("method1" "user1" "host1"))
1684 (add-to-list 'tramp-default-host-alist
'("method2" "user2" "host2"))
1685 (add-to-list 'tramp-default-host-alist
'("method3" "user3" "host3"))
1692 "|method3/user3@]/path/to/file"))
1693 (format "/[%s/%s@|%s/%s@|%s/%s@%s]"
1696 "method3" "user3" "host3"))))
1699 (tramp-change-syntax syntax
))))
1701 (ert-deftest tramp-test03-file-name-defaults
()
1702 "Check default values for some methods."
1703 ;; Default values in tramp-adb.el.
1704 (should (string-equal (file-remote-p "/adb::" 'host
) ""))
1705 ;; Default values in tramp-ftp.el.
1706 (should (string-equal (file-remote-p "/-:ftp.host:" 'method
) "ftp"))
1707 (dolist (u '("ftp" "anonymous"))
1708 (should (string-equal (file-remote-p (format "/-:%s@:" u
) 'method
) "ftp")))
1709 ;; Default values in tramp-gvfs.el.
1710 (when (and (load "tramp-gvfs" 'noerror
'nomessage
)
1711 (symbol-value 'tramp-gvfs-enabled
))
1712 (should (string-equal (file-remote-p "/synce::" 'user
) nil
)))
1713 ;; Default values in tramp-sh.el.
1714 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1716 (string-equal (file-remote-p (format "/-:root@%s:" h
) 'method
) "su")))
1717 (dolist (m '("su" "sudo" "ksu"))
1718 (should (string-equal (file-remote-p (format "/%s::" m
) 'user
) "root")))
1719 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1721 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
1722 ;; Default values in tramp-smb.el.
1723 (should (string-equal (file-remote-p "/smb::" 'user
) nil
)))
1725 (ert-deftest tramp-test04-substitute-in-file-name
()
1726 "Check `substitute-in-file-name'."
1727 (should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
1730 (substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
1732 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1735 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1736 ;; Quoting local part.
1739 (substitute-in-file-name "/method:host:/:///foo") "/method:host:/:///foo"))
1742 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1745 (substitute-in-file-name "/method:host:/:/path///foo")
1746 "/method:host:/:/path///foo"))
1749 (substitute-in-file-name "/method:host:/:/path//foo")
1750 "/method:host:/:/path//foo"))
1753 (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
1756 (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
1758 (string-equal (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
1759 ;; (substitute-in-file-name "/path/~foo") expands only for a local
1760 ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
1763 (substitute-in-file-name
1764 "/method:host:/path/~foo") "/method:host:/path/~foo"))
1765 ;; Quoting local part.
1768 (substitute-in-file-name "/method:host:/://~foo") "/method:host:/://~foo"))
1771 (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
1774 (substitute-in-file-name
1775 "/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
1778 (substitute-in-file-name
1779 "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
1781 (let (process-environment)
1784 (substitute-in-file-name "/method:host:/path/$FOO")
1785 "/method:host:/path/$FOO"))
1786 (setenv "FOO" "bla")
1789 (substitute-in-file-name "/method:host:/path/$FOO")
1790 "/method:host:/path/bla"))
1793 (substitute-in-file-name "/method:host:/path/$$FOO")
1794 "/method:host:/path/$FOO"))
1795 ;; Quoting local part.
1798 (substitute-in-file-name "/method:host:/:/path/$FOO")
1799 "/method:host:/:/path/$FOO"))
1800 (setenv "FOO" "bla")
1803 (substitute-in-file-name "/method:host:/:/path/$FOO")
1804 "/method:host:/:/path/$FOO"))
1807 (substitute-in-file-name "/method:host:/:/path/$$FOO")
1808 "/method:host:/:/path/$$FOO"))))
1810 (ert-deftest tramp-test05-expand-file-name
()
1811 "Check `expand-file-name'."
1814 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1817 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1818 ;; Quoting local part.
1821 (expand-file-name "/method:host:/:/path/./file")
1822 "/method:host:/:/path/file"))
1825 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1828 (expand-file-name "/method:host:/:/~/path/./file")
1829 "/method:host:/:/~/path/file")))
1831 ;; The following test is inspired by Bug#26911. It is rather a bug in
1832 ;; `expand-file-name', and it fails for all Emacs versions. Test
1833 ;; added for later, when it is fixed.
1834 (ert-deftest tramp-test05-expand-file-name-relative
()
1835 "Check `expand-file-name'."
1836 ;; Mark as failed until bug has been fixed.
1837 :expected-result
:failed
1838 (skip-unless (tramp--test-enabled))
1839 ;; These are the methods the test doesn't fail.
1840 (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1841 (tramp-smb-file-name-p tramp-test-temporary-file-directory
))
1842 (setf (ert-test-expected-result-type
1843 (ert-get-test 'tramp-test05-expand-file-name-relative
))
1848 (let ((default-directory
1850 (file-remote-p tramp-test-temporary-file-directory
) "/path")))
1851 (expand-file-name ".." "./"))
1852 (concat (file-remote-p tramp-test-temporary-file-directory
) "/"))))
1854 (ert-deftest tramp-test06-directory-file-name
()
1855 "Check `directory-file-name'.
1856 This checks also `file-name-as-directory', `file-name-directory',
1857 `file-name-nondirectory' and `unhandled-file-name-directory'."
1860 (directory-file-name "/method:host:/path/to/file")
1861 "/method:host:/path/to/file"))
1864 (directory-file-name "/method:host:/path/to/file/")
1865 "/method:host:/path/to/file"))
1868 (directory-file-name "/method:host:/path/to/file//")
1869 "/method:host:/path/to/file"))
1872 (file-name-as-directory "/method:host:/path/to/file")
1873 "/method:host:/path/to/file/"))
1876 (file-name-as-directory "/method:host:/path/to/file/")
1877 "/method:host:/path/to/file/"))
1880 (file-name-directory "/method:host:/path/to/file")
1881 "/method:host:/path/to/"))
1884 (file-name-directory "/method:host:/path/to/file/")
1885 "/method:host:/path/to/file/"))
1887 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1889 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1891 (unhandled-file-name-directory "/method:host:/path/to/file"))
1894 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1895 (dolist (n-e '(nil t
))
1896 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1897 ;; which ruins the tests.
1898 (let ((non-essential n-e
)
1899 tramp-default-method
)
1904 (file-remote-p tramp-test-temporary-file-directory
'method
))
1907 (file-remote-p tramp-test-temporary-file-directory
'host
))))
1908 (should (string-equal (directory-file-name file
) file
))
1911 (file-name-as-directory file
)
1912 (if (tramp-completion-mode-p)
1913 file
(concat file
"./"))))
1914 (should (string-equal (file-name-directory file
) file
))
1915 (should (string-equal (file-name-nondirectory file
) "")))))))
1917 (ert-deftest tramp-test07-file-exists-p
()
1918 "Check `file-exist-p', `write-region' and `delete-file'."
1919 (skip-unless (tramp--test-enabled))
1921 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
1922 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1923 (should-not (file-exists-p tmp-name
))
1924 (write-region "foo" nil tmp-name
)
1925 (should (file-exists-p tmp-name
))
1926 (delete-file tmp-name
)
1927 (should-not (file-exists-p tmp-name
)))))
1929 (ert-deftest tramp-test08-file-local-copy
()
1930 "Check `file-local-copy'."
1931 (skip-unless (tramp--test-enabled))
1933 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
1934 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1938 (write-region "foo" nil tmp-name1
)
1939 (should (setq tmp-name2
(file-local-copy tmp-name1
)))
1941 (insert-file-contents tmp-name2
)
1942 (should (string-equal (buffer-string) "foo")))
1943 ;; Check also that a file transfer with compression works.
1944 (let ((default-directory tramp-test-temporary-file-directory
)
1945 (tramp-copy-size-limit 4)
1946 (tramp-inline-compress-start-size 2))
1947 (delete-file tmp-name2
)
1948 (should (setq tmp-name2
(file-local-copy tmp-name1
))))
1950 (delete-file tmp-name1
)
1951 (delete-file tmp-name2
)
1953 (setq tmp-name2
(file-local-copy tmp-name1
))
1954 :type tramp-file-missing
))
1958 (delete-file tmp-name1
)
1959 (delete-file tmp-name2
))))))
1961 (ert-deftest tramp-test09-insert-file-contents
()
1962 "Check `insert-file-contents'."
1963 (skip-unless (tramp--test-enabled))
1965 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
1966 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1969 (write-region "foo" nil tmp-name
)
1970 (insert-file-contents tmp-name
)
1971 (should (string-equal (buffer-string) "foo"))
1972 (insert-file-contents tmp-name
)
1973 (should (string-equal (buffer-string) "foofoo"))
1975 (insert-file-contents tmp-name nil
1 3)
1976 (should (string-equal (buffer-string) "oofoofoo"))
1978 (insert-file-contents tmp-name nil nil nil
'replace
)
1979 (should (string-equal (buffer-string) "foo"))
1981 (delete-file tmp-name
)
1983 (insert-file-contents tmp-name
)
1984 :type tramp-file-missing
))
1987 (ignore-errors (delete-file tmp-name
))))))
1989 (ert-deftest tramp-test10-write-region
()
1990 "Check `write-region'."
1991 (skip-unless (tramp--test-enabled))
1993 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
1994 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1997 ;; Write buffer. Use absolute and relative file name.
2000 (write-region nil nil tmp-name
))
2002 (insert-file-contents tmp-name
)
2003 (should (string-equal (buffer-string) "foo")))
2004 (delete-file tmp-name
)
2007 (should-not (file-exists-p tmp-name
))
2008 (let ((default-directory (file-name-directory tmp-name
)))
2009 (should-not (file-exists-p (file-name-nondirectory tmp-name
)))
2010 (write-region nil nil
(file-name-nondirectory tmp-name
))
2011 (should (file-exists-p (file-name-nondirectory tmp-name
))))
2012 (should (file-exists-p tmp-name
)))
2014 (insert-file-contents tmp-name
)
2015 (should (string-equal (buffer-string) "foo")))
2020 (write-region nil nil tmp-name
'append
))
2022 (insert-file-contents tmp-name
)
2023 (should (string-equal (buffer-string) "foobla")))
2026 (write-region nil nil tmp-name
3))
2028 (insert-file-contents tmp-name
)
2029 (should (string-equal (buffer-string) "foobaz")))
2032 (write-region "foo" nil tmp-name
)
2034 (insert-file-contents tmp-name
)
2035 (should (string-equal (buffer-string) "foo")))
2039 (insert "123456789")
2040 (write-region 3 5 tmp-name
))
2042 (insert-file-contents tmp-name
)
2043 (should (string-equal (buffer-string) "34")))
2046 ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
2047 (with-no-warnings (when (symbol-plist 'ert-with-message-capture
)
2048 (let ((tramp-message-show-message t
))
2049 (dolist (noninteractive '(nil t
))
2050 (dolist (visit '(nil t
"string" no-message
))
2051 (ert-with-message-capture tramp--test-messages
2052 (write-region "foo" nil tmp-name nil visit
)
2053 ;; We must check the last line. There could be
2054 ;; other messages from the progress reporter.
2057 (if (and (null noninteractive
)
2058 (or (eq visit t
) (null visit
) (stringp visit
)))
2059 (format "^Wrote %s\n\\'" tmp-name
) "^\\'")
2060 tramp--test-messages
))))))))
2062 ;; Do not overwrite if excluded.
2063 (cl-letf (((symbol-function 'y-or-n-p
) (lambda (_prompt) t
)))
2064 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
2065 ;; `mustbenew' is passed to Tramp since Emacs 26.1.
2066 (when (tramp--test-emacs26-p)
2068 (cl-letf (((symbol-function 'y-or-n-p
) 'ignore
))
2069 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
2070 :type
'file-already-exists
)
2072 (write-region "foo" nil tmp-name nil nil nil
'excl
)
2073 :type
'file-already-exists
)))
2076 (ignore-errors (delete-file tmp-name
))))))
2078 (ert-deftest tramp-test11-copy-file
()
2079 "Check `copy-file'."
2080 (skip-unless (tramp--test-enabled))
2082 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
2083 (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
2085 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2086 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2087 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
2088 (dolist (source-target
2089 `(;; Copy on remote side.
2090 (,tmp-name1 .
,tmp-name2
)
2091 ;; Copy from remote side to local side.
2092 (,tmp-name1 .
,tmp-name3
)
2093 ;; Copy from local side to remote side.
2094 (,tmp-name3 .
,tmp-name1
)))
2095 (let ((source (car source-target
))
2096 (target (cdr source-target
)))
2098 ;; Copy simple file.
2101 (write-region "foo" nil source
)
2102 (should (file-exists-p source
))
2103 (copy-file source target
)
2104 (should (file-exists-p target
))
2106 (insert-file-contents target
)
2107 (should (string-equal (buffer-string) "foo")))
2108 (when (tramp--test-expensive-test)
2110 (copy-file source target
)
2111 :type
'file-already-exists
))
2112 (copy-file source target
'ok
))
2115 (ignore-errors (delete-file source
))
2116 (ignore-errors (delete-file target
)))
2118 ;; Copy file to directory.
2120 ;; FIXME: This fails on my QNAP server, see
2121 ;; /share/Web/owncloud/data/owncloud.log
2122 (unless (tramp--test-owncloud-p)
2123 (write-region "foo" nil source
)
2124 (should (file-exists-p source
))
2125 (make-directory target
)
2126 (should (file-directory-p target
))
2127 ;; This has been changed in Emacs 26.1.
2128 (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
2130 (copy-file source target
)
2131 :type
'file-already-exists
))
2132 (copy-file source
(file-name-as-directory target
))
2135 (expand-file-name (file-name-nondirectory source
) target
))))
2138 (ignore-errors (delete-file source
))
2139 (ignore-errors (delete-directory target
'recursive
)))
2141 ;; Copy directory to existing directory.
2143 ;; FIXME: This fails on my QNAP server, see
2144 ;; /share/Web/owncloud/data/owncloud.log
2145 (unless (and (tramp--test-owncloud-p)
2146 (or (not (file-remote-p source
))
2147 (not (file-remote-p target
))))
2148 (make-directory source
)
2149 (should (file-directory-p source
))
2150 (write-region "foo" nil
(expand-file-name "foo" source
))
2151 (should (file-exists-p (expand-file-name "foo" source
)))
2152 (make-directory target
)
2153 (should (file-directory-p target
))
2154 ;; Directory `target' exists already, so we must use
2155 ;; `file-name-as-directory'.
2156 (copy-file source
(file-name-as-directory target
))
2160 (concat (file-name-nondirectory source
) "/foo") target
))))
2163 (ignore-errors (delete-directory source
'recursive
))
2164 (ignore-errors (delete-directory target
'recursive
)))
2166 ;; Copy directory/file to non-existing directory.
2168 ;; FIXME: This fails on my QNAP server, see
2169 ;; /share/Web/owncloud/data/owncloud.log
2171 (and (tramp--test-owncloud-p) (not (file-remote-p source
)))
2172 (make-directory source
)
2173 (should (file-directory-p source
))
2174 (write-region "foo" nil
(expand-file-name "foo" source
))
2175 (should (file-exists-p (expand-file-name "foo" source
)))
2176 (make-directory target
)
2177 (should (file-directory-p target
))
2180 (expand-file-name (file-name-nondirectory source
) target
))
2184 (concat (file-name-nondirectory source
) "/foo") target
))))
2187 (ignore-errors (delete-directory source
'recursive
))
2188 (ignore-errors (delete-directory target
'recursive
))))))))
2190 (ert-deftest tramp-test12-rename-file
()
2191 "Check `rename-file'."
2192 (skip-unless (tramp--test-enabled))
2194 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
2195 (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
2197 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2198 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2199 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
2200 (dolist (source-target
2201 `(;; Rename on remote side.
2202 (,tmp-name1 .
,tmp-name2
)
2203 ;; Rename from remote side to local side.
2204 (,tmp-name1 .
,tmp-name3
)
2205 ;; Rename from local side to remote side.
2206 (,tmp-name3 .
,tmp-name1
)))
2207 (let ((source (car source-target
))
2208 (target (cdr source-target
)))
2210 ;; Rename simple file.
2213 (write-region "foo" nil source
)
2214 (should (file-exists-p source
))
2215 (rename-file source target
)
2216 (should-not (file-exists-p source
))
2217 (should (file-exists-p target
))
2219 (insert-file-contents target
)
2220 (should (string-equal (buffer-string) "foo")))
2221 (write-region "foo" nil source
)
2222 (should (file-exists-p source
))
2223 (when (tramp--test-expensive-test)
2225 (rename-file source target
)
2226 :type
'file-already-exists
))
2227 (rename-file source target
'ok
)
2228 (should-not (file-exists-p source
)))
2231 (ignore-errors (delete-file source
))
2232 (ignore-errors (delete-file target
)))
2234 ;; Rename file to directory.
2237 (write-region "foo" nil source
)
2238 (should (file-exists-p source
))
2239 (make-directory target
)
2240 (should (file-directory-p target
))
2241 ;; This has been changed in Emacs 26.1.
2242 (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
2244 (rename-file source target
)
2245 :type
'file-already-exists
))
2246 (rename-file source
(file-name-as-directory target
))
2247 (should-not (file-exists-p source
))
2250 (expand-file-name (file-name-nondirectory source
) target
))))
2253 (ignore-errors (delete-file source
))
2254 (ignore-errors (delete-directory target
'recursive
)))
2256 ;; Rename directory to existing directory.
2258 ;; FIXME: This fails on my QNAP server, see
2259 ;; /share/Web/owncloud/data/owncloud.log
2260 (unless (tramp--test-owncloud-p)
2261 (make-directory source
)
2262 (should (file-directory-p source
))
2263 (write-region "foo" nil
(expand-file-name "foo" source
))
2264 (should (file-exists-p (expand-file-name "foo" source
)))
2265 (make-directory target
)
2266 (should (file-directory-p target
))
2267 ;; Directory `target' exists already, so we must use
2268 ;; `file-name-as-directory'.
2269 (rename-file source
(file-name-as-directory target
))
2270 (should-not (file-exists-p source
))
2274 (concat (file-name-nondirectory source
) "/foo") target
))))
2277 (ignore-errors (delete-directory source
'recursive
))
2278 (ignore-errors (delete-directory target
'recursive
)))
2280 ;; Rename directory/file to non-existing directory.
2282 ;; FIXME: This fails on my QNAP server, see
2283 ;; /share/Web/owncloud/data/owncloud.log
2284 (unless (tramp--test-owncloud-p)
2285 (make-directory source
)
2286 (should (file-directory-p source
))
2287 (write-region "foo" nil
(expand-file-name "foo" source
))
2288 (should (file-exists-p (expand-file-name "foo" source
)))
2289 (make-directory target
)
2290 (should (file-directory-p target
))
2293 (expand-file-name (file-name-nondirectory source
) target
))
2294 (should-not (file-exists-p source
))
2298 (concat (file-name-nondirectory source
) "/foo") target
))))
2301 (ignore-errors (delete-directory source
'recursive
))
2302 (ignore-errors (delete-directory target
'recursive
))))))))
2304 (ert-deftest tramp-test13-make-directory
()
2305 "Check `make-directory'.
2306 This tests also `file-directory-p' and `file-accessible-directory-p'."
2307 (skip-unless (tramp--test-enabled))
2309 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2310 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2311 (tmp-name2 (expand-file-name "foo/bar" tmp-name1
)))
2314 (make-directory tmp-name1
)
2315 (should (file-directory-p tmp-name1
))
2316 (should (file-accessible-directory-p tmp-name1
))
2317 (should-error (make-directory tmp-name2
) :type
'file-error
)
2318 (make-directory tmp-name2
'parents
)
2319 (should (file-directory-p tmp-name2
))
2320 (should (file-accessible-directory-p tmp-name2
))
2321 ;; If PARENTS is non-nil, `make-directory' shall not
2322 ;; signal an error when DIR exists already.
2323 (make-directory tmp-name2
'parents
))
2326 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2328 (ert-deftest tramp-test14-delete-directory
()
2329 "Check `delete-directory'."
2330 (skip-unless (tramp--test-enabled))
2332 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2333 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2334 ;; Delete empty directory.
2335 (make-directory tmp-name
)
2336 (should (file-directory-p tmp-name
))
2337 (delete-directory tmp-name
)
2338 (should-not (file-directory-p tmp-name
))
2339 ;; Delete non-empty directory.
2340 (make-directory tmp-name
)
2341 (should (file-directory-p tmp-name
))
2342 (write-region "foo" nil
(expand-file-name "bla" tmp-name
))
2343 (should (file-exists-p (expand-file-name "bla" tmp-name
)))
2344 (should-error (delete-directory tmp-name
) :type
'file-error
)
2345 (delete-directory tmp-name
'recursive
)
2346 (should-not (file-directory-p tmp-name
)))))
2348 (ert-deftest tramp-test15-copy-directory
()
2349 "Check `copy-directory'."
2350 (skip-unless (tramp--test-enabled))
2352 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2353 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2354 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2355 (tmp-name3 (expand-file-name
2356 (file-name-nondirectory tmp-name1
) tmp-name2
))
2357 (tmp-name4 (expand-file-name "foo" tmp-name1
))
2358 (tmp-name5 (expand-file-name "foo" tmp-name2
))
2359 (tmp-name6 (expand-file-name "foo" tmp-name3
)))
2361 ;; Copy complete directory.
2364 ;; Copy empty directory.
2365 (make-directory tmp-name1
)
2366 (write-region "foo" nil tmp-name4
)
2367 (should (file-directory-p tmp-name1
))
2368 (should (file-exists-p tmp-name4
))
2369 (copy-directory tmp-name1 tmp-name2
)
2370 (should (file-directory-p tmp-name2
))
2371 (should (file-exists-p tmp-name5
))
2372 ;; Target directory does exist already.
2373 ;; This has been changed in Emacs 26.1.
2374 (when (tramp--test-emacs26-p)
2376 (copy-directory tmp-name1 tmp-name2
)
2378 (copy-directory tmp-name1
(file-name-as-directory tmp-name2
))
2379 (should (file-directory-p tmp-name3
))
2380 (should (file-exists-p tmp-name6
)))
2384 (delete-directory tmp-name1
'recursive
)
2385 (delete-directory tmp-name2
'recursive
)))
2387 ;; Copy directory contents.
2390 ;; Copy empty directory.
2391 (make-directory tmp-name1
)
2392 (write-region "foo" nil tmp-name4
)
2393 (should (file-directory-p tmp-name1
))
2394 (should (file-exists-p tmp-name4
))
2395 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
2396 (should (file-directory-p tmp-name2
))
2397 (should (file-exists-p tmp-name5
))
2398 ;; Target directory does exist already.
2399 (delete-file tmp-name5
)
2400 (should-not (file-exists-p tmp-name5
))
2402 tmp-name1
(file-name-as-directory tmp-name2
)
2403 nil
'parents
'contents
)
2404 (should (file-directory-p tmp-name2
))
2405 (should (file-exists-p tmp-name5
))
2406 (should-not (file-directory-p tmp-name3
))
2407 (should-not (file-exists-p tmp-name6
)))
2411 (delete-directory tmp-name1
'recursive
)
2412 (delete-directory tmp-name2
'recursive
))))))
2414 (ert-deftest tramp-test16-directory-files
()
2415 "Check `directory-files'."
2416 (skip-unless (tramp--test-enabled))
2418 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2419 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2420 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2421 (tmp-name3 (expand-file-name "foo" tmp-name1
)))
2424 (make-directory tmp-name1
)
2425 (write-region "foo" nil tmp-name2
)
2426 (write-region "bla" nil tmp-name3
)
2427 (should (file-directory-p tmp-name1
))
2428 (should (file-exists-p tmp-name2
))
2429 (should (file-exists-p tmp-name3
))
2430 (should (equal (directory-files tmp-name1
) '("." ".." "bla" "foo")))
2431 (should (equal (directory-files tmp-name1
'full
)
2432 `(,(concat tmp-name1
"/.")
2433 ,(concat tmp-name1
"/..")
2434 ,tmp-name2
,tmp-name3
)))
2435 (should (equal (directory-files
2436 tmp-name1 nil directory-files-no-dot-files-regexp
)
2438 (should (equal (directory-files
2439 tmp-name1
'full directory-files-no-dot-files-regexp
)
2440 `(,tmp-name2
,tmp-name3
))))
2443 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2445 ;; This is not a file name handler test. But Tramp needed to apply an
2446 ;; advice for older Emacs versions, so we check that this has been fixed.
2447 (ert-deftest tramp-test16-file-expand-wildcards
()
2448 "Check `file-expand-wildcards'."
2449 (skip-unless (tramp--test-enabled))
2451 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2452 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2453 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2454 (tmp-name3 (expand-file-name "bar" tmp-name1
))
2455 (tmp-name4 (expand-file-name "baz" tmp-name1
))
2456 (default-directory tmp-name1
))
2459 (make-directory tmp-name1
)
2460 (write-region "foo" nil tmp-name2
)
2461 (write-region "bar" nil tmp-name3
)
2462 (write-region "baz" nil tmp-name4
)
2463 (should (file-directory-p tmp-name1
))
2464 (should (file-exists-p tmp-name2
))
2465 (should (file-exists-p tmp-name3
))
2466 (should (file-exists-p tmp-name4
))
2468 ;; `sort' works destructive.
2470 (equal (file-expand-wildcards "*")
2471 (sort (copy-sequence '("foo" "bar" "baz")) 'string
<)))
2473 (equal (file-expand-wildcards "ba?")
2474 (sort (copy-sequence '("bar" "baz")) 'string
<)))
2476 (equal (file-expand-wildcards "ba[rz]")
2477 (sort (copy-sequence '("bar" "baz")) 'string
<)))
2481 (file-expand-wildcards "*" 'full
)
2483 (copy-sequence `(,tmp-name2
,tmp-name3
,tmp-name4
)) 'string
<)))
2486 (file-expand-wildcards "ba?" 'full
)
2487 (sort (copy-sequence `(,tmp-name3
,tmp-name4
)) 'string
<)))
2490 (file-expand-wildcards "ba[rz]" 'full
)
2491 (sort (copy-sequence `(,tmp-name3
,tmp-name4
)) 'string
<)))
2495 (file-expand-wildcards (concat tmp-name1
"/" "*"))
2497 (copy-sequence `(,tmp-name2
,tmp-name3
,tmp-name4
)) 'string
<)))
2500 (file-expand-wildcards (concat tmp-name1
"/" "ba?"))
2501 (sort (copy-sequence `(,tmp-name3
,tmp-name4
)) 'string
<)))
2504 (file-expand-wildcards (concat tmp-name1
"/" "ba[rz]"))
2505 (sort (copy-sequence `(,tmp-name3
,tmp-name4
)) 'string
<))))
2509 (delete-directory tmp-name1
'recursive
))))))
2511 (ert-deftest tramp-test17-insert-directory
()
2512 "Check `insert-directory'."
2513 (skip-unless (tramp--test-enabled))
2515 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2517 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2518 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2519 ;; We test for the summary line. Keyword "total" could be localized.
2520 (process-environment
2521 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment
)))
2524 (make-directory tmp-name1
)
2525 (write-region "foo" nil tmp-name2
)
2526 (should (file-directory-p tmp-name1
))
2527 (should (file-exists-p tmp-name2
))
2529 (insert-directory tmp-name1 nil
)
2530 (goto-char (point-min))
2531 (should (looking-at-p (regexp-quote tmp-name1
))))
2532 ;; This has been fixed in Emacs 26.1. See Bug#29423.
2533 (when (tramp--test-emacs26-p)
2535 (insert-directory (file-name-as-directory tmp-name1
) nil
)
2536 (goto-char (point-min))
2539 (regexp-quote (file-name-as-directory tmp-name1
))))))
2541 (insert-directory tmp-name1
"-al")
2542 (goto-char (point-min))
2544 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1
)))))
2546 (insert-directory (file-name-as-directory tmp-name1
) "-al")
2547 (goto-char (point-min))
2549 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1
)))))
2552 (file-name-as-directory tmp-name1
) "-al" nil
'full-directory-p
)
2553 (goto-char (point-min))
2557 ;; There might be a summary line.
2558 "\\(total.+[[:digit:]]+\n\\)?"
2559 ;; We don't know in which order ".", ".." and "foo" appear.
2561 "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
2562 (regexp-opt (directory-files tmp-name1
))
2563 (length (directory-files tmp-name1
))))))))
2566 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2568 (ert-deftest tramp-test17-dired-with-wildcards
()
2569 "Check `dired' with wildcards."
2570 (skip-unless (tramp--test-enabled))
2571 (skip-unless (tramp--test-sh-p))
2572 (skip-unless (not (tramp--test-rsync-p)))
2573 ;; Since Emacs 26.1.
2574 (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p
))
2576 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2578 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2580 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2581 (tmp-name3 (expand-file-name "foo" tmp-name1
))
2582 (tmp-name4 (expand-file-name "bar" tmp-name2
))
2583 (tramp-test-temporary-file-directory
2585 (if quoted
'tramp-compat-file-name-quote
'identity
)
2586 tramp-test-temporary-file-directory
))
2590 (make-directory tmp-name1
)
2591 (write-region "foo" nil tmp-name3
)
2592 (should (file-directory-p tmp-name1
))
2593 (should (file-exists-p tmp-name3
))
2594 (make-directory tmp-name2
)
2595 (write-region "foo" nil tmp-name4
)
2596 (should (file-directory-p tmp-name2
))
2597 (should (file-exists-p tmp-name4
))
2599 ;; Check for expanded directory names.
2600 (with-current-buffer
2604 "tramp-test*" tramp-test-temporary-file-directory
)))
2605 (goto-char (point-min))
2610 tmp-name1 tramp-test-temporary-file-directory
))))
2611 (goto-char (point-min))
2616 tmp-name2 tramp-test-temporary-file-directory
)))))
2617 (kill-buffer buffer
)
2619 ;; Check for expanded directory and file names.
2620 (with-current-buffer
2624 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2625 (goto-char (point-min))
2630 tmp-name3 tramp-test-temporary-file-directory
))))
2631 (goto-char (point-min))
2637 tramp-test-temporary-file-directory
)))))
2638 (kill-buffer buffer
)
2640 ;; Check for special characters.
2641 (setq tmp-name3
(expand-file-name "*?" tmp-name1
))
2642 (setq tmp-name4
(expand-file-name "[a-z0-9]" tmp-name2
))
2643 (write-region "foo" nil tmp-name3
)
2644 (should (file-exists-p tmp-name3
))
2645 (write-region "foo" nil tmp-name4
)
2646 (should (file-exists-p tmp-name4
))
2648 (with-current-buffer
2652 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2653 (goto-char (point-min))
2658 tmp-name3 tramp-test-temporary-file-directory
))))
2659 (goto-char (point-min))
2665 tramp-test-temporary-file-directory
)))))
2666 (kill-buffer buffer
))
2669 (ignore-errors (kill-buffer buffer
))
2670 (ignore-errors (delete-directory tmp-name1
'recursive
))
2671 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2673 ;; Method "smb" supports `make-symbolic-link' only if the remote host
2674 ;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
2675 ;; support symbolic links at all.
2676 (defmacro tramp--test-ignore-make-symbolic-link-error
(&rest body
)
2677 "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
2678 (declare (indent defun
) (debug t
))
2679 `(condition-case err
2682 (unless (and (eq (car err
) 'file-error
)
2683 (string-equal (error-message-string err
)
2684 "make-symbolic-link not supported"))
2685 (signal (car err
) (cdr err
))))))
2687 (ert-deftest tramp-test18-file-attributes
()
2688 "Check `file-attributes'.
2689 This tests also `file-readable-p', `file-regular-p' and
2690 `file-ownership-preserved-p'."
2691 (skip-unless (tramp--test-enabled))
2693 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2694 ;; We must use `file-truename' for the temporary directory,
2695 ;; because it could be located on a symlinked directory. This
2696 ;; would let the test fail.
2697 (let* ((tramp-test-temporary-file-directory
2698 (file-truename tramp-test-temporary-file-directory
))
2699 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2700 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2701 ;; File name with "//".
2705 (file-remote-p tmp-name1
)
2706 (replace-regexp-in-string
2707 "/" "//" (file-remote-p tmp-name1
'localname
))))
2711 ;; `file-ownership-preserved-p' should return t for
2712 ;; non-existing files. It is implemented only in tramp-sh.el.
2713 (when (tramp--test-sh-p)
2714 (should (file-ownership-preserved-p tmp-name1
'group
)))
2715 (write-region "foo" nil tmp-name1
)
2716 (should (file-exists-p tmp-name1
))
2717 (should (file-readable-p tmp-name1
))
2718 (should (file-regular-p tmp-name1
))
2719 (when (tramp--test-sh-p)
2720 (should (file-ownership-preserved-p tmp-name1
'group
)))
2722 ;; We do not test inodes and device numbers.
2723 (setq attr
(file-attributes tmp-name1
))
2724 (should (consp attr
))
2725 (should (null (car attr
)))
2726 (should (numberp (nth 1 attr
))) ;; Link.
2727 (should (numberp (nth 2 attr
))) ;; Uid.
2728 (should (numberp (nth 3 attr
))) ;; Gid.
2729 ;; Last access time.
2730 (should (stringp (current-time-string (nth 4 attr
))))
2731 ;; Last modification time.
2732 (should (stringp (current-time-string (nth 5 attr
))))
2733 ;; Last status change time.
2734 (should (stringp (current-time-string (nth 6 attr
))))
2735 (should (numberp (nth 7 attr
))) ;; Size.
2736 (should (stringp (nth 8 attr
))) ;; Modes.
2738 (setq attr
(file-attributes tmp-name1
'string
))
2739 (should (stringp (nth 2 attr
))) ;; Uid.
2740 (should (stringp (nth 3 attr
))) ;; Gid.
2742 (tramp--test-ignore-make-symbolic-link-error
2743 (when (tramp--test-sh-p)
2744 (should (file-ownership-preserved-p tmp-name2
'group
)))
2745 (make-symbolic-link tmp-name1 tmp-name2
)
2746 (should (file-exists-p tmp-name2
))
2747 (should (file-symlink-p tmp-name2
))
2748 (when (tramp--test-sh-p)
2749 (should (file-ownership-preserved-p tmp-name2
'group
)))
2750 (setq attr
(file-attributes tmp-name2
))
2754 (if quoted
'tramp-compat-file-name-quote
'identity
)
2756 (file-remote-p (file-truename tmp-name1
) 'localname
)))
2757 (delete-file tmp-name2
))
2759 ;; Check, that "//" in symlinks are handled properly.
2761 (let ((default-directory tramp-test-temporary-file-directory
))
2765 (tramp-file-name-localname
2766 (tramp-dissect-file-name tmp-name3
))
2767 (tramp-file-name-localname
2768 (tramp-dissect-file-name tmp-name2
)))
2770 (when (file-symlink-p tmp-name2
)
2771 (setq attr
(file-attributes tmp-name2
))
2775 (tramp-file-name-localname
2776 (tramp-dissect-file-name tmp-name3
))))
2777 (delete-file tmp-name2
))
2779 (when (tramp--test-sh-p)
2780 (should (file-ownership-preserved-p tmp-name1
'group
)))
2781 (delete-file tmp-name1
)
2782 (make-directory tmp-name1
)
2783 (should (file-exists-p tmp-name1
))
2784 (should (file-readable-p tmp-name1
))
2785 (should-not (file-regular-p tmp-name1
))
2786 (when (tramp--test-sh-p)
2787 (should (file-ownership-preserved-p tmp-name1
'group
)))
2788 (setq attr
(file-attributes tmp-name1
))
2789 (should (eq (car attr
) t
)))
2792 (ignore-errors (delete-directory tmp-name1
))
2793 (ignore-errors (delete-file tmp-name1
))
2794 (ignore-errors (delete-file tmp-name2
))))))
2796 (ert-deftest tramp-test19-directory-files-and-attributes
()
2797 "Check `directory-files-and-attributes'."
2798 (skip-unless (tramp--test-enabled))
2800 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2801 ;; `directory-files-and-attributes' contains also values for
2802 ;; "../". Ensure that this doesn't change during tests, for
2803 ;; example due to handling temporary files.
2804 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2805 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2809 (make-directory tmp-name1
)
2810 (should (file-directory-p tmp-name1
))
2811 (make-directory tmp-name2
)
2812 (should (file-directory-p tmp-name2
))
2813 (write-region "foo" nil
(expand-file-name "foo" tmp-name2
))
2814 (write-region "bar" nil
(expand-file-name "bar" tmp-name2
))
2815 (write-region "boz" nil
(expand-file-name "boz" tmp-name2
))
2816 (setq attr
(directory-files-and-attributes tmp-name2
))
2817 (should (consp attr
))
2818 ;; Dumb remote shells without perl(1) or stat(1) are not
2819 ;; able to return the date correctly. They say "don't know".
2824 5 (file-attributes (expand-file-name (car elt
) tmp-name2
)))
2827 (equal (file-attributes (expand-file-name (car elt
) tmp-name2
))
2829 (setq attr
(directory-files-and-attributes tmp-name2
'full
))
2831 (unless (equal (nth 5 (file-attributes (car elt
))) '(0 0))
2833 (equal (file-attributes (car elt
)) (cdr elt
)))))
2834 (setq attr
(directory-files-and-attributes tmp-name2 nil
"^b"))
2835 (should (equal (mapcar 'car attr
) '("bar" "boz"))))
2838 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2840 (ert-deftest tramp-test20-file-modes
()
2841 "Check `file-modes'.
2842 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2843 (skip-unless (tramp--test-enabled))
2844 (skip-unless (tramp--test-sh-p))
2846 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2847 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2850 (write-region "foo" nil tmp-name
)
2851 (should (file-exists-p tmp-name
))
2852 (set-file-modes tmp-name
#o777
)
2853 (should (= (file-modes tmp-name
) #o777
))
2854 (should (file-executable-p tmp-name
))
2855 (should (file-writable-p tmp-name
))
2856 (set-file-modes tmp-name
#o444
)
2857 (should (= (file-modes tmp-name
) #o444
))
2858 (should-not (file-executable-p tmp-name
))
2859 ;; A file is always writable for user "root".
2860 (unless (zerop (nth 2 (file-attributes tmp-name
)))
2861 (should-not (file-writable-p tmp-name
))))
2864 (ignore-errors (delete-file tmp-name
))))))
2866 (ert-deftest tramp-test21-file-links
()
2867 "Check `file-symlink-p'.
2868 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2869 (skip-unless (tramp--test-enabled))
2870 ;; The semantics has changed heavily in Emacs 26.1. We cannot test
2871 ;; older Emacsen, therefore.
2872 (skip-unless (tramp--test-emacs26-p))
2874 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
2875 ;; We must use `file-truename' for the temporary directory,
2876 ;; because it could be located on a symlinked directory. This
2877 ;; would let the test fail.
2878 (let* ((tramp-test-temporary-file-directory
2879 (file-truename tramp-test-temporary-file-directory
))
2880 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2881 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2882 (tmp-name3 (tramp--test-make-temp-name 'local quoted
))
2883 (tmp-name4 (tramp--test-make-temp-name nil quoted
))
2885 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name4
)))
2886 ;; Check `make-symbolic-link'.
2888 (tramp--test-ignore-make-symbolic-link-error
2889 (write-region "foo" nil tmp-name1
)
2890 (should (file-exists-p tmp-name1
))
2891 (make-symbolic-link tmp-name1 tmp-name2
)
2895 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2896 (file-remote-p tmp-name1
'localname
))
2897 (file-symlink-p tmp-name2
)))
2898 (when (tramp--test-expensive-test)
2900 (make-symbolic-link tmp-name1 tmp-name2
)
2901 :type
'file-already-exists
))
2902 (when (tramp--test-expensive-test)
2903 ;; A number means interactive case.
2904 (cl-letf (((symbol-function 'yes-or-no-p
) 'ignore
))
2906 (make-symbolic-link tmp-name1 tmp-name2
0)
2907 :type
'file-already-exists
)))
2908 (cl-letf (((symbol-function 'yes-or-no-p
) (lambda (_prompt) t
)))
2909 (make-symbolic-link tmp-name1 tmp-name2
0)
2913 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2914 (file-remote-p tmp-name1
'localname
))
2915 (file-symlink-p tmp-name2
))))
2916 (make-symbolic-link tmp-name1 tmp-name2
'ok-if-already-exists
)
2920 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2921 (file-remote-p tmp-name1
'localname
))
2922 (file-symlink-p tmp-name2
)))
2923 ;; If we use the local part of `tmp-name1', it shall still work.
2925 (file-remote-p tmp-name1
'localname
)
2926 tmp-name2
'ok-if-already-exists
)
2930 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2931 (file-remote-p tmp-name1
'localname
))
2932 (file-symlink-p tmp-name2
)))
2933 ;; `tmp-name3' is a local file name. Therefore, the link
2934 ;; target remains unchanged, even if quoted.
2935 ;; `make-symbolic-link' might not be permitted on w32 systems.
2936 (unless (tramp--test-windows-nt)
2937 (make-symbolic-link tmp-name1 tmp-name3
)
2939 (string-equal tmp-name1
(file-symlink-p tmp-name3
))))
2940 ;; Check directory as newname.
2941 (make-directory tmp-name4
)
2942 (when (tramp--test-expensive-test)
2944 (make-symbolic-link tmp-name1 tmp-name4
)
2945 :type
'file-already-exists
))
2946 (make-symbolic-link tmp-name1
(file-name-as-directory tmp-name4
))
2950 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2951 (file-remote-p tmp-name1
'localname
))
2952 (file-symlink-p tmp-name5
)))
2953 ;; `smbclient' does not show symlinks in directories, so
2954 ;; we cannot delete a non-empty directory. We delete the
2956 (delete-file tmp-name5
))
2960 (delete-file tmp-name1
)
2961 (delete-file tmp-name2
)
2962 (delete-file tmp-name3
)
2963 (delete-directory tmp-name4
'recursive
)))
2965 ;; Check `add-name-to-file'.
2967 (when (tramp--test-expensive-test)
2968 (write-region "foo" nil tmp-name1
)
2969 (should (file-exists-p tmp-name1
))
2970 (add-name-to-file tmp-name1 tmp-name2
)
2971 (should (file-regular-p tmp-name2
))
2973 (add-name-to-file tmp-name1 tmp-name2
)
2974 :type
'file-already-exists
)
2975 ;; A number means interactive case.
2976 (cl-letf (((symbol-function 'yes-or-no-p
) 'ignore
))
2978 (add-name-to-file tmp-name1 tmp-name2
0)
2979 :type
'file-already-exists
))
2980 (cl-letf (((symbol-function 'yes-or-no-p
) (lambda (_prompt) t
)))
2981 (add-name-to-file tmp-name1 tmp-name2
0)
2982 (should (file-regular-p tmp-name2
)))
2983 (add-name-to-file tmp-name1 tmp-name2
'ok-if-already-exists
)
2984 (should-not (file-symlink-p tmp-name2
))
2985 (should (file-regular-p tmp-name2
))
2986 ;; `tmp-name3' is a local file name.
2988 (add-name-to-file tmp-name1 tmp-name3
)
2990 ;; Check directory as newname.
2991 (make-directory tmp-name4
)
2993 (add-name-to-file tmp-name1 tmp-name4
)
2994 :type
'file-already-exists
)
2995 (add-name-to-file tmp-name1
(file-name-as-directory tmp-name4
))
2998 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name4
))))
3002 (delete-file tmp-name1
)
3003 (delete-file tmp-name2
)
3004 (delete-directory tmp-name4
'recursive
)))
3006 ;; Check `file-truename'.
3008 (tramp--test-ignore-make-symbolic-link-error
3009 (write-region "foo" nil tmp-name1
)
3010 (should (file-exists-p tmp-name1
))
3011 (should (string-equal tmp-name1
(file-truename tmp-name1
)))
3012 (make-symbolic-link tmp-name1 tmp-name2
)
3013 (should (file-symlink-p tmp-name2
))
3014 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
3016 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
)))
3017 (should (file-equal-p tmp-name1 tmp-name2
))
3018 ;; Check relative symlink file name.
3019 (delete-file tmp-name2
)
3020 (let ((default-directory tramp-test-temporary-file-directory
))
3021 (make-symbolic-link (file-name-nondirectory tmp-name1
) tmp-name2
))
3022 (should (file-symlink-p tmp-name2
))
3023 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
3025 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
)))
3026 (should (file-equal-p tmp-name1 tmp-name2
))
3027 ;; Symbolic links could look like a remote file name.
3028 ;; They must be quoted then.
3029 (delete-file tmp-name2
)
3032 (if quoted
'tramp-compat-file-name-unquote
'identity
)
3035 (should (file-symlink-p tmp-name2
))
3038 (file-truename tmp-name2
)
3039 (tramp-compat-file-name-quote
3040 (concat (file-remote-p tmp-name2
) "/penguin:motd:"))))
3041 ;; `tmp-name3' is a local file name.
3042 ;; `make-symbolic-link' might not be permitted on w32 systems.
3043 (unless (tramp--test-windows-nt)
3044 (make-symbolic-link tmp-name1 tmp-name3
)
3045 (should (file-symlink-p tmp-name3
))
3046 (should-not (string-equal tmp-name3
(file-truename tmp-name3
)))
3047 ;; `file-truename' returns a quoted file name for `tmp-name3'.
3048 ;; We must unquote it.
3052 (if (tramp--test-emacs27-p)
3053 'tramp-compat-file-name-unquote
'identity
)
3054 (file-truename tmp-name1
))
3055 (tramp-compat-file-name-unquote (file-truename tmp-name3
))))))
3059 (delete-file tmp-name1
)
3060 (delete-file tmp-name2
)
3061 (delete-file tmp-name3
)))
3063 ;; Symbolic links could be nested.
3065 (tramp--test-ignore-make-symbolic-link-error
3066 (make-directory tmp-name1
)
3067 (should (file-directory-p tmp-name1
))
3068 (let* ((tramp-test-temporary-file-directory
3069 (file-truename tmp-name1
))
3070 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
3071 (tmp-name3 tmp-name2
)
3072 (number-nesting 15))
3073 (dotimes (_ number-nesting
)
3076 (setq tmp-name3
(tramp--test-make-temp-name nil quoted
))))
3079 (file-truename tmp-name2
)
3080 (file-truename tmp-name3
)))
3081 (when (tramp--test-expensive-test)
3083 (with-temp-buffer (insert-file-contents tmp-name2
))
3084 :type tramp-file-missing
))
3085 (when (tramp--test-expensive-test)
3087 (with-temp-buffer (insert-file-contents tmp-name3
))
3088 :type tramp-file-missing
))
3089 ;; `directory-files' does not show symlinks to
3090 ;; non-existing targets in the "smb" case. So we remove
3091 ;; the symlinks manually.
3092 (while (stringp (setq tmp-name2
(file-symlink-p tmp-name3
)))
3093 (delete-file tmp-name3
)
3094 (setq tmp-name3
(concat (file-remote-p tmp-name3
) tmp-name2
)))))
3097 (ignore-errors (delete-directory tmp-name1
'recursive
)))
3099 ;; Detect cyclic symbolic links.
3101 (when (tramp--test-expensive-test)
3102 (tramp--test-ignore-make-symbolic-link-error
3103 (make-symbolic-link tmp-name2 tmp-name1
)
3104 (should (file-symlink-p tmp-name1
))
3105 (if (tramp-smb-file-name-p tramp-test-temporary-file-directory
)
3106 ;; The symlink command of `smbclient' detects the
3109 (make-symbolic-link tmp-name1 tmp-name2
)
3111 (make-symbolic-link tmp-name1 tmp-name2
)
3112 (should (file-symlink-p tmp-name2
))
3113 (should-error (file-truename tmp-name1
) :type
'file-error
))))
3117 (delete-file tmp-name1
)
3118 (delete-file tmp-name2
)))
3120 ;; `file-truename' shall preserve trailing slash of directories.
3122 (directory-file-name
3124 (if quoted
'tramp-compat-file-name-quote
'identity
)
3125 tramp-test-temporary-file-directory
)))
3126 (dir2 (file-name-as-directory dir1
)))
3127 (should (string-equal (file-truename dir1
) (expand-file-name dir1
)))
3128 (should (string-equal (file-truename dir2
) (expand-file-name dir2
)))))))
3130 (ert-deftest tramp-test22-file-times
()
3131 "Check `set-file-times' and `file-newer-than-file-p'."
3132 (skip-unless (tramp--test-enabled))
3133 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3135 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3136 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
3137 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
3138 (tmp-name3 (tramp--test-make-temp-name nil quoted
)))
3141 (write-region "foo" nil tmp-name1
)
3142 (should (file-exists-p tmp-name1
))
3143 (should (consp (nth 5 (file-attributes tmp-name1
))))
3144 ;; '(0 0) means don't know, and will be replaced by
3145 ;; `current-time'. Therefore, we use '(0 1). We skip the
3146 ;; test, if the remote handler is not able to set the
3148 (skip-unless (set-file-times tmp-name1
'(0 1)))
3149 ;; Dumb remote shells without perl(1) or stat(1) are not
3150 ;; able to return the date correctly. They say "don't know".
3151 (unless (equal (nth 5 (file-attributes tmp-name1
)) '(0 0))
3152 (should (equal (nth 5 (file-attributes tmp-name1
)) '(0 1)))
3153 (write-region "bla" nil tmp-name2
)
3154 (should (file-exists-p tmp-name2
))
3155 (should (file-newer-than-file-p tmp-name2 tmp-name1
))
3156 ;; `tmp-name3' does not exist.
3157 (should (file-newer-than-file-p tmp-name2 tmp-name3
))
3158 (should-not (file-newer-than-file-p tmp-name3 tmp-name1
))))
3162 (delete-file tmp-name1
)
3163 (delete-file tmp-name2
))))))
3165 (ert-deftest tramp-test23-visited-file-modtime
()
3166 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
3167 (skip-unless (tramp--test-enabled))
3169 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3170 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
3173 (write-region "foo" nil tmp-name
)
3174 (should (file-exists-p tmp-name
))
3176 (insert-file-contents tmp-name
)
3177 (should (verify-visited-file-modtime))
3178 (set-visited-file-modtime '(0 1))
3179 (should (verify-visited-file-modtime))
3180 (should (equal (visited-file-modtime) '(0 1 0 0)))))
3183 (ignore-errors (delete-file tmp-name
))))))
3185 ;; This test is inspired by Bug#29149.
3186 (ert-deftest tramp-test24-file-acl
()
3187 "Check that `file-acl' and `set-file-acl' work proper."
3188 (skip-unless (tramp--test-enabled))
3189 (skip-unless (file-acl tramp-test-temporary-file-directory
))
3191 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
3192 (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
3194 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
3195 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
3196 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
3197 ;; Both files are remote.
3200 ;; Two files with same ACLs.
3201 (write-region "foo" nil tmp-name1
)
3202 (should (file-exists-p tmp-name1
))
3203 (should (file-acl tmp-name1
))
3204 (copy-file tmp-name1 tmp-name2 nil nil nil
'preserve-permissions
)
3205 (should (file-acl tmp-name2
))
3206 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name2
)))
3207 ;; Different permissions mean different ACLs.
3208 (when (not (tramp--test-windows-nt-or-smb-p))
3209 (set-file-modes tmp-name1
#o777
)
3210 (set-file-modes tmp-name2
#o444
)
3212 (string-equal (file-acl tmp-name1
) (file-acl tmp-name2
))))
3213 ;; Copy ACL. Not all remote handlers support it, so we test.
3214 (when (set-file-acl tmp-name2
(file-acl tmp-name1
))
3215 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name2
))))
3216 ;; An invalid ACL does not harm.
3217 (should-not (set-file-acl tmp-name2
"foo")))
3220 (ignore-errors (delete-file tmp-name1
))
3221 (ignore-errors (delete-file tmp-name2
)))
3223 ;; Remote and local file.
3225 (when (and (file-acl temporary-file-directory
)
3226 (not (tramp--test-windows-nt-or-smb-p)))
3227 ;; Two files with same ACLs.
3228 (write-region "foo" nil tmp-name1
)
3229 (should (file-exists-p tmp-name1
))
3230 (should (file-acl tmp-name1
))
3231 (copy-file tmp-name1 tmp-name3 nil nil nil
'preserve-permissions
)
3232 (should (file-acl tmp-name3
))
3233 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
)))
3234 ;; Different permissions mean different ACLs.
3235 (set-file-modes tmp-name1
#o777
)
3236 (set-file-modes tmp-name3
#o444
)
3238 (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
)))
3239 ;; Copy ACL. Since we don't know whether Emacs is built
3240 ;; with local ACL support, we must check it.
3241 (when (set-file-acl tmp-name3
(file-acl tmp-name1
))
3242 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
))))
3244 ;; Two files with same ACLs.
3245 (delete-file tmp-name1
)
3246 (copy-file tmp-name3 tmp-name1 nil nil nil
'preserve-permissions
)
3247 (should (file-acl tmp-name1
))
3248 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
)))
3249 ;; Different permissions mean different ACLs.
3250 (set-file-modes tmp-name1
#o777
)
3251 (set-file-modes tmp-name3
#o444
)
3253 (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
)))
3255 (set-file-acl tmp-name1
(file-acl tmp-name3
))
3256 (should (string-equal (file-acl tmp-name1
) (file-acl tmp-name3
))))
3259 (ignore-errors (delete-file tmp-name1
))
3260 (ignore-errors (delete-file tmp-name3
))))))
3262 (ert-deftest tramp-test25-file-selinux
()
3263 "Check `file-selinux-context' and `set-file-selinux-context'."
3264 (skip-unless (tramp--test-enabled))
3266 (not (equal (file-selinux-context tramp-test-temporary-file-directory
)
3267 '(nil nil nil nil
))))
3269 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
3270 (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
3272 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
3273 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
3274 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
3275 ;; Both files are remote.
3278 ;; Two files with same SELinux context.
3279 (write-region "foo" nil tmp-name1
)
3280 (should (file-exists-p tmp-name1
))
3281 (should (file-selinux-context tmp-name1
))
3282 (copy-file tmp-name1 tmp-name2
)
3283 (should (file-selinux-context tmp-name2
))
3286 (file-selinux-context tmp-name1
)
3287 (file-selinux-context tmp-name2
)))
3288 ;; Check different SELinux context. We cannot support
3289 ;; different ranges in this test; let's assume the most
3291 (let ((context (file-selinux-context tmp-name1
)))
3292 (when (and (string-equal (nth 3 context
) "s0")
3293 (setcar (nthcdr 3 context
) "s0:c0")
3294 (set-file-selinux-context tmp-name1 context
))
3297 (file-selinux-context tmp-name1
)
3298 (file-selinux-context tmp-name2
)))))
3299 ;; Copy SELinux context.
3301 (set-file-selinux-context
3302 tmp-name2
(file-selinux-context tmp-name1
)))
3305 (file-selinux-context tmp-name1
)
3306 (file-selinux-context tmp-name2
)))
3307 ;; An invalid SELinux context does not harm.
3308 (should-not (set-file-selinux-context tmp-name2
"foo")))
3311 (ignore-errors (delete-file tmp-name1
))
3312 (ignore-errors (delete-file tmp-name2
)))
3314 ;; Remote and local file.
3317 (or (equal (file-selinux-context temporary-file-directory
)
3319 (tramp--test-windows-nt-or-smb-p)))
3320 ;; Both users shall use the same SELinux context.
3322 (let ((default-directory temporary-file-directory
))
3323 (shell-command-to-string "id -Z"))
3324 (let ((default-directory
3325 tramp-test-temporary-file-directory
))
3326 (shell-command-to-string "id -Z"))))
3328 ;; Two files with same SELinux context.
3329 (write-region "foo" nil tmp-name1
)
3330 (should (file-exists-p tmp-name1
))
3331 (should (file-selinux-context tmp-name1
))
3332 (copy-file tmp-name1 tmp-name3
)
3333 (should (file-selinux-context tmp-name3
))
3334 ;; We cannot expect that copying over file system
3335 ;; boundaries keeps SELinux context. So we copy it
3338 (set-file-selinux-context
3339 tmp-name3
(file-selinux-context tmp-name1
)))
3342 (file-selinux-context tmp-name1
)
3343 (file-selinux-context tmp-name3
)))
3344 ;; Check different SELinux context. We cannot support
3345 ;; different ranges in this test; let's assume the most
3347 (let ((context (file-selinux-context tmp-name1
)))
3348 (when (and (string-equal (nth 3 context
) "s0")
3349 (setcar (nthcdr 3 context
) "s0:c0")
3350 (set-file-selinux-context tmp-name1 context
))
3353 (file-selinux-context tmp-name1
)
3354 (file-selinux-context tmp-name3
)))))
3355 ;; Copy SELinux context.
3357 (set-file-selinux-context
3358 tmp-name3
(file-selinux-context tmp-name1
)))
3361 (file-selinux-context tmp-name1
)
3362 (file-selinux-context tmp-name3
)))
3364 ;; Two files with same SELinux context.
3365 (delete-file tmp-name1
)
3366 (copy-file tmp-name3 tmp-name1
)
3367 (should (file-selinux-context tmp-name1
))
3368 ;; We cannot expect that copying over file system
3369 ;; boundaries keeps SELinux context. So we copy it
3372 (set-file-selinux-context
3373 tmp-name1
(file-selinux-context tmp-name3
)))
3376 (file-selinux-context tmp-name1
)
3377 (file-selinux-context tmp-name3
)))
3378 ;; Check different SELinux context. We cannot support
3379 ;; different ranges in this test; let's assume the most
3381 (let ((context (file-selinux-context tmp-name3
)))
3382 (when (and (string-equal (nth 3 context
) "s0")
3383 (setcar (nthcdr 3 context
) "s0:c0")
3384 (set-file-selinux-context tmp-name3 context
))
3387 (file-selinux-context tmp-name1
)
3388 (file-selinux-context tmp-name3
)))))
3389 ;; Copy SELinux context.
3391 (set-file-selinux-context
3392 tmp-name1
(file-selinux-context tmp-name3
)))
3395 (file-selinux-context tmp-name1
)
3396 (file-selinux-context tmp-name3
))))
3399 (ignore-errors (delete-file tmp-name1
))
3400 (ignore-errors (delete-file tmp-name3
))))))
3402 (ert-deftest tramp-test26-file-name-completion
()
3403 "Check `file-name-completion' and `file-name-all-completions'."
3404 (skip-unless (tramp--test-enabled))
3406 ;; Method and host name in completion mode. This kind of completion
3407 ;; does not work on MS Windows.
3408 (when (not (memq system-type
'(cygwin windows-nt
)))
3409 (let ((method (file-remote-p tramp-test-temporary-file-directory
'method
))
3410 (host (file-remote-p tramp-test-temporary-file-directory
'host
))
3411 (orig-syntax tramp-syntax
))
3412 (when (and (stringp host
) (string-match tramp-host-with-port-regexp host
))
3413 (setq host
(match-string 1 host
)))
3418 (if (tramp--test-expensive-test)
3419 (tramp-syntax-values) `(,orig-syntax
)))
3420 (tramp-change-syntax syntax
)
3421 (let ;; This is needed for the `simplified' syntax.
3423 (if (zerop (length tramp-method-regexp
))
3424 "" tramp-default-method-marker
))
3425 ;; This is needed for the `separate' syntax.
3426 (prefix-format (substring tramp-prefix-format
1)))
3427 ;; Complete method name.
3428 (unless (or (zerop (length method
))
3429 (zerop (length tramp-method-regexp
)))
3432 (concat prefix-format method tramp-postfix-method-format
)
3433 (file-name-all-completions
3434 (concat prefix-format
(substring method
0 1)) "/"))))
3435 ;; Complete host name for default method. With gvfs
3436 ;; based methods, host name will be determined as
3437 ;; host.local, so we omit the test.
3438 (let ((tramp-default-method (or method tramp-default-method
)))
3439 (unless (or (zerop (length host
))
3440 (tramp--test-gvfs-p tramp-default-method
))
3444 prefix-format method-marker tramp-postfix-method-format
3445 host tramp-postfix-host-format
)
3446 (file-name-all-completions
3448 prefix-format method-marker tramp-postfix-method-format
3449 (substring host
0 1))
3451 ;; Complete host name.
3452 (unless (or (zerop (length method
))
3453 (zerop (length tramp-method-regexp
))
3454 (zerop (length host
))
3455 (tramp--test-gvfs-p method
))
3459 prefix-format method tramp-postfix-method-format
3460 host tramp-postfix-host-format
)
3461 (file-name-all-completions
3462 (concat prefix-format method tramp-postfix-method-format
)
3466 (tramp-change-syntax orig-syntax
))))
3468 (dolist (n-e '(nil t
))
3469 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3470 (let ((non-essential n-e
)
3471 (tmp-name (tramp--test-make-temp-name nil quoted
)))
3476 (make-directory tmp-name
)
3477 (should (file-directory-p tmp-name
))
3478 (write-region "foo" nil
(expand-file-name "foo" tmp-name
))
3479 (should (file-exists-p (expand-file-name "foo" tmp-name
)))
3480 (write-region "bar" nil
(expand-file-name "bold" tmp-name
))
3481 (should (file-exists-p (expand-file-name "bold" tmp-name
)))
3482 (make-directory (expand-file-name "boz" tmp-name
))
3483 (should (file-directory-p (expand-file-name "boz" tmp-name
)))
3484 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
3485 (should (equal (file-name-completion "foo" tmp-name
) t
))
3486 (should (equal (file-name-completion "b" tmp-name
) "bo"))
3487 (should-not (file-name-completion "a" tmp-name
))
3490 (file-name-completion "b" tmp-name
'file-directory-p
) "boz/"))
3492 (equal (file-name-all-completions "fo" tmp-name
) '("foo")))
3495 (sort (file-name-all-completions "b" tmp-name
) 'string-lessp
)
3497 (should-not (file-name-all-completions "a" tmp-name
))
3498 ;; `completion-regexp-list' restricts the completion to
3499 ;; files which match all expressions in this list.
3500 (let ((completion-regexp-list
3501 `(,directory-files-no-dot-files-regexp
"b")))
3503 (equal (file-name-completion "" tmp-name
) "bo"))
3506 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
3508 ;; `file-name-completion' ignores file names that end in
3509 ;; any string in `completion-ignored-extensions'.
3510 (let ((completion-ignored-extensions '(".ext")))
3511 (write-region "foo" nil
(expand-file-name "foo.ext" tmp-name
))
3512 (should (file-exists-p (expand-file-name "foo.ext" tmp-name
)))
3513 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
3514 (should (equal (file-name-completion "foo" tmp-name
) t
))
3516 (equal (file-name-completion "foo." tmp-name
) "foo.ext"))
3517 (should (equal (file-name-completion "foo.ext" tmp-name
) t
))
3518 ;; `file-name-all-completions' is not affected.
3521 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
3522 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
3525 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
3527 (ert-deftest tramp-test27-load
()
3529 (skip-unless (tramp--test-enabled))
3531 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3532 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
3535 (load tmp-name
'noerror
'nomessage
)
3536 (should-not (featurep 'tramp-test-load
))
3537 (write-region "(provide 'tramp-test-load)" nil tmp-name
)
3538 ;; `load' in lread.c does not pass `must-suffix'. Why?
3540 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
3541 ;; :type 'file-error)
3542 (load tmp-name nil
'nomessage
'nosuffix
)
3543 (should (featurep 'tramp-test-load
)))
3547 (and (featurep 'tramp-test-load
) (unload-feature 'tramp-test-load
))
3548 (delete-file tmp-name
))))))
3550 (ert-deftest tramp-test28-process-file
()
3551 "Check `process-file'."
3552 :tags
'(:expensive-test
)
3553 (skip-unless (tramp--test-enabled))
3554 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3556 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3557 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
3558 (fnnd (file-name-nondirectory tmp-name
))
3559 (default-directory tramp-test-temporary-file-directory
)
3560 kill-buffer-query-functions
)
3563 ;; We cannot use "/bin/true" and "/bin/false"; those paths
3564 ;; do not exist on hydra.
3565 (should (zerop (process-file "true")))
3566 (should-not (zerop (process-file "false")))
3567 (should-not (zerop (process-file "binary-does-not-exist")))
3569 (write-region "foo" nil tmp-name
)
3570 (should (file-exists-p tmp-name
))
3571 (should (zerop (process-file "ls" nil t nil fnnd
)))
3572 ;; `ls' could produce colorized output.
3573 (goto-char (point-min))
3575 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3576 (replace-match "" nil nil
))
3577 (should (string-equal (format "%s\n" fnnd
) (buffer-string)))
3578 (should-not (get-buffer-window (current-buffer) t
))
3580 ;; Second run. The output must be appended.
3581 (goto-char (point-max))
3582 (should (zerop (process-file "ls" nil t t fnnd
)))
3583 ;; `ls' could produce colorized output.
3584 (goto-char (point-min))
3586 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3587 (replace-match "" nil nil
))
3589 (string-equal (format "%s\n%s\n" fnnd fnnd
) (buffer-string)))
3590 ;; A non-nil DISPLAY must not raise the buffer.
3591 (should-not (get-buffer-window (current-buffer) t
))))
3594 (ignore-errors (delete-file tmp-name
))))))
3596 (ert-deftest tramp-test29-start-file-process
()
3597 "Check `start-file-process'."
3598 :tags
'(:expensive-test
)
3599 (skip-unless (tramp--test-enabled))
3600 (skip-unless (tramp--test-sh-p))
3602 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3603 (let ((default-directory tramp-test-temporary-file-directory
)
3604 (tmp-name (tramp--test-make-temp-name nil quoted
))
3605 kill-buffer-query-functions proc
)
3608 (setq proc
(start-file-process "test1" (current-buffer) "cat"))
3609 (should (processp proc
))
3610 (should (equal (process-status proc
) 'run
))
3611 (process-send-string proc
"foo")
3612 (process-send-eof proc
)
3614 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3615 (while (< (- (point-max) (point-min)) (length "foo"))
3616 (accept-process-output proc
0.1)))
3617 (should (string-equal (buffer-string) "foo")))
3620 (ignore-errors (delete-process proc
)))
3624 (write-region "foo" nil tmp-name
)
3625 (should (file-exists-p tmp-name
))
3628 "test2" (current-buffer)
3629 "cat" (file-name-nondirectory tmp-name
)))
3630 (should (processp proc
))
3632 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3633 (while (< (- (point-max) (point-min)) (length "foo"))
3634 (accept-process-output proc
0.1)))
3635 (should (string-equal (buffer-string) "foo")))
3639 (delete-process proc
)
3640 (delete-file tmp-name
)))
3644 (setq proc
(start-file-process "test3" (current-buffer) "cat"))
3645 (should (processp proc
))
3646 (should (equal (process-status proc
) 'run
))
3649 (lambda (p s
) (with-current-buffer (process-buffer p
) (insert s
))))
3650 (process-send-string proc
"foo")
3651 (process-send-eof proc
)
3653 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3654 (while (< (- (point-max) (point-min)) (length "foo"))
3655 (accept-process-output proc
0.1)))
3656 (should (string-equal (buffer-string) "foo")))
3659 (ignore-errors (delete-process proc
))))))
3661 (ert-deftest tramp-test30-interrupt-process
()
3662 "Check `interrupt-process'."
3663 :tags
'(:expensive-test
)
3664 (skip-unless (tramp--test-enabled))
3665 (skip-unless (tramp--test-sh-p))
3666 ;; Since Emacs 26.1.
3667 (skip-unless (boundp 'interrupt-process-functions
))
3669 (let ((default-directory tramp-test-temporary-file-directory
)
3670 kill-buffer-query-functions proc
)
3673 (setq proc
(start-file-process "test" (current-buffer) "sleep" "10"))
3674 (should (processp proc
))
3675 (should (process-live-p proc
))
3676 (should (equal (process-status proc
) 'run
))
3677 (should (numberp (process-get proc
'remote-pid
)))
3678 (should (interrupt-process proc
))
3679 ;; Let the process accept the interrupt.
3680 (accept-process-output proc
1 nil
0)
3681 (should-not (process-live-p proc
))
3682 ;; An interrupted process cannot be interrupted, again.
3683 (should-error (interrupt-process proc
) :type
'error
))
3686 (ignore-errors (delete-process proc
)))))
3688 (ert-deftest tramp-test31-shell-command
()
3689 "Check `shell-command'."
3690 :tags
'(:expensive-test
)
3691 (skip-unless (tramp--test-enabled))
3692 (skip-unless (tramp--test-sh-p))
3694 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3695 (let ((tmp-name (tramp--test-make-temp-name nil quoted
))
3696 (default-directory tramp-test-temporary-file-directory
)
3697 ;; Suppress nasty messages.
3699 kill-buffer-query-functions
)
3702 (write-region "foo" nil tmp-name
)
3703 (should (file-exists-p tmp-name
))
3705 (format "ls %s" (file-name-nondirectory tmp-name
))
3707 ;; `ls' could produce colorized output.
3708 (goto-char (point-min))
3710 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3711 (replace-match "" nil nil
))
3714 (format "%s\n" (file-name-nondirectory tmp-name
))
3718 (ignore-errors (delete-file tmp-name
)))
3722 (write-region "foo" nil tmp-name
)
3723 (should (file-exists-p tmp-name
))
3724 (async-shell-command
3725 (format "ls %s" (file-name-nondirectory tmp-name
))
3728 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3729 (while (< (- (point-max) (point-min))
3730 (1+ (length (file-name-nondirectory tmp-name
))))
3731 (accept-process-output
3732 (get-buffer-process (current-buffer)) 0.1)))
3733 ;; `ls' could produce colorized output.
3734 (goto-char (point-min))
3736 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3737 (replace-match "" nil nil
))
3738 ;; There might be a nasty "Process *Async Shell* finished" message.
3739 (goto-char (point-min))
3741 (narrow-to-region (point-min) (point))
3744 (format "%s\n" (file-name-nondirectory tmp-name
))
3748 (ignore-errors (delete-file tmp-name
)))
3752 (write-region "foo" nil tmp-name
)
3753 (should (file-exists-p tmp-name
))
3754 (async-shell-command "read line; ls $line" (current-buffer))
3755 (process-send-string
3756 (get-buffer-process (current-buffer))
3757 (format "%s\n" (file-name-nondirectory tmp-name
)))
3759 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3760 (while (< (- (point-max) (point-min))
3761 (1+ (length (file-name-nondirectory tmp-name
))))
3762 (accept-process-output
3763 (get-buffer-process (current-buffer)) 0.1)))
3764 ;; `ls' could produce colorized output.
3765 (goto-char (point-min))
3767 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3768 (replace-match "" nil nil
))
3769 ;; There might be a nasty "Process *Async Shell* finished" message.
3770 (goto-char (point-min))
3772 (narrow-to-region (point-min) (point))
3775 (format "%s\n" (file-name-nondirectory tmp-name
))
3779 (ignore-errors (delete-file tmp-name
))))))
3781 (defun tramp--test-shell-command-to-string-asynchronously (command)
3782 "Like `shell-command-to-string', but for asynchronous processes."
3784 (async-shell-command command
(current-buffer))
3786 (while (get-buffer-process (current-buffer))
3787 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3788 (accept-process-output nil
0.1)
3789 (buffer-substring-no-properties (point-min) (point-max))))
3791 ;; This test is inspired by Bug#23952.
3792 (ert-deftest tramp-test32-environment-variables
()
3793 "Check that remote processes set / unset environment variables properly."
3794 :tags
'(:expensive-test
)
3795 (skip-unless (tramp--test-enabled))
3796 (skip-unless (tramp--test-sh-p))
3798 (dolist (this-shell-command-to-string
3800 shell-command-to-string
3802 tramp--test-shell-command-to-string-asynchronously
))
3804 (let ((default-directory tramp-test-temporary-file-directory
)
3805 (shell-file-name "/bin/sh")
3806 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3807 kill-buffer-query-functions
)
3811 (let ((process-environment
3812 (cons (concat envvar
"=foo") process-environment
)))
3818 this-shell-command-to-string
3819 (format "echo -n ${%s:?bla}" envvar
))))))
3822 ;; Set the empty value.
3823 (let ((process-environment
3824 (cons (concat envvar
"=") process-environment
)))
3830 this-shell-command-to-string
3831 (format "echo -n ${%s:?bla}" envvar
))))
3835 (regexp-quote envvar
)
3836 (funcall this-shell-command-to-string
"set")))))
3838 ;; We force a reconnect, in order to have a clean environment.
3839 (tramp-cleanup-connection
3840 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3841 'keep-debug
'keep-password
)
3843 ;; Unset the variable.
3844 (let ((tramp-remote-process-environment
3845 (cons (concat envvar
"=foo")
3846 tramp-remote-process-environment
)))
3847 ;; Set the initial value, we want to unset below.
3852 this-shell-command-to-string
3853 (format "echo -n ${%s:?bla}" envvar
))))
3854 (let ((process-environment
3855 (cons envvar process-environment
)))
3856 ;; Variable is unset.
3861 this-shell-command-to-string
3862 (format "echo -n ${%s:?bla}" envvar
))))
3863 ;; Variable is unset.
3866 (regexp-quote envvar
)
3867 (funcall this-shell-command-to-string
"set")))))))))
3869 ;; This test is inspired by Bug#27009.
3870 (ert-deftest tramp-test32-environment-variables-and-port-numbers
()
3871 "Check that two connections with separate ports are different."
3872 (skip-unless (tramp--test-enabled))
3873 ;; We test it only for the mock-up connection; otherwise there might
3874 ;; be problems with the used ports.
3875 (skip-unless (and (eq tramp-syntax
'default
)
3876 (tramp--test-mock-p)))
3878 ;; We force a reconnect, in order to have a clean environment.
3879 (dolist (dir `(,tramp-test-temporary-file-directory
3880 "/mock:localhost#11111:" "/mock:localhost#22222:"))
3881 (tramp-cleanup-connection
3882 (tramp-dissect-file-name dir
) 'keep-debug
'keep-password
))
3885 (dolist (port '(11111 22222))
3886 (let* ((default-directory
3887 (format "/mock:localhost#%d:%s" port temporary-file-directory
))
3888 (shell-file-name "/bin/sh")
3889 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3890 ;; We cannot use `process-environment', because this
3891 ;; would be applied in `process-file'.
3892 (tramp-remote-process-environment
3894 (format "%s=%d" envvar port
)
3895 tramp-remote-process-environment
)))
3898 (number-to-string port
)
3899 (shell-command-to-string (format "echo -n $%s" envvar
))))))
3902 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3903 (tramp-cleanup-connection (tramp-dissect-file-name dir
)))))
3905 ;; The functions were introduced in Emacs 26.1.
3906 (ert-deftest tramp-test33-explicit-shell-file-name
()
3907 "Check that connection-local `explicit-shell-file-name' is set."
3908 :tags
'(:expensive-test
)
3909 (skip-unless (tramp--test-enabled))
3910 (skip-unless (tramp--test-sh-p))
3911 ;; Since Emacs 26.1.
3912 (skip-unless (and (fboundp 'connection-local-set-profile-variables
)
3913 (fboundp 'connection-local-set-profiles
)))
3915 ;; `connection-local-set-profile-variables' and
3916 ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't
3917 ;; want to see compiler warnings for older Emacsen.
3918 (let ((default-directory tramp-test-temporary-file-directory
)
3919 explicit-shell-file-name kill-buffer-query-functions
)
3922 ;; `shell-mode' would ruin our test, because it deletes all
3923 ;; buffer local variables.
3924 (put 'explicit-shell-file-name
'permanent-local t
)
3925 ;; Declare connection-local variable `explicit-shell-file-name'.
3927 (connection-local-set-profile-variables
3929 '((explicit-shell-file-name .
"/bin/sh")
3930 (explicit-sh-args .
("-i"))))
3931 (connection-local-set-profiles
3932 `(:application tramp
3933 :protocol
,(file-remote-p default-directory
'method
)
3934 :user
,(file-remote-p default-directory
'user
)
3935 :machine
,(file-remote-p default-directory
'host
))
3938 ;; Run interactive shell. Since the default directory is
3939 ;; remote, `explicit-shell-file-name' shall be set in order
3940 ;; to avoid a question.
3941 (with-current-buffer (get-buffer-create "*shell*")
3942 (ignore-errors (kill-process (current-buffer)))
3943 (should-not explicit-shell-file-name
)
3944 (call-interactively 'shell
)
3945 (should explicit-shell-file-name
)))
3947 (put 'explicit-shell-file-name
'permanent-local nil
)
3948 (kill-buffer "*shell*"))))
3950 (ert-deftest tramp-test34-vc-registered
()
3951 "Check `vc-registered'."
3952 :tags
'(:expensive-test
)
3953 (skip-unless (tramp--test-enabled))
3954 (skip-unless (tramp--test-sh-p))
3956 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
3957 (let* ((default-directory tramp-test-temporary-file-directory
)
3958 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
3959 (tmp-name2 (expand-file-name "foo" tmp-name1
))
3960 (tramp-remote-process-environment tramp-remote-process-environment
)
3961 (vc-handled-backends
3962 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3964 ((tramp-find-executable
3965 v vc-git-program
(tramp-get-remote-path v
))
3967 ((tramp-find-executable
3968 v vc-hg-program
(tramp-get-remote-path v
))
3970 ((tramp-find-executable
3971 v vc-bzr-program
(tramp-get-remote-path v
))
3972 (setq tramp-remote-process-environment
3973 (cons (format "BZR_HOME=%s"
3974 (file-remote-p tmp-name1
'localname
))
3975 tramp-remote-process-environment
))
3976 ;; We must force a reconnect, in order to activate $BZR_HOME.
3977 (tramp-cleanup-connection
3978 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3979 'keep-debug
'keep-password
)
3982 ;; Suppress nasty messages.
3983 (inhibit-message t
))
3984 (skip-unless vc-handled-backends
)
3985 (unless quoted
(tramp--test-message "%s" vc-handled-backends
))
3989 (make-directory tmp-name1
)
3990 (write-region "foo" nil tmp-name2
)
3991 (should (file-directory-p tmp-name1
))
3992 (should (file-exists-p tmp-name2
))
3993 (should-not (vc-registered tmp-name1
))
3994 (should-not (vc-registered tmp-name2
))
3996 (let ((default-directory tmp-name1
))
3997 ;; Create empty repository, and register the file.
3998 ;; Sometimes, creation of repository fails (bzr!); we
3999 ;; skip the test then.
4001 (vc-create-repo (car vc-handled-backends
))
4002 (error (skip-unless nil
)))
4003 ;; The structure of VC-FILESET is not documented. Let's
4004 ;; hope it won't change.
4007 (list (car vc-handled-backends
)
4008 (list (file-name-nondirectory tmp-name2
))))
4009 ;; `vc-register' has changed its arguments in Emacs
4010 ;; 25.1. Let's skip it for older Emacsen.
4011 (error (skip-unless (>= emacs-major-version
25))))
4012 ;; vc-git uses an own process sentinel, Tramp's sentinel
4013 ;; for flushing the cache isn't used.
4014 (dired-uncache (concat (file-remote-p default-directory
) "/"))
4015 (should (vc-registered (file-name-nondirectory tmp-name2
)))))
4018 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
4020 (ert-deftest tramp-test35-make-auto-save-file-name
()
4021 "Check `make-auto-save-file-name'."
4022 (skip-unless (tramp--test-enabled))
4024 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
4025 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
4026 (tmp-name2 (tramp--test-make-temp-name nil quoted
)))
4030 ;; Use default `auto-save-file-name-transforms' mechanism.
4031 (let (tramp-auto-save-directory)
4033 (setq buffer-file-name tmp-name1
)
4036 (make-auto-save-file-name)
4037 ;; This is taken from original `make-auto-save-file-name'.
4038 ;; We call `convert-standard-filename', because on
4039 ;; MS Windows the (local) colons must be replaced by
4040 ;; exclamation marks.
4041 (convert-standard-filename
4045 (subst-char-in-string
4046 ?
/ ?
! (replace-regexp-in-string "!" "!!" tmp-name1
)))
4047 temporary-file-directory
))))))
4050 (let (tramp-auto-save-directory auto-save-file-name-transforms
)
4052 (setq buffer-file-name tmp-name1
)
4055 (make-auto-save-file-name)
4057 (if quoted
'tramp-compat-file-name-quote
'identity
)
4059 (format "#%s#" (file-name-nondirectory tmp-name1
))
4060 tramp-test-temporary-file-directory
))))))
4062 ;; Use default `tramp-auto-save-directory' mechanism.
4063 (let ((tramp-auto-save-directory tmp-name2
))
4065 (setq buffer-file-name tmp-name1
)
4068 (make-auto-save-file-name)
4069 ;; This is taken from Tramp.
4073 (tramp-subst-strs-in-string
4080 (tramp-compat-file-name-unquote tmp-name1
)))
4082 (should (file-directory-p tmp-name2
))))
4084 ;; Relative file names shall work, too.
4085 (let ((tramp-auto-save-directory "."))
4087 (setq buffer-file-name tmp-name1
4088 default-directory tmp-name2
)
4091 (make-auto-save-file-name)
4092 ;; This is taken from Tramp.
4096 (tramp-subst-strs-in-string
4103 (tramp-compat-file-name-unquote tmp-name1
)))
4105 (should (file-directory-p tmp-name2
)))))
4108 (ignore-errors (delete-file tmp-name1
))
4109 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
4111 (ert-deftest tramp-test36-find-backup-file-name
()
4112 "Check `find-backup-file-name'."
4113 (skip-unless (tramp--test-enabled))
4115 (dolist (quoted (if (tramp--test-expensive-test) '(nil t
) '(nil)))
4116 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
4117 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
4118 ;; These settings are not used by Tramp, so we ignore them.
4119 version-control delete-old-versions
4120 (kept-old-versions (default-toplevel-value 'kept-old-versions
))
4121 (kept-new-versions (default-toplevel-value 'kept-new-versions
)))
4124 ;; Use default `backup-directory-alist' mechanism.
4125 (let (backup-directory-alist tramp-backup-directory-alist
)
4128 (find-backup-file-name tmp-name1
)
4131 (if quoted
'tramp-compat-file-name-quote
'identity
)
4133 (format "%s~" (file-name-nondirectory tmp-name1
))
4134 tramp-test-temporary-file-directory
)))))))
4137 ;; Map `backup-directory-alist'.
4138 (let ((backup-directory-alist `(("." .
,tmp-name2
)))
4139 tramp-backup-directory-alist
)
4142 (find-backup-file-name tmp-name1
)
4145 (if quoted
'tramp-compat-file-name-quote
'identity
)
4149 ;; This is taken from `make-backup-file-name-1'. We
4150 ;; call `convert-standard-filename', because on MS
4151 ;; Windows the (local) colons must be replaced by
4152 ;; exclamation marks.
4153 (subst-char-in-string
4155 (replace-regexp-in-string
4156 "!" "!!" (convert-standard-filename tmp-name1
))))
4158 ;; The backup directory is created.
4159 (should (file-directory-p tmp-name2
)))
4162 (ignore-errors (delete-directory tmp-name2
'recursive
)))
4165 ;; Map `tramp-backup-directory-alist'.
4166 (let ((tramp-backup-directory-alist `(("." .
,tmp-name2
)))
4167 backup-directory-alist
)
4170 (find-backup-file-name tmp-name1
)
4173 (if quoted
'tramp-compat-file-name-quote
'identity
)
4177 ;; This is taken from `make-backup-file-name-1'. We
4178 ;; call `convert-standard-filename', because on MS
4179 ;; Windows the (local) colons must be replaced by
4180 ;; exclamation marks.
4181 (subst-char-in-string
4183 (replace-regexp-in-string
4184 "!" "!!" (convert-standard-filename tmp-name1
))))
4186 ;; The backup directory is created.
4187 (should (file-directory-p tmp-name2
)))
4190 (ignore-errors (delete-directory tmp-name2
'recursive
)))
4193 ;; Map `tramp-backup-directory-alist' with local file name.
4194 (let ((tramp-backup-directory-alist
4195 `(("." .
,(file-remote-p tmp-name2
'localname
))))
4196 backup-directory-alist
)
4199 (find-backup-file-name tmp-name1
)
4202 (if quoted
'tramp-compat-file-name-quote
'identity
)
4206 ;; This is taken from `make-backup-file-name-1'. We
4207 ;; call `convert-standard-filename', because on MS
4208 ;; Windows the (local) colons must be replaced by
4209 ;; exclamation marks.
4210 (subst-char-in-string
4212 (replace-regexp-in-string
4213 "!" "!!" (convert-standard-filename tmp-name1
))))
4215 ;; The backup directory is created.
4216 (should (file-directory-p tmp-name2
)))
4219 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
4221 ;; The functions were introduced in Emacs 26.1.
4222 (ert-deftest tramp-test37-make-nearby-temp-file
()
4223 "Check `make-nearby-temp-file' and `temporary-file-directory'."
4224 (skip-unless (tramp--test-enabled))
4225 ;; Since Emacs 26.1.
4227 (and (fboundp 'make-nearby-temp-file
) (fboundp 'temporary-file-directory
)))
4229 ;; `make-nearby-temp-file' and `temporary-file-directory' exists
4230 ;; since Emacs 26.1. We don't want to see compiler warnings for
4232 (let ((default-directory tramp-test-temporary-file-directory
)
4234 ;; The remote host shall know a temporary file directory.
4235 (should (stringp (with-no-warnings (temporary-file-directory))))
4238 (file-remote-p default-directory
)
4239 (file-remote-p (with-no-warnings (temporary-file-directory)))))
4241 ;; The temporary file shall be located on the remote host.
4242 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test")))
4243 (should (file-exists-p tmp-file
))
4244 (should (file-regular-p tmp-file
))
4247 (file-remote-p default-directory
)
4248 (file-remote-p tmp-file
)))
4249 (delete-file tmp-file
)
4250 (should-not (file-exists-p tmp-file
))
4252 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test" 'dir
)))
4253 (should (file-exists-p tmp-file
))
4254 (should (file-directory-p tmp-file
))
4255 (delete-directory tmp-file
)
4256 (should-not (file-exists-p tmp-file
))))
4258 (defun tramp--test-emacs26-p ()
4259 "Check for Emacs version >= 26.1.
4260 Some semantics has been changed for there, w/o new functions or
4261 variables, so we check the Emacs version directly."
4262 (>= emacs-major-version
26))
4264 (defun tramp--test-emacs27-p ()
4265 "Check for Emacs version >= 27.1.
4266 Some semantics has been changed for there, w/o new functions or
4267 variables, so we check the Emacs version directly."
4268 (>= emacs-major-version
27))
4270 (defun tramp--test-adb-p ()
4271 "Check, whether the remote host runs Android.
4272 This requires restrictions of file name syntax."
4273 (tramp-adb-file-name-p tramp-test-temporary-file-directory
))
4275 (defun tramp--test-docker-p ()
4276 "Check, whether the docker method is used.
4277 This does not support some special file names."
4279 "docker" (file-remote-p tramp-test-temporary-file-directory
'method
)))
4281 (defun tramp--test-ftp-p ()
4282 "Check, whether an FTP-like method is used.
4283 This does not support globbing characters in file names (yet)."
4284 ;; Globbing characters are ??, ?* and ?\[.
4286 "ftp$" (file-remote-p tramp-test-temporary-file-directory
'method
)))
4288 (defun tramp--test-gvfs-p (&optional method
)
4289 "Check, whether the remote host runs a GVFS based method.
4290 This requires restrictions of file name syntax."
4291 (or (member method tramp-gvfs-methods
)
4292 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory
)))
4294 (defun tramp--test-hpux-p ()
4295 "Check, whether the remote host runs HP-UX.
4296 Several special characters do not work properly there."
4297 ;; We must refill the cache. `file-truename' does it.
4298 (with-parsed-tramp-file-name
4299 (file-truename tramp-test-temporary-file-directory
) nil
4300 (string-match "^HP-UX" (tramp-get-connection-property v
"uname" ""))))
4302 (defun tramp--test-mock-p ()
4303 "Check, whether the mock method is used.
4304 This does not support external Emacs calls."
4306 "mock" (file-remote-p tramp-test-temporary-file-directory
'method
)))
4308 (defun tramp--test-owncloud-p ()
4309 "Check, whether the owncloud method is used."
4311 "owncloud" (file-remote-p tramp-test-temporary-file-directory
'method
)))
4313 (defun tramp--test-rsync-p ()
4314 "Check, whether the rsync method is used.
4315 This does not support special file names."
4317 "rsync" (file-remote-p tramp-test-temporary-file-directory
'method
)))
4319 (defun tramp--test-sh-p ()
4320 "Check, whether the remote host runs a based method from tramp-sh.el."
4322 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
4323 'tramp-sh-file-name-handler
))
4325 (defun tramp--test-windows-nt ()
4326 "Check, whether the locale host runs MS Windows."
4327 (eq system-type
'windows-nt
))
4329 (defun tramp--test-windows-nt-and-batch ()
4330 "Check, whether the locale host runs MS Windows in batch mode.
4331 This does not support special characters."
4332 (and (eq system-type
'windows-nt
) noninteractive
))
4334 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
4335 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
4336 This does not support utf8 based file transfer."
4337 (and (eq system-type
'windows-nt
)
4339 (regexp-opt '("pscp" "psftp"))
4340 (file-remote-p tramp-test-temporary-file-directory
'method
))))
4342 (defun tramp--test-windows-nt-or-smb-p ()
4343 "Check, whether the locale or remote host runs MS Windows.
4344 This requires restrictions of file name syntax."
4345 (or (eq system-type
'windows-nt
)
4346 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)))
4348 (defun tramp--test-check-files (&rest files
)
4349 "Run a simple but comprehensive test over every file in FILES."
4350 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
4351 (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
4353 ;; We must use `file-truename' for the temporary directory,
4354 ;; because it could be located on a symlinked directory. This
4355 ;; would let the test fail.
4356 (let* ((tramp-test-temporary-file-directory
4357 (file-truename tramp-test-temporary-file-directory
))
4358 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
4359 (tmp-name2 (tramp--test-make-temp-name 'local quoted
))
4360 (files (delq nil files
))
4361 (process-environment process-environment
))
4364 (make-directory tmp-name1
)
4365 (make-directory tmp-name2
)
4368 (let* ((file1 (expand-file-name elt tmp-name1
))
4369 (file2 (expand-file-name elt tmp-name2
))
4370 (file3 (expand-file-name (concat elt
"foo") tmp-name1
)))
4371 (write-region elt nil file1
)
4372 (should (file-exists-p file1
))
4374 ;; Check file contents.
4376 (insert-file-contents file1
)
4377 (should (string-equal (buffer-string) elt
)))
4379 ;; Copy file both directions.
4380 (copy-file file1
(file-name-as-directory tmp-name2
))
4381 (should (file-exists-p file2
))
4383 (should-not (file-exists-p file1
))
4384 (copy-file file2
(file-name-as-directory tmp-name1
))
4385 (should (file-exists-p file1
))
4387 (tramp--test-ignore-make-symbolic-link-error
4388 (make-symbolic-link file1 file3
)
4389 (should (file-symlink-p file3
))
4392 (expand-file-name file1
) (file-truename file3
)))
4396 (if quoted
'tramp-compat-file-name-quote
'identity
)
4397 (car (file-attributes file3
)))
4398 (file-remote-p (file-truename file1
) 'localname
)))
4399 ;; Check file contents.
4401 (insert-file-contents file3
)
4402 (should (string-equal (buffer-string) elt
)))
4403 (delete-file file3
))))
4405 ;; Check file names.
4406 (should (equal (directory-files
4407 tmp-name1 nil directory-files-no-dot-files-regexp
)
4408 (sort (copy-sequence files
) 'string-lessp
)))
4409 (should (equal (directory-files
4410 tmp-name2 nil directory-files-no-dot-files-regexp
)
4411 (sort (copy-sequence files
) 'string-lessp
)))
4413 ;; `substitute-in-file-name' could return different
4414 ;; values. For `adb', there could be strange file
4415 ;; permissions preventing overwriting a file. We don't
4416 ;; care in this testcase.
4419 (substitute-in-file-name (expand-file-name elt tmp-name1
)))
4421 (substitute-in-file-name
4422 (expand-file-name elt tmp-name2
))))
4423 (ignore-errors (write-region elt nil file1
))
4424 (should (file-exists-p file1
))
4425 (ignore-errors (write-region elt nil file2 nil
'nomessage
))
4426 (should (file-exists-p file2
))))
4428 (should (equal (directory-files
4429 tmp-name1 nil directory-files-no-dot-files-regexp
)
4431 tmp-name2 nil directory-files-no-dot-files-regexp
)))
4433 ;; Check directory creation. We use a subdirectory "foo"
4434 ;; in order to avoid conflicts with previous file name tests.
4436 (let* ((elt1 (concat elt
"foo"))
4437 (file1 (expand-file-name (concat "foo/" elt
) tmp-name1
))
4438 (file2 (expand-file-name elt file1
))
4439 (file3 (expand-file-name elt1 file1
)))
4440 (make-directory file1
'parents
)
4441 (should (file-directory-p file1
))
4442 (write-region elt nil file2
)
4443 (should (file-exists-p file2
))
4447 file1 nil directory-files-no-dot-files-regexp
)
4451 (caar (directory-files-and-attributes
4452 file1 nil directory-files-no-dot-files-regexp
))
4455 ;; Check symlink in `directory-files-and-attributes'.
4456 ;; It does not work in the "smb" case, only relative
4457 ;; symlinks to existing files are shown there.
4458 (tramp--test-ignore-make-symbolic-link-error
4460 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)
4461 (make-symbolic-link file2 file3
)
4462 (should (file-symlink-p file3
))
4465 (caar (directory-files-and-attributes
4466 file1 nil
(regexp-quote elt1
)))
4471 (if quoted
'tramp-compat-file-name-quote
'identity
)
4472 (cadr (car (directory-files-and-attributes
4473 file1 nil
(regexp-quote elt1
)))))
4474 (file-remote-p (file-truename file2
) 'localname
)))
4476 (should-not (file-exists-p file3
))))
4479 (should-not (file-exists-p file2
))
4480 (delete-directory file1
)
4481 (should-not (file-exists-p file1
))))
4483 ;; Check, that environment variables are set correctly.
4484 (when (and (tramp--test-expensive-test) (tramp--test-sh-p))
4486 (let ((envvar (concat "VAR_" (upcase (md5 elt
))))
4487 (elt (encode-coding-string elt coding-system-for-read
))
4488 (default-directory tramp-test-temporary-file-directory
)
4489 (process-environment process-environment
))
4491 ;; The value of PS1 could confuse Tramp's detection
4492 ;; of process output. So we unset it temporarily.
4495 (should (zerop (process-file "env" nil t nil
)))
4496 (goto-char (point-min))
4501 (regexp-quote envvar
)
4502 (regexp-quote (getenv envvar
))))))))))
4505 (ignore-errors (delete-directory tmp-name1
'recursive
))
4506 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
4508 (defun tramp--test-special-characters ()
4509 "Perform the test in `tramp-test38-special-characters*'."
4510 ;; Newlines, slashes and backslashes in file names are not
4511 ;; supported. So we don't test. And we don't test the tab
4512 ;; character on Windows or Cygwin, because the backslash is
4513 ;; interpreted as a path separator, preventing "\t" from being
4514 ;; expanded to <TAB>.
4517 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4519 (if (or (tramp--test-adb-p)
4520 (tramp--test-docker-p)
4521 (eq system-type
'cygwin
))
4528 (unless (or (tramp--test-ftp-p)
4529 (tramp--test-gvfs-p)
4530 (tramp--test-windows-nt-or-smb-p))
4532 (unless (or (tramp--test-ftp-p)
4533 (tramp--test-gvfs-p)
4534 (tramp--test-windows-nt-or-smb-p))
4536 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4540 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4543 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4546 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4549 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
4551 ;; Simplify test in order to speed up.
4552 (apply 'tramp--test-check-files
4553 (if (tramp--test-expensive-test)
4554 files
(list (mapconcat 'identity files
""))))))
4556 ;; These tests are inspired by Bug#17238.
4557 (ert-deftest tramp-test38-special-characters
()
4558 "Check special characters in file names."
4559 (skip-unless (tramp--test-enabled))
4560 (skip-unless (not (tramp--test-rsync-p)))
4561 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4563 (tramp--test-special-characters))
4565 (ert-deftest tramp-test38-special-characters-with-stat
()
4566 "Check special characters in file names.
4567 Use the `stat' command."
4568 :tags
'(:expensive-test
)
4569 (skip-unless (tramp--test-enabled))
4570 (skip-unless (tramp--test-sh-p))
4571 (skip-unless (not (tramp--test-rsync-p)))
4572 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4573 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4574 (skip-unless (tramp-get-remote-stat v
)))
4576 (let ((tramp-connection-properties
4578 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4580 tramp-connection-properties
)))
4581 (tramp--test-special-characters)))
4583 (ert-deftest tramp-test38-special-characters-with-perl
()
4584 "Check special characters in file names.
4585 Use the `perl' command."
4586 :tags
'(:expensive-test
)
4587 (skip-unless (tramp--test-enabled))
4588 (skip-unless (tramp--test-sh-p))
4589 (skip-unless (not (tramp--test-rsync-p)))
4590 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4591 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4592 (skip-unless (tramp-get-remote-perl v
)))
4594 (let ((tramp-connection-properties
4596 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4598 ;; See `tramp-sh-handle-file-truename'.
4599 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4601 tramp-connection-properties
)))
4602 (tramp--test-special-characters)))
4604 (ert-deftest tramp-test38-special-characters-with-ls
()
4605 "Check special characters in file names.
4606 Use the `ls' command."
4607 :tags
'(:expensive-test
)
4608 (skip-unless (tramp--test-enabled))
4609 (skip-unless (tramp--test-sh-p))
4610 (skip-unless (not (tramp--test-rsync-p)))
4611 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4612 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4614 (let ((tramp-connection-properties
4616 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4618 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4620 ;; See `tramp-sh-handle-file-truename'.
4621 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4623 tramp-connection-properties
)))
4624 (tramp--test-special-characters)))
4626 (defun tramp--test-utf8 ()
4627 "Perform the test in `tramp-test39-utf8*'."
4628 (let* ((utf8 (if (and (eq system-type
'darwin
)
4629 (memq 'utf-8-hfs
(coding-system-list)))
4631 (coding-system-for-read utf8
)
4632 (coding-system-for-write utf8
)
4633 (file-name-coding-system
4634 (coding-system-change-eol-conversion utf8
'unix
)))
4636 'tramp--test-check-files
4637 (if (tramp--test-expensive-test)
4640 ;; Use all available language specific snippets. Filter
4641 ;; out strings which use unencodable characters. Remove
4642 ;; slash or newline. Not Tramp's business.
4644 (setq x
(eval (cdr (assoc 'sample-text x
))))
4645 (unless (or (null x
)
4646 (unencodable-char-position
4647 nil nil file-name-coding-system nil x
)
4648 (string-match "TaiViet" x
))
4649 (replace-regexp-in-string "[\n/]" "" x
)))
4650 language-info-alist
))
4653 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
4654 (unless (tramp--test-hpux-p)
4655 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
4657 "Автостопом по гала́ктике")))))
4659 (ert-deftest tramp-test39-utf8
()
4660 "Check UTF8 encoding in file names and file contents."
4662 (skip-unless (tramp--test-enabled))
4663 (skip-unless (not (tramp--test-docker-p)))
4664 (skip-unless (not (tramp--test-rsync-p)))
4665 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4666 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4668 (tramp--test-instrument-test-case 10
4669 (tramp--test-utf8)))
4671 (ert-deftest tramp-test39-utf8-with-stat
()
4672 "Check UTF8 encoding in file names and file contents.
4673 Use the `stat' command."
4674 :tags
'(:expensive-test
:unstable
)
4675 (skip-unless (tramp--test-enabled))
4676 (skip-unless (tramp--test-sh-p))
4677 (skip-unless (not (tramp--test-docker-p)))
4678 (skip-unless (not (tramp--test-rsync-p)))
4679 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4680 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4681 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4682 (skip-unless (tramp-get-remote-stat v
)))
4684 (let ((tramp-connection-properties
4686 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4688 tramp-connection-properties
)))
4689 (tramp--test-utf8)))
4691 (ert-deftest tramp-test39-utf8-with-perl
()
4692 "Check UTF8 encoding in file names and file contents.
4693 Use the `perl' command."
4694 :tags
'(:expensive-test
:unstable
)
4695 (skip-unless (tramp--test-enabled))
4696 (skip-unless (tramp--test-sh-p))
4697 (skip-unless (not (tramp--test-docker-p)))
4698 (skip-unless (not (tramp--test-rsync-p)))
4699 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4700 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4701 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4702 (skip-unless (tramp-get-remote-perl v
)))
4704 (let ((tramp-connection-properties
4706 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4708 ;; See `tramp-sh-handle-file-truename'.
4709 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4711 tramp-connection-properties
)))
4712 (tramp--test-utf8)))
4714 (ert-deftest tramp-test39-utf8-with-ls
()
4715 "Check UTF8 encoding in file names and file contents.
4716 Use the `ls' command."
4717 :tags
'(:expensive-test
:unstable
)
4718 (skip-unless (tramp--test-enabled))
4719 (skip-unless (tramp--test-sh-p))
4720 (skip-unless (not (tramp--test-docker-p)))
4721 (skip-unless (not (tramp--test-rsync-p)))
4722 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4723 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4725 (let ((tramp-connection-properties
4727 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4729 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4731 ;; See `tramp-sh-handle-file-truename'.
4732 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4734 tramp-connection-properties
)))
4735 (tramp--test-utf8)))
4737 (ert-deftest tramp-test40-file-system-info
()
4738 "Check that `file-system-info' returns proper values."
4739 (skip-unless (tramp--test-enabled))
4740 ;; Since Emacs 27.1.
4741 (skip-unless (fboundp 'file-system-info
))
4743 ;; `file-system-info' exists since Emacs 27. We don't want to see
4744 ;; compiler warnings for older Emacsen.
4745 (let ((fsi (with-no-warnings
4746 (file-system-info tramp-test-temporary-file-directory
))))
4748 (should (and (consp fsi
)
4750 (numberp (nth 0 fsi
))
4751 (numberp (nth 1 fsi
))
4752 (numberp (nth 2 fsi
))))))
4754 (defun tramp--test-timeout-handler ()
4756 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
4758 ;; This test is inspired by Bug#16928.
4759 (ert-deftest tramp-test41-asynchronous-requests
()
4760 "Check parallel asynchronous requests.
4761 Such requests could arrive from timers, process filters and
4762 process sentinels. They shall not disturb each other."
4763 :tags
'(:expensive-test
)
4764 (skip-unless (tramp--test-enabled))
4765 (skip-unless (tramp--test-sh-p))
4767 ;; This test could be blocked on hydra. So we set a timeout of 300
4768 ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
4769 ;; This clearly doesn't work though, because the test not
4770 ;; infrequently hangs for hours until killed by the infrastructure.
4771 (with-timeout (300 (tramp--test-timeout-handler))
4772 (define-key special-event-map
[sigusr1] 'tramp--test-timeout-handler)
4773 (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
4774 (let* (;; For the watchdog.
4775 (default-directory (expand-file-name temporary-file-directory))
4778 "*watchdog*" nil shell-file-name shell-command-switch
4779 (format "sleep 300; kill -USR1 %d" (emacs-pid))))
4780 (tmp-name (tramp--test-make-temp-name))
4781 (default-directory tmp-name)
4782 ;; Do not cache Tramp properties.
4783 (remote-file-name-inhibit-cache t)
4784 (process-file-side-effects t)
4785 ;; Suppress nasty messages.
4787 ;; Do not run delayed timers.
4788 (timer-max-repeats 0)
4789 ;; Number of asynchronous processes for test. Tests on
4790 ;; some machines handle less parallel processes.
4794 (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))))
4795 ((getenv "EMACS_HYDRA_CI") 5)
4797 ;; On hydra, timings are bad.
4800 ((getenv "EMACS_HYDRA_CI") 10)
4802 ;; We must distinguish due to performance reasons.
4805 ((tramp--test-mock-p) 'vc-registered)
4806 (t 'file-attributes)))
4807 timer buffers kill-buffer-query-functions)
4811 (make-directory tmp-name)
4813 ;; Setup a timer in order to raise an ordinary command
4814 ;; again and again. `vc-registered' is well suited,
4815 ;; because there are many checks.
4822 (let ((time (float-time))
4823 (default-directory tmp-name)
4825 (buffer-name (nth (random (length buffers)) buffers))))
4826 (tramp--test-message
4827 "Start timer %s %s" file (current-time-string))
4828 (funcall timer-operation file)
4829 ;; Adjust timer if it takes too much time.
4830 (when (> (- (float-time) time) timer-repeat)
4831 (setq timer-repeat (* 1.5 timer-repeat))
4832 (setf (timer--repeat-delay timer) timer-repeat)
4833 (tramp--test-message "Increase timer %s" timer-repeat))
4834 (tramp--test-message
4835 "Stop timer %s %s" file (current-time-string)))))))
4837 ;; Create temporary buffers. The number of buffers
4838 ;; corresponds to the number of processes; it could be
4839 ;; increased in order to make pressure on Tramp.
4840 (dotimes (_ number-proc)
4841 (setq buffers (cons (generate-new-buffer "foo") buffers)))
4843 ;; Open asynchronous processes. Set process filter and sentinel.
4844 (dolist (buf buffers)
4846 (sit-for 0.01 'nodisp)
4848 (start-file-process-shell-command
4849 (buffer-name buf) buf
4851 "(read line && echo $line >$line);"
4852 "(read line && cat $line);"
4853 "(read line && rm $line)")))
4854 (file (expand-file-name (buffer-name buf))))
4855 ;; Remember the file name. Add counter.
4856 (process-put proc 'foo file)
4857 (process-put proc 'bar 0)
4858 ;; Add process filter.
4861 (lambda (proc string)
4862 (tramp--test-message
4863 "Process filter %s %s %s" proc string (current-time-string))
4864 (with-current-buffer (process-buffer proc)
4866 (unless (zerop (length string))
4867 (dired-uncache (process-get proc 'foo))
4868 (should (file-attributes (process-get proc 'foo))))))
4869 ;; Add process sentinel.
4870 (set-process-sentinel
4872 (lambda (proc _state)
4873 (tramp--test-message
4874 "Process sentinel %s %s" proc (current-time-string))
4875 (dired-uncache (process-get proc 'foo))
4876 (should-not (file-attributes (process-get proc 'foo)))))))
4878 ;; Send a string. Use a random order of the buffers. Mix
4879 ;; with regular operation.
4880 (let ((buffers (copy-sequence buffers)))
4883 (sit-for 0.01 'nodisp)
4884 (let* ((buf (nth (random (length buffers)) buffers))
4885 (proc (get-buffer-process buf))
4886 (file (process-get proc 'foo))
4887 (count (process-get proc 'bar)))
4888 (tramp--test-message
4889 "Start action %d %s %s" count buf (current-time-string))
4890 ;; Regular operation prior process action.
4891 (dired-uncache file)
4893 (should-not (file-attributes file))
4894 (should (file-attributes file)))
4895 ;; Send string to process.
4896 (process-send-string proc (format "%s\n" (buffer-name buf)))
4897 (accept-process-output proc 0.1 nil 0)
4898 ;; Give the watchdog a chance.
4899 (read-event nil nil 0.01)
4900 (tramp--test-message
4901 "Continue action %d %s %s" count buf (current-time-string))
4902 ;; Regular operation post process action.
4903 (dired-uncache file)
4905 (should-not (file-attributes file))
4906 (should (file-attributes file)))
4907 (tramp--test-message
4908 "Stop action %d %s %s" count buf (current-time-string))
4909 (process-put proc 'bar (1+ count))
4910 (unless (process-live-p proc)
4911 (setq buffers (delq buf buffers))))))
4913 ;; Checks. All process output shall exists in the
4914 ;; respective buffers. All created files shall be
4916 (tramp--test-message "Check %s" (current-time-string))
4917 (dolist (buf buffers)
4918 (with-current-buffer buf
4919 (should (string-equal (format "%s\n" buf) (buffer-string)))))
4922 tmp-name nil directory-files-no-dot-files-regexp)))
4925 (define-key special-event-map [sigusr1] 'ignore
)
4926 (ignore-errors (quit-process watchdog
))
4927 (dolist (buf buffers
)
4928 (ignore-errors (delete-process (get-buffer-process buf
)))
4929 (ignore-errors (kill-buffer buf
)))
4930 (ignore-errors (cancel-timer timer
))
4931 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
4933 ;; This test is inspired by Bug#29163.
4934 (ert-deftest tramp-test42-auto-load
()
4935 "Check that Tramp autoloads properly."
4936 (let ((default-directory (expand-file-name temporary-file-directory
))
4939 "(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t))"
4940 tramp-test-temporary-file-directory
)))
4943 "Tramp loaded: t[\n\r]+"
4944 (shell-command-to-string
4946 "%s -batch -Q -L %s --eval %s"
4947 (shell-quote-argument
4948 (expand-file-name invocation-name invocation-directory
))
4949 (mapconcat 'shell-quote-argument load-path
" -L ")
4950 (shell-quote-argument code
)))))))
4952 (ert-deftest tramp-test42-delay-load
()
4953 "Check that Tramp is loaded lazily, only when needed."
4954 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
4955 ;; cannot test older Emacsen, therefore.
4956 (skip-unless (tramp--test-emacs26-p))
4958 ;; Tramp is neither loaded at Emacs startup, nor when completing a
4959 ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
4960 ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
4961 (let ((default-directory (expand-file-name temporary-file-directory
))
4964 (setq tramp-mode %s) \
4965 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
4966 (file-name-all-completions \"/foo\" \"/\") \
4967 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
4968 (file-name-all-completions \"/foo:\" \"/\") \
4969 (message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
4970 ;; Tramp doesn't load when `tramp-mode' is nil.
4971 (dolist (tm '(t nil
))
4975 "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
4977 (shell-command-to-string
4979 "%s -batch -Q -L %s --eval %s"
4980 (shell-quote-argument
4981 (expand-file-name invocation-name invocation-directory
))
4982 (mapconcat 'shell-quote-argument load-path
" -L ")
4983 (shell-quote-argument (format code tm
)))))))))
4985 (ert-deftest tramp-test42-recursive-load
()
4986 "Check that Tramp does not fail due to recursive load."
4987 (skip-unless (tramp--test-enabled))
4989 (let ((default-directory (expand-file-name temporary-file-directory
)))
4993 "(expand-file-name %S)" tramp-test-temporary-file-directory
)
4995 "(let ((default-directory %S)) (expand-file-name %S))"
4996 tramp-test-temporary-file-directory
4997 temporary-file-directory
)))
5001 (shell-command-to-string
5003 "%s -batch -Q -L %s --eval %s"
5004 (shell-quote-argument
5005 (expand-file-name invocation-name invocation-directory
))
5006 (mapconcat 'shell-quote-argument load-path
" -L ")
5007 (shell-quote-argument code
))))))))
5009 (ert-deftest tramp-test42-remote-load-path
()
5010 "Check that Tramp autoloads its packages with remote `load-path'."
5011 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
5012 ;; cannot test older Emacsen, therefore.
5013 (skip-unless (tramp--test-emacs26-p))
5015 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
5016 ;; It shall still work, when a remote file name is in the
5018 (let ((default-directory (expand-file-name temporary-file-directory
))
5020 "(let ((force-load-messages t) \
5021 (load-path (cons \"/foo:bar:\" load-path))) \
5022 (tramp-cleanup-all-connections))"))
5028 "tramp-cmds" (file-name-directory (locate-library "tramp"))))
5029 (shell-command-to-string
5031 "%s -batch -Q -L %s -l tramp-sh --eval %s"
5032 (shell-quote-argument
5033 (expand-file-name invocation-name invocation-directory
))
5034 (mapconcat 'shell-quote-argument load-path
" -L ")
5035 (shell-quote-argument code
)))))))
5037 (ert-deftest tramp-test43-unload
()
5038 "Check that Tramp and its subpackages unload completely.
5039 Since it unloads Tramp, it shall be the last test to run."
5040 :tags
'(:expensive-test
)
5041 (skip-unless noninteractive
)
5042 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
5043 ;; cannot test older Emacsen, therefore.
5044 (skip-unless (tramp--test-emacs26-p))
5046 (when (featurep 'tramp
)
5047 (unload-feature 'tramp
'force
)
5048 ;; No Tramp feature must be left.
5049 (should-not (featurep 'tramp
))
5050 (should-not (all-completions "tramp" (delq 'tramp-tests features
)))
5051 ;; `file-name-handler-alist' must be clean.
5052 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist
)))
5053 ;; There shouldn't be left a bound symbol, except buffer-local
5054 ;; variables, and autoload functions. We do not regard our test
5055 ;; symbols, and the Tramp unload hooks.
5058 (and (or (and (boundp x
) (null (local-variable-if-set-p x
)))
5059 (and (functionp x
) (null (autoloadp (symbol-function x
)))))
5060 (string-match "^tramp" (symbol-name x
))
5061 (not (string-match "^tramp--?test" (symbol-name x
)))
5062 (not (string-match "unload-hook$" (symbol-name x
)))
5063 (ert-fail (format "`%s' still bound" x
)))))
5064 ;; The defstruct `tramp-file-name' and all its internal functions
5066 (should-not (cl--find-class 'tramp-file-name
))
5070 (string-match "tramp-file-name" (symbol-name x
))
5071 (ert-fail (format "Structure function `%s' still exists" x
)))))
5072 ;; There shouldn't be left a hook function containing a Tramp
5073 ;; function. We do not regard the Tramp unload hooks.
5077 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x
))
5078 (not (string-match "unload-hook$" (symbol-name x
)))
5079 (consp (symbol-value x
))
5080 (ignore-errors (all-completions "tramp" (symbol-value x
)))
5081 (ert-fail (format "Hook `%s' still contains Tramp function" x
)))))))
5083 (defun tramp-test-all (&optional interactive
)
5084 "Run all tests for \\[tramp]."
5087 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
5091 ;; * dired-compress-file
5093 ;; * file-equal-p (partly done in `tramp-test21-file-links')
5094 ;; * file-in-directory-p
5095 ;; * file-name-case-insensitive-p
5097 ;; * Work on skipped tests. Make a comment, when it is impossible.
5098 ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
5099 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
5100 ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
5101 ;; do not work properly for `owncloud'.
5102 ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
5103 ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably.
5104 ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'.
5106 (provide 'tramp-tests
)
5107 ;;; tramp-tests.el ends here