1 ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2017 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 `http://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 ;; A whole test run can be performed calling the command `tramp-test-all'.
49 (declare-function tramp-find-executable
"tramp-sh")
50 (declare-function tramp-get-remote-path
"tramp-sh")
51 (declare-function tramp-get-remote-stat
"tramp-sh")
52 (declare-function tramp-get-remote-perl
"tramp-sh")
53 (defvar auto-save-file-name-transforms
)
54 (defvar tramp-copy-size-limit
)
55 (defvar tramp-persistency-file-name
)
56 (defvar tramp-remote-process-environment
)
57 ;; Suppress nasty messages.
58 (fset 'shell-command-sentinel
'ignore
)
60 ;; There is no default value on w32 systems, which could work out of the box.
61 (defconst tramp-test-temporary-file-directory
63 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
64 ((eq system-type
'windows-nt
) null-device
)
68 (tramp-login-program "sh")
69 (tramp-login-args (("-i")))
70 (tramp-remote-shell "/bin/sh")
71 (tramp-remote-shell-args ("-c"))
72 (tramp-connection-timeout 10)))
74 'tramp-default-host-alist
75 `("\\`mock\\'" nil
,(system-name)))
76 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
77 ;; batch mode only, therefore.
78 (unless (and (null noninteractive
) (file-directory-p "~/"))
79 (setenv "HOME" temporary-file-directory
))
80 (format "/mock::%s" temporary-file-directory
)))
81 "Temporary directory for Tramp tests.")
83 (setq password-cache-expiry nil
85 tramp-cache-read-persistent-data t
;; For auth-sources.
86 tramp-copy-size-limit nil
87 tramp-message-show-message nil
88 tramp-persistency-file-name nil
)
90 ;; This should happen on hydra only.
91 (when (getenv "EMACS_HYDRA_CI")
92 (add-to-list 'tramp-remote-path
'tramp-own-remote-path
))
94 (defvar tramp--test-expensive-test
96 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
97 "Whether expensive tests are run.")
99 (defvar tramp--test-enabled-checked nil
100 "Cached result of `tramp--test-enabled'.
101 If the function did run, the value is a cons cell, the `cdr'
104 (defun tramp--test-enabled ()
105 "Whether remote file access is enabled."
106 (unless (consp tramp--test-enabled-checked
)
108 tramp--test-enabled-checked
112 (file-remote-p tramp-test-temporary-file-directory
)
113 (file-directory-p tramp-test-temporary-file-directory
)
114 (file-writable-p tramp-test-temporary-file-directory
))))))
116 (when (cdr tramp--test-enabled-checked
)
117 ;; Cleanup connection.
119 (tramp-cleanup-connection
120 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
121 nil
'keep-password
)))
124 (cdr tramp--test-enabled-checked
))
126 (defun tramp--test-make-temp-name (&optional local quoted
)
127 "Return a temporary file name for test.
128 If LOCAL is non-nil, a local file name is returned.
129 If QUOTED is non-nil, the local part of the file name is quoted.
130 The temporary file is not created."
132 (if quoted
'tramp-compat-file-name-quote
'identity
)
134 (make-temp-name "tramp-test")
135 (if local temporary-file-directory tramp-test-temporary-file-directory
))))
137 ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
138 (defvar tramp--test-instrument-test-case-p nil
139 "Whether `tramp--test-instrument-test-case' run.
140 This shall used dynamically bound only.")
142 (defmacro tramp--test-instrument-test-case
(verbose &rest body
)
143 "Run BODY with `tramp-verbose' equal VERBOSE.
144 Print the the content of the Tramp debug buffer, if BODY does not
145 eval properly in `should' or `should-not'. `should-error' is not
146 handled properly. BODY shall not contain a timeout."
147 (declare (indent 1) (debug (natnump body
)))
148 `(let ((tramp-verbose (max (or ,verbose
0) (or tramp-verbose
0)))
149 (tramp-message-show-message t
)
150 (tramp-debug-on-error t
)
151 (debug-ignored-errors
152 (cons "^make-symbolic-link not supported$" debug-ignored-errors
))
155 (let ((tramp--test-instrument-test-case-p t
)) ,@body
)
157 (when (and (null tramp--test-instrument-test-case-p
) (> tramp-verbose
3))
158 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
159 (with-current-buffer (tramp-get-connection-buffer v
)
160 (message "%s" (buffer-string)))
161 (with-current-buffer (tramp-get-debug-buffer v
)
162 (message "%s" (buffer-string))))))))
164 (defsubst tramp--test-message
(fmt-string &rest arguments
)
165 "Emit a message into ERT *Messages*."
166 (tramp--test-instrument-test-case 0
169 (tramp-dissect-file-name tramp-test-temporary-file-directory
) 0
170 fmt-string arguments
)))
172 (defsubst tramp--test-backtrace
()
173 "Dump a backtrace into ERT *Messages*."
174 (tramp--test-instrument-test-case 10
176 (tramp-dissect-file-name tramp-test-temporary-file-directory
))))
178 (ert-deftest tramp-test00-availability
()
179 "Test availability of Tramp functions."
180 :expected-result
(if (tramp--test-enabled) :passed
:failed
)
182 "Remote directory: `%s'" tramp-test-temporary-file-directory
)
183 (should (ignore-errors
185 (file-remote-p tramp-test-temporary-file-directory
)
186 (file-directory-p tramp-test-temporary-file-directory
)
187 (file-writable-p tramp-test-temporary-file-directory
)))))
189 (ert-deftest tramp-test01-file-name-syntax
()
190 "Check remote file name syntax."
192 (should (tramp-tramp-file-p "/method::"))
193 (should (tramp-tramp-file-p "/method:host:"))
194 (should (tramp-tramp-file-p "/method:user@:"))
195 (should (tramp-tramp-file-p "/method:user@host:"))
196 (should (tramp-tramp-file-p "/method:user@email@host:"))
199 (should (tramp-tramp-file-p "/method:host#1234:"))
200 (should (tramp-tramp-file-p "/method:user@host#1234:"))
202 ;; Using an IPv4 address.
203 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
204 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
206 ;; Using an IPv6 address.
207 (should (tramp-tramp-file-p "/method:[::1]:"))
208 (should (tramp-tramp-file-p "/method:user@[::1]:"))
210 ;; Local file name part.
211 (should (tramp-tramp-file-p "/method:::"))
212 (should (tramp-tramp-file-p "/method::/:"))
213 (should (tramp-tramp-file-p "/method::/path/to/file"))
214 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
215 (should (tramp-tramp-file-p "/method::file"))
216 (should (tramp-tramp-file-p "/method::/:file"))
219 (should (tramp-tramp-file-p "/method1:|method2::"))
220 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
221 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
222 (should (tramp-tramp-file-p
223 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
226 (should-not (tramp-tramp-file-p nil
))
227 (should-not (tramp-tramp-file-p 'symbol
))
229 (should-not (tramp-tramp-file-p "/host:"))
230 (should-not (tramp-tramp-file-p "/user@host:"))
231 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
232 (should-not (tramp-tramp-file-p "/[]:"))
233 (should-not (tramp-tramp-file-p "/[::1]:"))
234 (should-not (tramp-tramp-file-p "/host:/:"))
235 (should-not (tramp-tramp-file-p "/host1|host2:"))
236 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
237 ;; Quote with "/:" suppresses file name handlers.
238 (should-not (tramp-tramp-file-p "/::"))
239 (should-not (tramp-tramp-file-p "/:@:"))
240 (should-not (tramp-tramp-file-p "/:[]:"))
241 ;; Methods shall be at least two characters on MS Windows, except
242 ;; the default method.
243 (let ((system-type 'windows-nt
))
244 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
245 (should-not (tramp-tramp-file-p "/c::/path/to/file"))
246 (should (tramp-tramp-file-p "/-::/path/to/file")))
247 (let ((system-type 'gnu
/linux
))
248 (should (tramp-tramp-file-p "/-:h:/path/to/file"))
249 (should (tramp-tramp-file-p "/m::/path/to/file"))))
251 (ert-deftest tramp-test01-file-name-syntax-simplified
()
252 "Check simplified file name syntax."
253 :tags
'(:expensive-test
)
254 (let ((syntax tramp-syntax
))
257 (tramp-change-syntax 'simplified
)
259 (should (tramp-tramp-file-p "/host:"))
260 (should (tramp-tramp-file-p "/user@:"))
261 (should (tramp-tramp-file-p "/user@host:"))
262 (should (tramp-tramp-file-p "/user@email@host:"))
265 (should (tramp-tramp-file-p "/host#1234:"))
266 (should (tramp-tramp-file-p "/user@host#1234:"))
268 ;; Using an IPv4 address.
269 (should (tramp-tramp-file-p "/1.2.3.4:"))
270 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
272 ;; Using an IPv6 address.
273 (should (tramp-tramp-file-p "/[::1]:"))
274 (should (tramp-tramp-file-p "/user@[::1]:"))
276 ;; Local file name part.
277 (should (tramp-tramp-file-p "/host::"))
278 (should (tramp-tramp-file-p "/host:/:"))
279 (should (tramp-tramp-file-p "/host:/path/to/file"))
280 (should (tramp-tramp-file-p "/host:/:/path/to/file"))
281 (should (tramp-tramp-file-p "/host:file"))
282 (should (tramp-tramp-file-p "/host:/:file"))
285 (should (tramp-tramp-file-p "/host1|host2:"))
286 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
287 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
290 (should-not (tramp-tramp-file-p nil
))
291 (should-not (tramp-tramp-file-p 'symbol
))
292 ;; Quote with "/:" suppresses file name handlers.
293 (should-not (tramp-tramp-file-p "/::"))
294 (should-not (tramp-tramp-file-p "/:@:"))
295 (should-not (tramp-tramp-file-p "/:[]:")))
298 (tramp-change-syntax syntax
))))
300 (ert-deftest tramp-test01-file-name-syntax-separate
()
301 "Check separate file name syntax."
302 :tags
'(:expensive-test
)
303 (let ((syntax tramp-syntax
))
306 (tramp-change-syntax 'separate
)
308 (should (tramp-tramp-file-p "/[method/]"))
309 (should (tramp-tramp-file-p "/[method/host]"))
310 (should (tramp-tramp-file-p "/[method/user@]"))
311 (should (tramp-tramp-file-p "/[method/user@host]"))
312 (should (tramp-tramp-file-p "/[method/user@email@host]"))
315 (should (tramp-tramp-file-p "/[method/host#1234]"))
316 (should (tramp-tramp-file-p "/[method/user@host#1234]"))
318 ;; Using an IPv4 address.
319 (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
320 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
322 ;; Using an IPv6 address.
323 (should (tramp-tramp-file-p "/[method/::1]"))
324 (should (tramp-tramp-file-p "/[method/user@::1]"))
326 ;; Local file name part.
327 (should (tramp-tramp-file-p "/[method/]"))
328 (should (tramp-tramp-file-p "/[method/]/:"))
329 (should (tramp-tramp-file-p "/[method/]/path/to/file"))
330 (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
331 (should (tramp-tramp-file-p "/[method/]file"))
332 (should (tramp-tramp-file-p "/[method/]/:file"))
335 (should (tramp-tramp-file-p "/[method1/|method2/]"))
336 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
339 "/[method1/user1@host1|method2/user2@host2]"))
342 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
345 (should-not (tramp-tramp-file-p nil
))
346 (should-not (tramp-tramp-file-p 'symbol
))
348 (should-not (tramp-tramp-file-p "/host:"))
349 (should-not (tramp-tramp-file-p "/user@host:"))
350 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
351 (should-not (tramp-tramp-file-p "/host:/:"))
352 (should-not (tramp-tramp-file-p "/host1|host2:"))
353 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
354 ;; Quote with "/:" suppresses file name handlers.
355 (should-not (tramp-tramp-file-p "/:[]")))
358 (tramp-change-syntax syntax
))))
360 (ert-deftest tramp-test02-file-name-dissect
()
361 "Check remote file name components."
362 (let ((tramp-default-method "default-method")
363 (tramp-default-user "default-user")
364 (tramp-default-host "default-host"))
365 ;; Expand `tramp-default-user' and `tramp-default-host'.
366 (should (string-equal
367 (file-remote-p "/method::")
368 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
369 (should (string-equal (file-remote-p "/method::" 'method
) "method"))
370 (should (string-equal (file-remote-p "/method::" 'user
) "default-user"))
371 (should (string-equal (file-remote-p "/method::" 'host
) "default-host"))
372 (should (string-equal (file-remote-p "/method::" 'localname
) ""))
373 (should (string-equal (file-remote-p "/method::" 'hop
) nil
))
375 ;; Expand `tramp-default-method' and `tramp-default-user'.
376 (should (string-equal
377 (file-remote-p "/-:host:")
378 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
379 (should (string-equal (file-remote-p "/-:host:" 'method
) "default-method"))
380 (should (string-equal (file-remote-p "/-:host:" 'user
) "default-user"))
381 (should (string-equal (file-remote-p "/-:host:" 'host
) "host"))
382 (should (string-equal (file-remote-p "/-:host:" 'localname
) ""))
383 (should (string-equal (file-remote-p "/-:host:" 'hop
) nil
))
385 ;; Expand `tramp-default-method' and `tramp-default-host'.
386 (should (string-equal
387 (file-remote-p "/-:user@:")
388 (format "/%s:%s@%s:" "default-method" "user" "default-host")))
389 (should (string-equal (file-remote-p "/-:user@:" 'method
) "default-method"))
390 (should (string-equal (file-remote-p "/-:user@:" 'user
) "user"))
391 (should (string-equal (file-remote-p "/-:user@:" 'host
) "default-host"))
392 (should (string-equal (file-remote-p "/-:user@:" 'localname
) ""))
393 (should (string-equal (file-remote-p "/-:user@:" 'hop
) nil
))
395 ;; Expand `tramp-default-method'.
396 (should (string-equal
397 (file-remote-p "/-:user@host:")
398 (format "/%s:%s@%s:" "default-method" "user" "host")))
399 (should (string-equal
400 (file-remote-p "/-:user@host:" 'method
) "default-method"))
401 (should (string-equal (file-remote-p "/-:user@host:" 'user
) "user"))
402 (should (string-equal (file-remote-p "/-:user@host:" 'host
) "host"))
403 (should (string-equal (file-remote-p "/-:user@host:" 'localname
) ""))
404 (should (string-equal (file-remote-p "/-:user@host:" 'hop
) nil
))
406 ;; Expand `tramp-default-user'.
407 (should (string-equal
408 (file-remote-p "/method:host:")
409 (format "/%s:%s@%s:" "method" "default-user" "host")))
410 (should (string-equal (file-remote-p "/method:host:" 'method
) "method"))
411 (should (string-equal (file-remote-p "/method:host:" 'user
) "default-user"))
412 (should (string-equal (file-remote-p "/method:host:" 'host
) "host"))
413 (should (string-equal (file-remote-p "/method:host:" 'localname
) ""))
414 (should (string-equal (file-remote-p "/method:host:" 'hop
) nil
))
416 ;; Expand `tramp-default-host'.
417 (should (string-equal
418 (file-remote-p "/method:user@:")
419 (format "/%s:%s@%s:" "method" "user" "default-host")))
420 (should (string-equal (file-remote-p "/method:user@:" 'method
) "method"))
421 (should (string-equal (file-remote-p "/method:user@:" 'user
) "user"))
422 (should (string-equal (file-remote-p "/method:user@:" 'host
)
424 (should (string-equal (file-remote-p "/method:user@:" 'localname
) ""))
425 (should (string-equal (file-remote-p "/method:user@:" 'hop
) nil
))
428 (should (string-equal
429 (file-remote-p "/method:user@host:")
430 (format "/%s:%s@%s:" "method" "user" "host")))
431 (should (string-equal
432 (file-remote-p "/method:user@host:" 'method
) "method"))
433 (should (string-equal (file-remote-p "/method:user@host:" 'user
) "user"))
434 (should (string-equal (file-remote-p "/method:user@host:" 'host
) "host"))
435 (should (string-equal (file-remote-p "/method:user@host:" 'localname
) ""))
436 (should (string-equal (file-remote-p "/method:user@host:" 'hop
) nil
))
439 (should (string-equal
440 (file-remote-p "/method:user@email@host:")
441 (format "/%s:%s@%s:" "method" "user@email" "host")))
442 (should (string-equal
443 (file-remote-p "/method:user@email@host:" 'method
) "method"))
444 (should (string-equal
445 (file-remote-p "/method:user@email@host:" 'user
) "user@email"))
446 (should (string-equal
447 (file-remote-p "/method:user@email@host:" 'host
) "host"))
448 (should (string-equal
449 (file-remote-p "/method:user@email@host:" 'localname
) ""))
450 (should (string-equal
451 (file-remote-p "/method:user@email@host:" 'hop
) nil
))
453 ;; Expand `tramp-default-method' and `tramp-default-user'.
454 (should (string-equal
455 (file-remote-p "/-:host#1234:")
456 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
457 (should (string-equal
458 (file-remote-p "/-:host#1234:" 'method
) "default-method"))
459 (should (string-equal (file-remote-p "/-:host#1234:" 'user
) "default-user"))
460 (should (string-equal (file-remote-p "/-:host#1234:" 'host
) "host#1234"))
461 (should (string-equal (file-remote-p "/-:host#1234:" 'localname
) ""))
462 (should (string-equal (file-remote-p "/-:host#1234:" 'hop
) nil
))
464 ;; Expand `tramp-default-method'.
465 (should (string-equal
466 (file-remote-p "/-:user@host#1234:")
467 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
468 (should (string-equal
469 (file-remote-p "/-:user@host#1234:" 'method
) "default-method"))
470 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user
) "user"))
471 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host
) "host#1234"))
472 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname
) ""))
473 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop
) nil
))
475 ;; Expand `tramp-default-user'.
476 (should (string-equal
477 (file-remote-p "/method:host#1234:")
478 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
479 (should (string-equal
480 (file-remote-p "/method:host#1234:" 'method
) "method"))
481 (should (string-equal
482 (file-remote-p "/method:host#1234:" 'user
) "default-user"))
483 (should (string-equal
484 (file-remote-p "/method:host#1234:" 'host
) "host#1234"))
485 (should (string-equal (file-remote-p "/method:host#1234:" 'localname
) ""))
486 (should (string-equal (file-remote-p "/method:host#1234:" 'hop
) nil
))
489 (should (string-equal
490 (file-remote-p "/method:user@host#1234:")
491 (format "/%s:%s@%s:" "method" "user" "host#1234")))
492 (should (string-equal
493 (file-remote-p "/method:user@host#1234:" 'method
) "method"))
494 (should (string-equal
495 (file-remote-p "/method:user@host#1234:" 'user
) "user"))
496 (should (string-equal
497 (file-remote-p "/method:user@host#1234:" 'host
) "host#1234"))
498 (should (string-equal
499 (file-remote-p "/method:user@host#1234:" 'localname
) ""))
500 (should (string-equal
501 (file-remote-p "/method:user@host#1234:" 'hop
) nil
))
503 ;; Expand `tramp-default-method' and `tramp-default-user'.
504 (should (string-equal
505 (file-remote-p "/-:1.2.3.4:")
506 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
507 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method
) "default-method"))
508 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user
) "default-user"))
509 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host
) "1.2.3.4"))
510 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname
) ""))
511 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop
) nil
))
513 ;; Expand `tramp-default-method'.
514 (should (string-equal
515 (file-remote-p "/-:user@1.2.3.4:")
516 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
517 (should (string-equal
518 (file-remote-p "/-:user@1.2.3.4:" 'method
) "default-method"))
519 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user
) "user"))
520 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host
) "1.2.3.4"))
521 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname
) ""))
522 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop
) nil
))
524 ;; Expand `tramp-default-user'.
525 (should (string-equal
526 (file-remote-p "/method:1.2.3.4:")
527 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
528 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method
) "method"))
529 (should (string-equal
530 (file-remote-p "/method:1.2.3.4:" 'user
) "default-user"))
531 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host
) "1.2.3.4"))
532 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname
) ""))
533 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop
) nil
))
536 (should (string-equal
537 (file-remote-p "/method:user@1.2.3.4:")
538 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
539 (should (string-equal
540 (file-remote-p "/method:user@1.2.3.4:" 'method
) "method"))
541 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user
) "user"))
542 (should (string-equal
543 (file-remote-p "/method:user@1.2.3.4:" 'host
) "1.2.3.4"))
544 (should (string-equal
545 (file-remote-p "/method:user@1.2.3.4:" 'localname
) ""))
546 (should (string-equal
547 (file-remote-p "/method:user@1.2.3.4:" 'hop
) nil
))
549 ;; Expand `tramp-default-method', `tramp-default-user' and
550 ;; `tramp-default-host'.
551 (should (string-equal
552 (file-remote-p "/-:[]:")
554 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
555 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
556 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
557 (should (string-equal (file-remote-p "/-:[]:" 'host
) "default-host"))
558 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
559 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
))
561 ;; Expand `tramp-default-method' and `tramp-default-user'.
562 (let ((tramp-default-host "::1"))
563 (should (string-equal
564 (file-remote-p "/-:[]:")
565 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
566 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
567 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
568 (should (string-equal (file-remote-p "/-:[]:" 'host
) "::1"))
569 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
570 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
)))
572 ;; Expand `tramp-default-method' and `tramp-default-user'.
573 (should (string-equal
574 (file-remote-p "/-:[::1]:")
575 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
576 (should (string-equal (file-remote-p "/-:[::1]:" 'method
) "default-method"))
577 (should (string-equal (file-remote-p "/-:[::1]:" 'user
) "default-user"))
578 (should (string-equal (file-remote-p "/-:[::1]:" 'host
) "::1"))
579 (should (string-equal (file-remote-p "/-:[::1]:" 'localname
) ""))
580 (should (string-equal (file-remote-p "/-:[::1]:" 'hop
) nil
))
582 ;; Expand `tramp-default-method'.
583 (should (string-equal
584 (file-remote-p "/-:user@[::1]:")
585 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
586 (should (string-equal
587 (file-remote-p "/-:user@[::1]:" 'method
) "default-method"))
588 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user
) "user"))
589 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host
) "::1"))
590 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname
) ""))
591 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop
) nil
))
593 ;; Expand `tramp-default-user'.
594 (should (string-equal
595 (file-remote-p "/method:[::1]:")
596 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
597 (should (string-equal (file-remote-p "/method:[::1]:" 'method
) "method"))
598 (should (string-equal
599 (file-remote-p "/method:[::1]:" 'user
) "default-user"))
600 (should (string-equal (file-remote-p "/method:[::1]:" 'host
) "::1"))
601 (should (string-equal (file-remote-p "/method:[::1]:" 'localname
) ""))
602 (should (string-equal (file-remote-p "/method:[::1]:" 'hop
) nil
))
605 (should (string-equal
606 (file-remote-p "/method:user@[::1]:")
607 (format "/%s:%s@%s:" "method" "user" "[::1]")))
608 (should (string-equal
609 (file-remote-p "/method:user@[::1]:" 'method
) "method"))
610 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user
) "user"))
611 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host
) "::1"))
612 (should (string-equal
613 (file-remote-p "/method:user@[::1]:" 'localname
) ""))
614 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop
) nil
))
616 ;; Local file name part.
617 (should (string-equal (file-remote-p "/-:host:/:" 'localname
) "/:"))
618 (should (string-equal (file-remote-p "/method:::" 'localname
) ":"))
619 (should (string-equal (file-remote-p "/method:: " 'localname
) " "))
620 (should (string-equal (file-remote-p "/method::file" 'localname
) "file"))
621 (should (string-equal
622 (file-remote-p "/method::/path/to/file" 'localname
)
628 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
629 (format "/%s:%s@%s|%s:%s@%s:"
630 "method1" "user1" "host1" "method2" "user2" "host2")))
634 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method
)
639 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user
)
644 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host
)
649 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname
)
654 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop
)
656 "method1" "user1" "host1")))
662 "/method1:user1@host1"
663 "|method2:user2@host2"
664 "|method3:user3@host3:/path/to/file"))
665 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
666 "method1" "user1" "host1"
667 "method2" "user2" "host2"
668 "method3" "user3" "host3")))
673 "/method1:user1@host1"
674 "|method2:user2@host2"
675 "|method3:user3@host3:/path/to/file")
682 "/method1:user1@host1"
683 "|method2:user2@host2"
684 "|method3:user3@host3:/path/to/file")
691 "/method1:user1@host1"
692 "|method2:user2@host2"
693 "|method3:user3@host3:/path/to/file")
700 "/method1:user1@host1"
701 "|method2:user2@host2"
702 "|method3:user3@host3:/path/to/file")
709 "/method1:user1@host1"
710 "|method2:user2@host2"
711 "|method3:user3@host3:/path/to/file")
713 (format "%s:%s@%s|%s:%s@%s|"
714 "method1" "user1" "host1" "method2" "user2" "host2")))))
716 (ert-deftest tramp-test02-file-name-dissect-simplified
()
717 "Check simplified file name components."
718 :tags
'(:expensive-test
)
719 (let ((tramp-default-method "default-method")
720 (tramp-default-user "default-user")
721 (tramp-default-host "default-host")
722 (syntax tramp-syntax
))
725 (tramp-change-syntax 'simplified
)
726 ;; Expand `tramp-default-method' and `tramp-default-user'.
727 (should (string-equal
728 (file-remote-p "/host:")
729 (format "/%s@%s:" "default-user" "host")))
730 (should (string-equal
731 (file-remote-p "/host:" 'method
) "default-method"))
732 (should (string-equal (file-remote-p "/host:" 'user
) "default-user"))
733 (should (string-equal (file-remote-p "/host:" 'host
) "host"))
734 (should (string-equal (file-remote-p "/host:" 'localname
) ""))
735 (should (string-equal (file-remote-p "/host:" 'hop
) nil
))
737 ;; Expand `tramp-default-method' and `tramp-default-host'.
738 (should (string-equal
739 (file-remote-p "/user@:")
740 (format "/%s@%s:" "user" "default-host")))
741 (should (string-equal
742 (file-remote-p "/user@:" 'method
) "default-method"))
743 (should (string-equal (file-remote-p "/user@:" 'user
) "user"))
744 (should (string-equal (file-remote-p "/user@:" 'host
) "default-host"))
745 (should (string-equal (file-remote-p "/user@:" 'localname
) ""))
746 (should (string-equal (file-remote-p "/user@:" 'hop
) nil
))
748 ;; Expand `tramp-default-method'.
749 (should (string-equal
750 (file-remote-p "/user@host:")
751 (format "/%s@%s:" "user" "host")))
752 (should (string-equal
753 (file-remote-p "/user@host:" 'method
) "default-method"))
754 (should (string-equal (file-remote-p "/user@host:" 'user
) "user"))
755 (should (string-equal (file-remote-p "/user@host:" 'host
) "host"))
756 (should (string-equal (file-remote-p "/user@host:" 'localname
) ""))
757 (should (string-equal (file-remote-p "/user@host:" 'hop
) nil
))
760 (should (string-equal
761 (file-remote-p "/user@email@host:")
762 (format "/%s@%s:" "user@email" "host")))
763 (should (string-equal
765 "/user@email@host:" 'method
) "default-method"))
766 (should (string-equal
767 (file-remote-p "/user@email@host:" 'user
) "user@email"))
768 (should (string-equal
769 (file-remote-p "/user@email@host:" 'host
) "host"))
770 (should (string-equal
771 (file-remote-p "/user@email@host:" 'localname
) ""))
772 (should (string-equal
773 (file-remote-p "/user@email@host:" 'hop
) nil
))
775 ;; Expand `tramp-default-method' and `tramp-default-user'.
776 (should (string-equal
777 (file-remote-p "/host#1234:")
778 (format "/%s@%s:" "default-user" "host#1234")))
779 (should (string-equal
780 (file-remote-p "/host#1234:" 'method
) "default-method"))
781 (should (string-equal
782 (file-remote-p "/host#1234:" 'user
) "default-user"))
783 (should (string-equal
784 (file-remote-p "/host#1234:" 'host
) "host#1234"))
785 (should (string-equal (file-remote-p "/host#1234:" 'localname
) ""))
786 (should (string-equal (file-remote-p "/host#1234:" 'hop
) nil
))
788 ;; Expand `tramp-default-method'.
789 (should (string-equal
790 (file-remote-p "/user@host#1234:")
791 (format "/%s@%s:" "user" "host#1234")))
792 (should (string-equal
793 (file-remote-p "/user@host#1234:" 'method
) "default-method"))
794 (should (string-equal
795 (file-remote-p "/user@host#1234:" 'user
) "user"))
796 (should (string-equal
797 (file-remote-p "/user@host#1234:" 'host
) "host#1234"))
798 (should (string-equal
799 (file-remote-p "/user@host#1234:" 'localname
) ""))
800 (should (string-equal (file-remote-p "/user@host#1234:" 'hop
) nil
))
802 ;; Expand `tramp-default-method' and `tramp-default-user'.
803 (should (string-equal
804 (file-remote-p "/1.2.3.4:")
805 (format "/%s@%s:" "default-user" "1.2.3.4")))
806 (should (string-equal
807 (file-remote-p "/1.2.3.4:" 'method
) "default-method"))
808 (should (string-equal
809 (file-remote-p "/1.2.3.4:" 'user
) "default-user"))
810 (should (string-equal (file-remote-p "/1.2.3.4:" 'host
) "1.2.3.4"))
811 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname
) ""))
812 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop
) nil
))
814 ;; Expand `tramp-default-method'.
815 (should (string-equal
816 (file-remote-p "/user@1.2.3.4:")
817 (format "/%s@%s:" "user" "1.2.3.4")))
818 (should (string-equal
819 (file-remote-p "/user@1.2.3.4:" 'method
) "default-method"))
820 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user
) "user"))
821 (should (string-equal
822 (file-remote-p "/user@1.2.3.4:" 'host
) "1.2.3.4"))
823 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname
) ""))
824 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop
) nil
))
826 ;; Expand `tramp-default-method', `tramp-default-user' and
827 ;; `tramp-default-host'.
828 (should (string-equal
829 (file-remote-p "/[]:")
831 "/%s@%s:" "default-user" "default-host")))
832 (should (string-equal
833 (file-remote-p "/[]:" 'method
) "default-method"))
834 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
835 (should (string-equal (file-remote-p "/[]:" 'host
) "default-host"))
836 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
837 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
))
839 ;; Expand `tramp-default-method' and `tramp-default-user'.
840 (let ((tramp-default-host "::1"))
841 (should (string-equal
842 (file-remote-p "/[]:")
843 (format "/%s@%s:" "default-user" "[::1]")))
844 (should (string-equal
845 (file-remote-p "/[]:" 'method
) "default-method"))
846 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
847 (should (string-equal (file-remote-p "/[]:" 'host
) "::1"))
848 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
849 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
)))
851 ;; Expand `tramp-default-method' and `tramp-default-user'.
852 (should (string-equal
853 (file-remote-p "/[::1]:")
854 (format "/%s@%s:" "default-user" "[::1]")))
855 (should (string-equal
856 (file-remote-p "/[::1]:" 'method
) "default-method"))
857 (should (string-equal (file-remote-p "/[::1]:" 'user
) "default-user"))
858 (should (string-equal (file-remote-p "/[::1]:" 'host
) "::1"))
859 (should (string-equal (file-remote-p "/[::1]:" 'localname
) ""))
860 (should (string-equal (file-remote-p "/[::1]:" 'hop
) nil
))
862 ;; Expand `tramp-default-method'.
863 (should (string-equal
864 (file-remote-p "/user@[::1]:")
865 (format "/%s@%s:" "user" "[::1]")))
866 (should (string-equal
867 (file-remote-p "/user@[::1]:" 'method
) "default-method"))
868 (should (string-equal (file-remote-p "/user@[::1]:" 'user
) "user"))
869 (should (string-equal (file-remote-p "/user@[::1]:" 'host
) "::1"))
870 (should (string-equal (file-remote-p "/user@[::1]:" 'localname
) ""))
871 (should (string-equal (file-remote-p "/user@[::1]:" 'hop
) nil
))
873 ;; Local file name part.
874 (should (string-equal (file-remote-p "/host:/:" 'localname
) "/:"))
875 (should (string-equal (file-remote-p "/host::" 'localname
) ":"))
876 (should (string-equal (file-remote-p "/host: " 'localname
) " "))
877 (should (string-equal (file-remote-p "/host:file" 'localname
) "file"))
878 (should (string-equal
879 (file-remote-p "/host:/path/to/file" 'localname
)
885 (file-remote-p "/user1@host1|user2@host2:/path/to/file")
886 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
890 "/user1@host1|user2@host2:/path/to/file" 'method
)
895 "/user1@host1|user2@host2:/path/to/file" 'user
)
900 "/user1@host1|user2@host2:/path/to/file" 'host
)
905 "/user1@host1|user2@host2:/path/to/file" 'localname
)
910 "/user1@host1|user2@host2:/path/to/file" 'hop
)
911 (format "%s@%s|" "user1" "host1")))
919 "|user3@host3:/path/to/file"))
920 (format "/%s@%s|%s@%s|%s@%s:"
930 "|user3@host3:/path/to/file")
939 "|user3@host3:/path/to/file")
948 "|user3@host3:/path/to/file")
957 "|user3@host3:/path/to/file")
966 "|user3@host3:/path/to/file")
968 (format "%s@%s|%s@%s|"
969 "user1" "host1" "user2" "host2"))))
972 (tramp-change-syntax syntax
))))
974 (ert-deftest tramp-test02-file-name-dissect-separate
()
975 "Check separate file name components."
976 :tags
'(:expensive-test
)
977 (let ((tramp-default-method "default-method")
978 (tramp-default-user "default-user")
979 (tramp-default-host "default-host")
980 (syntax tramp-syntax
))
983 (tramp-change-syntax 'separate
)
984 ;; Expand `tramp-default-user' and `tramp-default-host'.
985 (should (string-equal
986 (file-remote-p "/[method/]")
988 "/[%s/%s@%s]" "method" "default-user" "default-host")))
989 (should (string-equal (file-remote-p "/[method/]" 'method
) "method"))
990 (should (string-equal
991 (file-remote-p "/[method/]" 'user
) "default-user"))
992 (should (string-equal
993 (file-remote-p "/[method/]" 'host
) "default-host"))
994 (should (string-equal (file-remote-p "/[method/]" 'localname
) ""))
995 (should (string-equal (file-remote-p "/[method/]" 'hop
) nil
))
997 ;; Expand `tramp-default-method' and `tramp-default-user'.
998 (should (string-equal
999 (file-remote-p "/[/host]")
1001 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1002 (should (string-equal
1003 (file-remote-p "/[/host]" 'method
) "default-method"))
1004 (should (string-equal
1005 (file-remote-p "/[/host]" 'user
) "default-user"))
1006 (should (string-equal (file-remote-p "/[/host]" 'host
) "host"))
1007 (should (string-equal (file-remote-p "/[/host]" 'localname
) ""))
1008 (should (string-equal (file-remote-p "/[/host]" 'hop
) nil
))
1010 ;; Expand `tramp-default-method' and `tramp-default-host'.
1011 (should (string-equal
1012 (file-remote-p "/[/user@]")
1014 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1015 (should (string-equal
1016 (file-remote-p "/[/user@]" 'method
) "default-method"))
1017 (should (string-equal (file-remote-p "/[/user@]" 'user
) "user"))
1018 (should (string-equal
1019 (file-remote-p "/[/user@]" 'host
) "default-host"))
1020 (should (string-equal (file-remote-p "/[/user@]" 'localname
) ""))
1021 (should (string-equal (file-remote-p "/[/user@]" 'hop
) nil
))
1023 ;; Expand `tramp-default-method'.
1024 (should (string-equal
1025 (file-remote-p "/[/user@host]")
1026 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1027 (should (string-equal
1028 (file-remote-p "/[/user@host]" 'method
) "default-method"))
1029 (should (string-equal (file-remote-p "/[/user@host]" 'user
) "user"))
1030 (should (string-equal (file-remote-p "/[/user@host]" 'host
) "host"))
1031 (should (string-equal (file-remote-p "/[/user@host]" 'localname
) ""))
1032 (should (string-equal (file-remote-p "/[/user@host]" 'hop
) nil
))
1034 ;; Expand `tramp-default-method' and `tramp-default-user'.
1035 (should (string-equal
1036 (file-remote-p "/[-/host]")
1038 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1039 (should (string-equal
1040 (file-remote-p "/[-/host]" 'method
) "default-method"))
1041 (should (string-equal
1042 (file-remote-p "/[-/host]" 'user
) "default-user"))
1043 (should (string-equal (file-remote-p "/[-/host]" 'host
) "host"))
1044 (should (string-equal (file-remote-p "/[-/host]" 'localname
) ""))
1045 (should (string-equal (file-remote-p "/[-/host]" 'hop
) nil
))
1047 ;; Expand `tramp-default-method' and `tramp-default-host'.
1048 (should (string-equal
1049 (file-remote-p "/[-/user@]")
1051 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1052 (should (string-equal
1053 (file-remote-p "/[-/user@]" 'method
) "default-method"))
1054 (should (string-equal (file-remote-p "/[-/user@]" 'user
) "user"))
1055 (should (string-equal
1056 (file-remote-p "/[-/user@]" 'host
) "default-host"))
1057 (should (string-equal (file-remote-p "/[-/user@]" 'localname
) ""))
1058 (should (string-equal (file-remote-p "/[-/user@]" 'hop
) nil
))
1060 ;; Expand `tramp-default-method'.
1061 (should (string-equal
1062 (file-remote-p "/[-/user@host]")
1063 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1064 (should (string-equal
1065 (file-remote-p "/[-/user@host]" 'method
) "default-method"))
1066 (should (string-equal (file-remote-p "/[-/user@host]" 'user
) "user"))
1067 (should (string-equal (file-remote-p "/[-/user@host]" 'host
) "host"))
1068 (should (string-equal (file-remote-p "/[-/user@host]" 'localname
) ""))
1069 (should (string-equal (file-remote-p "/[-/user@host]" 'hop
) nil
))
1071 ;; Expand `tramp-default-user'.
1072 (should (string-equal
1073 (file-remote-p "/[method/host]")
1074 (format "/[%s/%s@%s]" "method" "default-user" "host")))
1075 (should (string-equal
1076 (file-remote-p "/[method/host]" 'method
) "method"))
1077 (should (string-equal
1078 (file-remote-p "/[method/host]" 'user
) "default-user"))
1079 (should (string-equal (file-remote-p "/[method/host]" 'host
) "host"))
1080 (should (string-equal (file-remote-p "/[method/host]" 'localname
) ""))
1081 (should (string-equal (file-remote-p "/[method/host]" 'hop
) nil
))
1083 ;; Expand `tramp-default-host'.
1084 (should (string-equal
1085 (file-remote-p "/[method/user@]")
1086 (format "/[%s/%s@%s]" "method" "user" "default-host")))
1087 (should (string-equal
1088 (file-remote-p "/[method/user@]" 'method
) "method"))
1089 (should (string-equal (file-remote-p "/[method/user@]" 'user
) "user"))
1090 (should (string-equal
1091 (file-remote-p "/[method/user@]" 'host
) "default-host"))
1092 (should (string-equal
1093 (file-remote-p "/[method/user@]" 'localname
) ""))
1094 (should (string-equal (file-remote-p "/[method/user@]" 'hop
) nil
))
1097 (should (string-equal
1098 (file-remote-p "/[method/user@host]")
1099 (format "/[%s/%s@%s]" "method" "user" "host")))
1100 (should (string-equal
1101 (file-remote-p "/[method/user@host]" 'method
) "method"))
1102 (should (string-equal
1103 (file-remote-p "/[method/user@host]" 'user
) "user"))
1104 (should (string-equal
1105 (file-remote-p "/[method/user@host]" 'host
) "host"))
1106 (should (string-equal
1107 (file-remote-p "/[method/user@host]" 'localname
) ""))
1108 (should (string-equal
1109 (file-remote-p "/[method/user@host]" 'hop
) nil
))
1112 (should (string-equal
1113 (file-remote-p "/[method/user@email@host]")
1114 (format "/[%s/%s@%s]" "method" "user@email" "host")))
1115 (should (string-equal
1117 "/[method/user@email@host]" 'method
) "method"))
1118 (should (string-equal
1120 "/[method/user@email@host]" 'user
) "user@email"))
1121 (should (string-equal
1122 (file-remote-p "/[method/user@email@host]" 'host
) "host"))
1123 (should (string-equal
1124 (file-remote-p "/[method/user@email@host]" 'localname
) ""))
1125 (should (string-equal
1126 (file-remote-p "/[method/user@email@host]" 'hop
) nil
))
1128 ;; Expand `tramp-default-method' and `tramp-default-user'.
1129 (should (string-equal
1130 (file-remote-p "/[/host#1234]")
1132 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1133 (should (string-equal
1134 (file-remote-p "/[/host#1234]" 'method
) "default-method"))
1135 (should (string-equal
1136 (file-remote-p "/[/host#1234]" 'user
) "default-user"))
1137 (should (string-equal
1138 (file-remote-p "/[/host#1234]" 'host
) "host#1234"))
1139 (should (string-equal (file-remote-p "/[/host#1234]" 'localname
) ""))
1140 (should (string-equal (file-remote-p "/[/host#1234]" 'hop
) nil
))
1142 ;; Expand `tramp-default-method'.
1143 (should (string-equal
1144 (file-remote-p "/[/user@host#1234]")
1145 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1146 (should (string-equal
1148 "/[/user@host#1234]" 'method
) "default-method"))
1149 (should (string-equal
1151 "/[/user@host#1234]" 'user
) "user"))
1152 (should (string-equal
1153 (file-remote-p "/[/user@host#1234]" 'host
) "host#1234"))
1154 (should (string-equal
1155 (file-remote-p "/[/user@host#1234]" 'localname
) ""))
1156 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop
) nil
))
1158 ;; Expand `tramp-default-method' and `tramp-default-user'.
1159 (should (string-equal
1160 (file-remote-p "/[-/host#1234]")
1162 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1163 (should (string-equal
1164 (file-remote-p "/[-/host#1234]" 'method
) "default-method"))
1165 (should (string-equal
1166 (file-remote-p "/[-/host#1234]" 'user
) "default-user"))
1167 (should (string-equal
1168 (file-remote-p "/[-/host#1234]" 'host
) "host#1234"))
1169 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname
) ""))
1170 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop
) nil
))
1172 ;; Expand `tramp-default-method'.
1173 (should (string-equal
1174 (file-remote-p "/[-/user@host#1234]")
1175 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1176 (should (string-equal
1178 "/[-/user@host#1234]" 'method
) "default-method"))
1179 (should (string-equal
1181 "/[-/user@host#1234]" 'user
) "user"))
1182 (should (string-equal
1183 (file-remote-p "/[-/user@host#1234]" 'host
) "host#1234"))
1184 (should (string-equal
1185 (file-remote-p "/[-/user@host#1234]" 'localname
) ""))
1186 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop
) nil
))
1188 ;; Expand `tramp-default-user'.
1189 (should (string-equal
1190 (file-remote-p "/[method/host#1234]")
1191 (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1192 (should (string-equal
1193 (file-remote-p "/[method/host#1234]" 'method
) "method"))
1194 (should (string-equal
1195 (file-remote-p "/[method/host#1234]" 'user
) "default-user"))
1196 (should (string-equal
1197 (file-remote-p "/[method/host#1234]" 'host
) "host#1234"))
1198 (should (string-equal
1199 (file-remote-p "/[method/host#1234]" 'localname
) ""))
1200 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop
) nil
))
1203 (should (string-equal
1204 (file-remote-p "/[method/user@host#1234]")
1205 (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1206 (should (string-equal
1207 (file-remote-p "/[method/user@host#1234]" 'method
) "method"))
1208 (should (string-equal
1209 (file-remote-p "/[method/user@host#1234]" 'user
) "user"))
1210 (should (string-equal
1212 "/[method/user@host#1234]" 'host
) "host#1234"))
1213 (should (string-equal
1214 (file-remote-p "/[method/user@host#1234]" 'localname
) ""))
1215 (should (string-equal
1216 (file-remote-p "/[method/user@host#1234]" 'hop
) nil
))
1218 ;; Expand `tramp-default-method' and `tramp-default-user'.
1219 (should (string-equal
1220 (file-remote-p "/[/1.2.3.4]")
1222 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1223 (should (string-equal
1224 (file-remote-p "/[/1.2.3.4]" 'method
) "default-method"))
1225 (should (string-equal
1226 (file-remote-p "/[/1.2.3.4]" 'user
) "default-user"))
1227 (should (string-equal
1228 (file-remote-p "/[/1.2.3.4]" 'host
) "1.2.3.4"))
1229 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname
) ""))
1230 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop
) nil
))
1232 ;; Expand `tramp-default-method'.
1233 (should (string-equal
1234 (file-remote-p "/[/user@1.2.3.4]")
1235 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1236 (should (string-equal
1238 "/[/user@1.2.3.4]" 'method
) "default-method"))
1239 (should (string-equal
1240 (file-remote-p "/[/user@1.2.3.4]" 'user
) "user"))
1241 (should (string-equal
1242 (file-remote-p "/[/user@1.2.3.4]" 'host
) "1.2.3.4"))
1243 (should (string-equal
1244 (file-remote-p "/[/user@1.2.3.4]" 'localname
) ""))
1245 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop
) nil
))
1247 ;; Expand `tramp-default-method' and `tramp-default-user'.
1248 (should (string-equal
1249 (file-remote-p "/[-/1.2.3.4]")
1251 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1252 (should (string-equal
1253 (file-remote-p "/[-/1.2.3.4]" 'method
) "default-method"))
1254 (should (string-equal
1255 (file-remote-p "/[-/1.2.3.4]" 'user
) "default-user"))
1256 (should (string-equal
1257 (file-remote-p "/[-/1.2.3.4]" 'host
) "1.2.3.4"))
1258 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname
) ""))
1259 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop
) nil
))
1261 ;; Expand `tramp-default-method'.
1262 (should (string-equal
1263 (file-remote-p "/[-/user@1.2.3.4]")
1264 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1265 (should (string-equal
1267 "/[-/user@1.2.3.4]" 'method
) "default-method"))
1268 (should (string-equal
1269 (file-remote-p "/[-/user@1.2.3.4]" 'user
) "user"))
1270 (should (string-equal
1271 (file-remote-p "/[-/user@1.2.3.4]" 'host
) "1.2.3.4"))
1272 (should (string-equal
1273 (file-remote-p "/[-/user@1.2.3.4]" 'localname
) ""))
1274 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop
) nil
))
1276 ;; Expand `tramp-default-user'.
1277 (should (string-equal
1278 (file-remote-p "/[method/1.2.3.4]")
1279 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1280 (should (string-equal
1281 (file-remote-p "/[method/1.2.3.4]" 'method
) "method"))
1282 (should (string-equal
1283 (file-remote-p "/[method/1.2.3.4]" 'user
) "default-user"))
1284 (should (string-equal
1285 (file-remote-p "/[method/1.2.3.4]" 'host
) "1.2.3.4"))
1286 (should (string-equal
1287 (file-remote-p "/[method/1.2.3.4]" 'localname
) ""))
1288 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop
) nil
))
1291 (should (string-equal
1292 (file-remote-p "/[method/user@1.2.3.4]")
1293 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1294 (should (string-equal
1295 (file-remote-p "/[method/user@1.2.3.4]" 'method
) "method"))
1296 (should (string-equal
1297 (file-remote-p "/[method/user@1.2.3.4]" 'user
) "user"))
1298 (should (string-equal
1299 (file-remote-p "/[method/user@1.2.3.4]" 'host
) "1.2.3.4"))
1300 (should (string-equal
1301 (file-remote-p "/[method/user@1.2.3.4]" 'localname
) ""))
1302 (should (string-equal
1303 (file-remote-p "/[method/user@1.2.3.4]" 'hop
) nil
))
1305 ;; Expand `tramp-default-method', `tramp-default-user' and
1306 ;; `tramp-default-host'.
1307 (should (string-equal
1308 (file-remote-p "/[/]")
1311 "default-method" "default-user" "default-host")))
1312 (should (string-equal
1313 (file-remote-p "/[/]" 'method
) "default-method"))
1314 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1315 (should (string-equal (file-remote-p "/[/]" 'host
) "default-host"))
1316 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1317 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
))
1319 ;; Expand `tramp-default-method' and `tramp-default-user'.
1320 (let ((tramp-default-host "::1"))
1321 (should (string-equal
1322 (file-remote-p "/[/]")
1325 "default-method" "default-user" "::1")))
1326 (should (string-equal
1327 (file-remote-p "/[/]" 'method
) "default-method"))
1328 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1329 (should (string-equal (file-remote-p "/[/]" 'host
) "::1"))
1330 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1331 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
)))
1333 ;; Expand `tramp-default-method' and `tramp-default-user'.
1334 (should (string-equal
1335 (file-remote-p "/[/::1]")
1337 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1338 (should (string-equal
1339 (file-remote-p "/[/::1]" 'method
) "default-method"))
1340 (should (string-equal
1341 (file-remote-p "/[/::1]" 'user
) "default-user"))
1342 (should (string-equal (file-remote-p "/[/::1]" 'host
) "::1"))
1343 (should (string-equal (file-remote-p "/[/::1]" 'localname
) ""))
1344 (should (string-equal (file-remote-p "/[/::1]" 'hop
) nil
))
1346 ;; Expand `tramp-default-method'.
1347 (should (string-equal
1348 (file-remote-p "/[/user@::1]")
1349 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1350 (should (string-equal
1351 (file-remote-p "/[/user@::1]" 'method
) "default-method"))
1352 (should (string-equal (file-remote-p "/[/user@::1]" 'user
) "user"))
1353 (should (string-equal (file-remote-p "/[/user@::1]" 'host
) "::1"))
1354 (should (string-equal (file-remote-p "/[/user@::1]" 'localname
) ""))
1355 (should (string-equal (file-remote-p "/[/user@::1]" 'hop
) nil
))
1357 ;; Expand `tramp-default-method', `tramp-default-user' and
1358 ;; `tramp-default-host'.
1359 (should (string-equal
1360 (file-remote-p "/[-/]")
1363 "default-method" "default-user" "default-host")))
1364 (should (string-equal
1365 (file-remote-p "/[-/]" 'method
) "default-method"))
1366 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1367 (should (string-equal (file-remote-p "/[-/]" 'host
) "default-host"))
1368 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1369 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
))
1371 ;; Expand `tramp-default-method' and `tramp-default-user'.
1372 (let ((tramp-default-host "::1"))
1373 (should (string-equal
1374 (file-remote-p "/[-/]")
1377 "default-method" "default-user" "::1")))
1378 (should (string-equal
1379 (file-remote-p "/[-/]" 'method
) "default-method"))
1380 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1381 (should (string-equal (file-remote-p "/[-/]" 'host
) "::1"))
1382 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1383 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
)))
1385 ;; Expand `tramp-default-method' and `tramp-default-user'.
1386 (should (string-equal
1387 (file-remote-p "/[-/::1]")
1389 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1390 (should (string-equal
1391 (file-remote-p "/[-/::1]" 'method
) "default-method"))
1392 (should (string-equal
1393 (file-remote-p "/[-/::1]" 'user
) "default-user"))
1394 (should (string-equal (file-remote-p "/[-/::1]" 'host
) "::1"))
1395 (should (string-equal (file-remote-p "/[-/::1]" 'localname
) ""))
1396 (should (string-equal (file-remote-p "/[-/::1]" 'hop
) nil
))
1398 ;; Expand `tramp-default-method'.
1399 (should (string-equal
1400 (file-remote-p "/[-/user@::1]")
1401 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1402 (should (string-equal
1403 (file-remote-p "/[-/user@::1]" 'method
) "default-method"))
1404 (should (string-equal (file-remote-p "/[-/user@::1]" 'user
) "user"))
1405 (should (string-equal (file-remote-p "/[-/user@::1]" 'host
) "::1"))
1406 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname
) ""))
1407 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop
) nil
))
1409 ;; Expand `tramp-default-user'.
1410 (should (string-equal
1411 (file-remote-p "/[method/::1]")
1412 (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1413 (should (string-equal
1414 (file-remote-p "/[method/::1]" 'method
) "method"))
1415 (should (string-equal
1416 (file-remote-p "/[method/::1]" 'user
) "default-user"))
1417 (should (string-equal (file-remote-p "/[method/::1]" 'host
) "::1"))
1418 (should (string-equal (file-remote-p "/[method/::1]" 'localname
) ""))
1419 (should (string-equal (file-remote-p "/[method/::1]" 'hop
) nil
))
1422 (should (string-equal
1423 (file-remote-p "/[method/user@::1]")
1424 (format "/[%s/%s@%s]" "method" "user" "::1")))
1425 (should (string-equal
1426 (file-remote-p "/[method/user@::1]" 'method
) "method"))
1427 (should (string-equal
1428 (file-remote-p "/[method/user@::1]" 'user
) "user"))
1429 (should (string-equal
1430 (file-remote-p "/[method/user@::1]" 'host
) "::1"))
1431 (should (string-equal
1432 (file-remote-p "/[method/user@::1]" 'localname
) ""))
1433 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop
) nil
))
1435 ;; Local file name part.
1436 (should (string-equal (file-remote-p "/[/host]/:" 'localname
) "/:"))
1437 (should (string-equal (file-remote-p "/[-/host]/:" 'localname
) "/:"))
1438 (should (string-equal (file-remote-p "/[method/]:" 'localname
) ":"))
1439 (should (string-equal (file-remote-p "/[method/] " 'localname
) " "))
1440 (should (string-equal
1441 (file-remote-p "/[method/]file" 'localname
) "file"))
1442 (should (string-equal
1443 (file-remote-p "/[method/]/path/to/file" 'localname
)
1450 "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1451 (format "/[%s/%s@%s|%s/%s@%s]"
1452 "method1" "user1" "host1" "method2" "user2" "host2")))
1456 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method
)
1461 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user
)
1466 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host
)
1471 "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1477 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop
)
1479 "method1" "user1" "host1")))
1485 "/[method1/user1@host1"
1486 "|method2/user2@host2"
1487 "|method3/user3@host3]/path/to/file"))
1488 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1489 "method1" "user1" "host1"
1490 "method2" "user2" "host2"
1491 "method3" "user3" "host3")))
1496 "/[method1/user1@host1"
1497 "|method2/user2@host2"
1498 "|method3/user3@host3]/path/to/file")
1505 "/[method1/user1@host1"
1506 "|method2/user2@host2"
1507 "|method3/user3@host3]/path/to/file")
1514 "/[method1/user1@host1"
1515 "|method2/user2@host2"
1516 "|method3/user3@host3]/path/to/file")
1523 "/[method1/user1@host1"
1524 "|method2/user2@host2"
1525 "|method3/user3@host3]/path/to/file")
1532 "/[method1/user1@host1"
1533 "|method2/user2@host2"
1534 "|method3/user3@host3]/path/to/file")
1536 (format "%s/%s@%s|%s/%s@%s|"
1537 "method1" "user1" "host1" "method2" "user2" "host2"))))
1540 (tramp-change-syntax syntax
))))
1542 (ert-deftest tramp-test03-file-name-defaults
()
1543 "Check default values for some methods."
1544 ;; Default values in tramp-adb.el.
1545 (should (string-equal (file-remote-p "/adb::" 'host
) ""))
1546 ;; Default values in tramp-ftp.el.
1547 (should (string-equal (file-remote-p "/-:ftp.host:" 'method
) "ftp"))
1548 (dolist (u '("ftp" "anonymous"))
1549 (should (string-equal (file-remote-p (format "/-:%s@:" u
) 'method
) "ftp")))
1550 ;; Default values in tramp-gvfs.el.
1551 (when (and (load "tramp-gvfs" 'noerror
'nomessage
)
1552 (symbol-value 'tramp-gvfs-enabled
))
1553 (should (string-equal (file-remote-p "/synce::" 'user
) nil
)))
1554 ;; Default values in tramp-sh.el.
1555 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1557 (string-equal (file-remote-p (format "/-:root@%s:" h
) 'method
) "su")))
1558 (dolist (m '("su" "sudo" "ksu"))
1559 (should (string-equal (file-remote-p (format "/%s::" m
) 'user
) "root")))
1560 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1562 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
1563 ;; Default values in tramp-smb.el.
1564 (should (string-equal (file-remote-p "/smb::" 'user
) nil
)))
1566 (ert-deftest tramp-test04-substitute-in-file-name
()
1567 "Check `substitute-in-file-name'."
1568 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
1571 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1573 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1574 ;; Quoting local part.
1577 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1580 (substitute-in-file-name "/method:host:/:/path//foo")
1581 "/method:host:/:/path//foo"))
1584 (substitute-in-file-name "/method:host:/:/path///foo")
1585 "/method:host:/:/path///foo"))
1589 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
1591 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
1592 ;; Quoting local part.
1595 (substitute-in-file-name "/method:host:/:/path/~/foo")
1596 "/method:host:/:/path/~/foo"))
1599 (substitute-in-file-name "/method:host:/:/path//~/foo")
1600 "/method:host:/:/path//~/foo"))
1602 (let (process-environment)
1605 (substitute-in-file-name "/method:host:/path/$FOO")
1606 "/method:host:/path/$FOO"))
1607 (setenv "FOO" "bla")
1610 (substitute-in-file-name "/method:host:/path/$FOO")
1611 "/method:host:/path/bla"))
1614 (substitute-in-file-name "/method:host:/path/$$FOO")
1615 "/method:host:/path/$FOO"))
1616 ;; Quoting local part.
1619 (substitute-in-file-name "/method:host:/:/path/$FOO")
1620 "/method:host:/:/path/$FOO"))
1621 (setenv "FOO" "bla")
1624 (substitute-in-file-name "/method:host:/:/path/$FOO")
1625 "/method:host:/:/path/$FOO"))
1628 (substitute-in-file-name "/method:host:/:/path/$$FOO")
1629 "/method:host:/:/path/$$FOO"))))
1631 (ert-deftest tramp-test05-expand-file-name
()
1632 "Check `expand-file-name'."
1635 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1638 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1639 ;; Quoting local part.
1642 (expand-file-name "/method:host:/:/path/./file")
1643 "/method:host:/:/path/file"))
1646 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1649 (expand-file-name "/method:host:/:/~/path/./file")
1650 "/method:host:/:/~/path/file")))
1652 ;; The following test is inspired by Bug#26911. It is rather a bug in
1653 ;; `expand-file-name', and it fails for all Emacs versions. Test
1654 ;; added for later, when it is fixed.
1655 (ert-deftest tramp-test05-expand-file-name-relative
()
1656 "Check `expand-file-name'."
1657 ;; Mark as failed until bug has been fixed.
1658 :expected-result
:failed
1659 (skip-unless (tramp--test-enabled))
1660 ;; These are the methods the test doesn't fail.
1661 (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1662 (tramp-smb-file-name-p tramp-test-temporary-file-directory
))
1663 (setf (ert-test-expected-result-type
1664 (ert-get-test 'tramp-test05-expand-file-name-relative
))
1669 (let ((default-directory
1671 (file-remote-p tramp-test-temporary-file-directory
) "/path")))
1672 (expand-file-name ".." "./"))
1673 (concat (file-remote-p tramp-test-temporary-file-directory
) "/"))))
1675 (ert-deftest tramp-test06-directory-file-name
()
1676 "Check `directory-file-name'.
1677 This checks also `file-name-as-directory', `file-name-directory',
1678 `file-name-nondirectory' and `unhandled-file-name-directory'."
1681 (directory-file-name "/method:host:/path/to/file")
1682 "/method:host:/path/to/file"))
1685 (directory-file-name "/method:host:/path/to/file/")
1686 "/method:host:/path/to/file"))
1689 (file-name-as-directory "/method:host:/path/to/file")
1690 "/method:host:/path/to/file/"))
1693 (file-name-as-directory "/method:host:/path/to/file/")
1694 "/method:host:/path/to/file/"))
1697 (file-name-directory "/method:host:/path/to/file")
1698 "/method:host:/path/to/"))
1701 (file-name-directory "/method:host:/path/to/file/")
1702 "/method:host:/path/to/file/"))
1704 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1706 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1708 (unhandled-file-name-directory "/method:host:/path/to/file"))
1711 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1712 (dolist (n-e '(nil t
))
1713 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1714 ;; which ruins the tests.
1715 (let ((non-essential n-e
)
1716 tramp-default-method
)
1721 (file-remote-p tramp-test-temporary-file-directory
'method
))
1724 (file-remote-p tramp-test-temporary-file-directory
'host
))))
1725 (should (string-equal (directory-file-name file
) file
))
1728 (file-name-as-directory file
)
1729 (if (tramp-completion-mode-p)
1730 file
(concat file
"./"))))
1731 (should (string-equal (file-name-directory file
) file
))
1732 (should (string-equal (file-name-nondirectory file
) "")))))))
1734 (ert-deftest tramp-test07-file-exists-p
()
1735 "Check `file-exist-p', `write-region' and `delete-file'."
1736 (skip-unless (tramp--test-enabled))
1738 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1739 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1740 (should-not (file-exists-p tmp-name
))
1741 (write-region "foo" nil tmp-name
)
1742 (should (file-exists-p tmp-name
))
1743 (delete-file tmp-name
)
1744 (should-not (file-exists-p tmp-name
)))))
1746 (ert-deftest tramp-test08-file-local-copy
()
1747 "Check `file-local-copy'."
1748 (skip-unless (tramp--test-enabled))
1750 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1751 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1755 (write-region "foo" nil tmp-name1
)
1756 (should (setq tmp-name2
(file-local-copy tmp-name1
)))
1758 (insert-file-contents tmp-name2
)
1759 (should (string-equal (buffer-string) "foo")))
1760 ;; Check also that a file transfer with compression works.
1761 (let ((default-directory tramp-test-temporary-file-directory
)
1762 (tramp-copy-size-limit 4)
1763 (tramp-inline-compress-start-size 2))
1764 (delete-file tmp-name2
)
1765 (should (setq tmp-name2
(file-local-copy tmp-name1
)))))
1769 (delete-file tmp-name1
)
1770 (delete-file tmp-name2
))))))
1772 (ert-deftest tramp-test09-insert-file-contents
()
1773 "Check `insert-file-contents'."
1774 (skip-unless (tramp--test-enabled))
1776 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1777 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1780 (write-region "foo" nil tmp-name
)
1782 (insert-file-contents tmp-name
)
1783 (should (string-equal (buffer-string) "foo"))
1784 (insert-file-contents tmp-name
)
1785 (should (string-equal (buffer-string) "foofoo"))
1787 (insert-file-contents tmp-name nil
1 3)
1788 (should (string-equal (buffer-string) "oofoofoo"))
1790 (insert-file-contents tmp-name nil nil nil
'replace
)
1791 (should (string-equal (buffer-string) "foo"))))
1794 (ignore-errors (delete-file tmp-name
))))))
1796 (ert-deftest tramp-test10-write-region
()
1797 "Check `write-region'."
1798 (skip-unless (tramp--test-enabled))
1800 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1801 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1804 ;; Write buffer. Use absolute and relative file name.
1807 (write-region nil nil tmp-name
))
1809 (insert-file-contents tmp-name
)
1810 (should (string-equal (buffer-string) "foo")))
1811 (delete-file tmp-name
)
1814 (should-not (file-exists-p tmp-name
))
1815 (let ((default-directory (file-name-directory tmp-name
)))
1816 (should-not (file-exists-p (file-name-nondirectory tmp-name
)))
1817 (write-region nil nil
(file-name-nondirectory tmp-name
))
1818 (should (file-exists-p (file-name-nondirectory tmp-name
))))
1819 (should (file-exists-p tmp-name
)))
1821 (insert-file-contents tmp-name
)
1822 (should (string-equal (buffer-string) "foo")))
1827 (write-region nil nil tmp-name
'append
))
1829 (insert-file-contents tmp-name
)
1830 (should (string-equal (buffer-string) "foobla")))
1833 (write-region nil nil tmp-name
3))
1835 (insert-file-contents tmp-name
)
1836 (should (string-equal (buffer-string) "foobaz")))
1839 (write-region "foo" nil tmp-name
)
1841 (insert-file-contents tmp-name
)
1842 (should (string-equal (buffer-string) "foo")))
1846 (insert "123456789")
1847 (write-region 3 5 tmp-name
))
1849 (insert-file-contents tmp-name
)
1850 (should (string-equal (buffer-string) "34")))
1852 ;; Do not overwrite if excluded.
1853 (cl-letf (((symbol-function 'y-or-n-p
) (lambda (_prompt) t
)))
1854 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
1855 ;; `mustbenew' is passed to Tramp since Emacs 26.1. We
1856 ;; have no test for this, so we check function
1857 ;; `temporary-file-directory', which has been added to
1858 ;; Emacs 26.1 as well.
1859 (when (fboundp 'temporary-file-directory
)
1861 (cl-letf (((symbol-function 'y-or-n-p
) 'ignore
))
1862 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
1863 :type
'file-already-exists
)
1865 (write-region "foo" nil tmp-name nil nil nil
'excl
)
1866 :type
'file-already-exists
)))
1869 (ignore-errors (delete-file tmp-name
))))))
1871 (ert-deftest tramp-test11-copy-file
()
1872 "Check `copy-file'."
1873 (skip-unless (tramp--test-enabled))
1875 ;; TODO: The quoted case does not work.
1876 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1878 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1879 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1880 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
1881 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
1882 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
1884 ;; Copy on remote side.
1887 (write-region "foo" nil tmp-name1
)
1888 (copy-file tmp-name1 tmp-name2
)
1889 (should (file-exists-p tmp-name2
))
1891 (insert-file-contents tmp-name2
)
1892 (should (string-equal (buffer-string) "foo")))
1893 (should-error (copy-file tmp-name1 tmp-name2
))
1894 (copy-file tmp-name1 tmp-name2
'ok
)
1895 (make-directory tmp-name3
)
1896 (copy-file tmp-name1 tmp-name3
)
1899 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
1902 (ignore-errors (delete-file tmp-name1
))
1903 (ignore-errors (delete-file tmp-name2
))
1904 (ignore-errors (delete-directory tmp-name3
'recursive
)))
1906 ;; Copy from remote side to local side.
1909 (write-region "foo" nil tmp-name1
)
1910 (copy-file tmp-name1 tmp-name4
)
1911 (should (file-exists-p tmp-name4
))
1913 (insert-file-contents tmp-name4
)
1914 (should (string-equal (buffer-string) "foo")))
1915 (should-error (copy-file tmp-name1 tmp-name4
))
1916 (copy-file tmp-name1 tmp-name4
'ok
)
1917 (make-directory tmp-name5
)
1918 (copy-file tmp-name1 tmp-name5
)
1921 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
1924 (ignore-errors (delete-file tmp-name1
))
1925 (ignore-errors (delete-file tmp-name4
))
1926 (ignore-errors (delete-directory tmp-name5
'recursive
)))
1928 ;; Copy from local side to remote side.
1931 (write-region "foo" nil tmp-name4 nil
'nomessage
)
1932 (copy-file tmp-name4 tmp-name1
)
1933 (should (file-exists-p tmp-name1
))
1935 (insert-file-contents tmp-name1
)
1936 (should (string-equal (buffer-string) "foo")))
1937 (should-error (copy-file tmp-name4 tmp-name1
))
1938 (copy-file tmp-name4 tmp-name1
'ok
)
1939 (make-directory tmp-name3
)
1940 (copy-file tmp-name4 tmp-name3
)
1943 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
1946 (ignore-errors (delete-file tmp-name1
))
1947 (ignore-errors (delete-file tmp-name4
))
1948 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
1950 (ert-deftest tramp-test12-rename-file
()
1951 "Check `rename-file'."
1952 (skip-unless (tramp--test-enabled))
1954 ;; TODO: The quoted case does not work.
1955 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1957 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1958 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1959 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
1960 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
1961 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
1963 ;; Rename on remote side.
1966 (write-region "foo" nil tmp-name1
)
1967 (rename-file tmp-name1 tmp-name2
)
1968 (should-not (file-exists-p tmp-name1
))
1969 (should (file-exists-p tmp-name2
))
1971 (insert-file-contents tmp-name2
)
1972 (should (string-equal (buffer-string) "foo")))
1973 (write-region "foo" nil tmp-name1
)
1974 (should-error (rename-file tmp-name1 tmp-name2
))
1975 (rename-file tmp-name1 tmp-name2
'ok
)
1976 (should-not (file-exists-p tmp-name1
))
1977 (write-region "foo" nil tmp-name1
)
1978 (make-directory tmp-name3
)
1979 (rename-file tmp-name1 tmp-name3
)
1980 (should-not (file-exists-p tmp-name1
))
1983 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
1986 (ignore-errors (delete-file tmp-name1
))
1987 (ignore-errors (delete-file tmp-name2
))
1988 (ignore-errors (delete-directory tmp-name3
'recursive
)))
1990 ;; Rename from remote side to local side.
1993 (write-region "foo" nil tmp-name1
)
1994 (rename-file tmp-name1 tmp-name4
)
1995 (should-not (file-exists-p tmp-name1
))
1996 (should (file-exists-p tmp-name4
))
1998 (insert-file-contents tmp-name4
)
1999 (should (string-equal (buffer-string) "foo")))
2000 (write-region "foo" nil tmp-name1
)
2001 (should-error (rename-file tmp-name1 tmp-name4
))
2002 (rename-file tmp-name1 tmp-name4
'ok
)
2003 (should-not (file-exists-p tmp-name1
))
2004 (write-region "foo" nil tmp-name1
)
2005 (make-directory tmp-name5
)
2006 (rename-file tmp-name1 tmp-name5
)
2007 (should-not (file-exists-p tmp-name1
))
2010 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
2013 (ignore-errors (delete-file tmp-name1
))
2014 (ignore-errors (delete-file tmp-name4
))
2015 (ignore-errors (delete-directory tmp-name5
'recursive
)))
2017 ;; Rename from local side to remote side.
2020 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2021 (rename-file tmp-name4 tmp-name1
)
2022 (should-not (file-exists-p tmp-name4
))
2023 (should (file-exists-p tmp-name1
))
2025 (insert-file-contents tmp-name1
)
2026 (should (string-equal (buffer-string) "foo")))
2027 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2028 (should-error (rename-file tmp-name4 tmp-name1
))
2029 (rename-file tmp-name4 tmp-name1
'ok
)
2030 (should-not (file-exists-p tmp-name4
))
2031 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2032 (make-directory tmp-name3
)
2033 (rename-file tmp-name4 tmp-name3
)
2034 (should-not (file-exists-p tmp-name4
))
2037 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
2040 (ignore-errors (delete-file tmp-name1
))
2041 (ignore-errors (delete-file tmp-name4
))
2042 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
2044 (ert-deftest tramp-test13-make-directory
()
2045 "Check `make-directory'.
2046 This tests also `file-directory-p' and `file-accessible-directory-p'."
2047 (skip-unless (tramp--test-enabled))
2049 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2050 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2051 (tmp-name2 (expand-file-name "foo/bar" tmp-name1
)))
2054 (make-directory tmp-name1
)
2055 (should (file-directory-p tmp-name1
))
2056 (should (file-accessible-directory-p tmp-name1
))
2057 (should-error (make-directory tmp-name2
))
2058 (make-directory tmp-name2
'parents
)
2059 (should (file-directory-p tmp-name2
))
2060 (should (file-accessible-directory-p tmp-name2
)))
2063 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2065 (ert-deftest tramp-test14-delete-directory
()
2066 "Check `delete-directory'."
2067 (skip-unless (tramp--test-enabled))
2069 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2070 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2071 ;; Delete empty directory.
2072 (make-directory tmp-name
)
2073 (should (file-directory-p tmp-name
))
2074 (delete-directory tmp-name
)
2075 (should-not (file-directory-p tmp-name
))
2076 ;; Delete non-empty directory.
2077 (make-directory tmp-name
)
2078 (should (file-directory-p tmp-name
))
2079 (write-region "foo" nil
(expand-file-name "bla" tmp-name
))
2080 (should (file-exists-p (expand-file-name "bla" tmp-name
)))
2081 (should-error (delete-directory tmp-name
))
2082 (delete-directory tmp-name
'recursive
)
2083 (should-not (file-directory-p tmp-name
)))))
2085 (ert-deftest tramp-test15-copy-directory
()
2086 "Check `copy-directory'."
2087 (skip-unless (tramp--test-enabled))
2089 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2090 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2091 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2092 (tmp-name3 (expand-file-name
2093 (file-name-nondirectory tmp-name1
) tmp-name2
))
2094 (tmp-name4 (expand-file-name "foo" tmp-name1
))
2095 (tmp-name5 (expand-file-name "foo" tmp-name2
))
2096 (tmp-name6 (expand-file-name "foo" tmp-name3
)))
2098 ;; Copy complete directory.
2101 ;; Copy empty directory.
2102 (make-directory tmp-name1
)
2103 (write-region "foo" nil tmp-name4
)
2104 (should (file-directory-p tmp-name1
))
2105 (should (file-exists-p tmp-name4
))
2106 (copy-directory tmp-name1 tmp-name2
)
2107 (should (file-directory-p tmp-name2
))
2108 (should (file-exists-p tmp-name5
))
2109 ;; Target directory does exist already.
2110 (copy-directory tmp-name1 tmp-name2
)
2111 (should (file-directory-p tmp-name3
))
2112 (should (file-exists-p tmp-name6
)))
2116 (delete-directory tmp-name1
'recursive
)
2117 (delete-directory tmp-name2
'recursive
)))
2119 ;; Copy directory contents.
2122 ;; Copy empty directory.
2123 (make-directory tmp-name1
)
2124 (write-region "foo" nil tmp-name4
)
2125 (should (file-directory-p tmp-name1
))
2126 (should (file-exists-p tmp-name4
))
2127 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
2128 (should (file-directory-p tmp-name2
))
2129 (should (file-exists-p tmp-name5
))
2130 ;; Target directory does exist already.
2131 (delete-file tmp-name5
)
2132 (should-not (file-exists-p tmp-name5
))
2133 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
2134 (should (file-directory-p tmp-name2
))
2135 (should (file-exists-p tmp-name5
))
2136 (should-not (file-directory-p tmp-name3
))
2137 (should-not (file-exists-p tmp-name6
)))
2141 (delete-directory tmp-name1
'recursive
)
2142 (delete-directory tmp-name2
'recursive
))))))
2144 (ert-deftest tramp-test16-directory-files
()
2145 "Check `directory-files'."
2146 (skip-unless (tramp--test-enabled))
2148 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2149 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2150 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2151 (tmp-name3 (expand-file-name "foo" tmp-name1
)))
2154 (make-directory tmp-name1
)
2155 (write-region "foo" nil tmp-name2
)
2156 (write-region "bla" nil tmp-name3
)
2157 (should (file-directory-p tmp-name1
))
2158 (should (file-exists-p tmp-name2
))
2159 (should (file-exists-p tmp-name3
))
2160 (should (equal (directory-files tmp-name1
) '("." ".." "bla" "foo")))
2161 (should (equal (directory-files tmp-name1
'full
)
2162 `(,(concat tmp-name1
"/.")
2163 ,(concat tmp-name1
"/..")
2164 ,tmp-name2
,tmp-name3
)))
2165 (should (equal (directory-files
2166 tmp-name1 nil directory-files-no-dot-files-regexp
)
2168 (should (equal (directory-files
2169 tmp-name1
'full directory-files-no-dot-files-regexp
)
2170 `(,tmp-name2
,tmp-name3
))))
2173 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2175 ;; This is not a file name handler test. But Tramp needed to apply an
2176 ;; advice for older Emacs versions, so we check that this has been fixed.
2177 (ert-deftest tramp-test16-file-expand-wildcards
()
2178 "Check `file-expand-wildcards'."
2179 (skip-unless (tramp--test-enabled))
2181 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2182 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2183 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2184 (tmp-name3 (expand-file-name "bar" tmp-name1
))
2185 (tmp-name4 (expand-file-name "baz" tmp-name1
))
2186 (default-directory tmp-name1
))
2189 (make-directory tmp-name1
)
2190 (write-region "foo" nil tmp-name2
)
2191 (write-region "bar" nil tmp-name3
)
2192 (write-region "baz" nil tmp-name4
)
2193 (should (file-directory-p tmp-name1
))
2194 (should (file-exists-p tmp-name2
))
2195 (should (file-exists-p tmp-name3
))
2196 (should (file-exists-p tmp-name4
))
2198 ;; We cannot use `sort', it works destructive.
2199 (should (equal (file-expand-wildcards "*")
2200 (seq-sort 'string
< '("foo" "bar" "baz"))))
2201 (should (equal (file-expand-wildcards "ba?")
2202 (seq-sort 'string
< '("bar" "baz"))))
2203 (should (equal (file-expand-wildcards "ba[rz]")
2204 (seq-sort 'string
< '("bar" "baz"))))
2206 (should (equal (file-expand-wildcards "*" 'full
)
2208 'string
< `(,tmp-name2
,tmp-name3
,tmp-name4
))))
2209 (should (equal (file-expand-wildcards "ba?" 'full
)
2210 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2211 (should (equal (file-expand-wildcards "ba[rz]" 'full
)
2212 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2214 (should (equal (file-expand-wildcards (concat tmp-name1
"/" "*"))
2216 'string
< `(,tmp-name2
,tmp-name3
,tmp-name4
))))
2217 (should (equal (file-expand-wildcards (concat tmp-name1
"/" "ba?"))
2218 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2219 (should (equal (file-expand-wildcards
2220 (concat tmp-name1
"/" "ba[rz]"))
2221 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
)))))
2225 (delete-directory tmp-name1
))))))
2227 (ert-deftest tramp-test17-insert-directory
()
2228 "Check `insert-directory'."
2229 (skip-unless (tramp--test-enabled))
2231 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2233 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2234 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2235 ;; We test for the summary line. Keyword "total" could be localized.
2236 (process-environment
2237 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment
)))
2240 (make-directory tmp-name1
)
2241 (write-region "foo" nil tmp-name2
)
2242 (should (file-directory-p tmp-name1
))
2243 (should (file-exists-p tmp-name2
))
2245 (insert-directory tmp-name1 nil
)
2246 (goto-char (point-min))
2247 (should (looking-at-p (regexp-quote tmp-name1
))))
2249 (insert-directory tmp-name1
"-al")
2250 (goto-char (point-min))
2252 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1
)))))
2254 (insert-directory (file-name-as-directory tmp-name1
) "-al")
2255 (goto-char (point-min))
2257 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1
)))))
2260 (file-name-as-directory tmp-name1
) "-al" nil
'full-directory-p
)
2261 (goto-char (point-min))
2265 ;; There might be a summary line.
2266 "\\(total.+[[:digit:]]+\n\\)?"
2267 ;; We don't know in which order ".", ".." and "foo" appear.
2268 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
2271 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2273 (ert-deftest tramp-test17-dired-with-wildcards
()
2274 "Check `dired' with wildcards."
2275 (skip-unless (tramp--test-enabled))
2276 (skip-unless (tramp--test-sh-p))
2277 ;; Since Emacs 26.1.
2278 (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p
))
2280 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2282 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2284 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2285 (tmp-name3 (expand-file-name "foo" tmp-name1
))
2286 (tmp-name4 (expand-file-name "bar" tmp-name2
))
2287 (tramp-test-temporary-file-directory
2289 (if quoted
'tramp-compat-file-name-quote
'identity
)
2290 tramp-test-temporary-file-directory
))
2294 (make-directory tmp-name1
)
2295 (write-region "foo" nil tmp-name3
)
2296 (should (file-directory-p tmp-name1
))
2297 (should (file-exists-p tmp-name3
))
2298 (make-directory tmp-name2
)
2299 (write-region "foo" nil tmp-name4
)
2300 (should (file-directory-p tmp-name2
))
2301 (should (file-exists-p tmp-name4
))
2303 ;; Check for expanded directory names.
2304 (with-current-buffer
2308 "tramp-test*" tramp-test-temporary-file-directory
)))
2309 (goto-char (point-min))
2314 tmp-name1 tramp-test-temporary-file-directory
))))
2315 (goto-char (point-min))
2320 tmp-name2 tramp-test-temporary-file-directory
)))))
2321 (kill-buffer buffer
)
2323 ;; Check for expanded directory and file names.
2324 (with-current-buffer
2328 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2329 (goto-char (point-min))
2334 tmp-name3 tramp-test-temporary-file-directory
))))
2335 (goto-char (point-min))
2341 tramp-test-temporary-file-directory
)))))
2342 (kill-buffer buffer
)
2344 ;; Check for special characters.
2345 (setq tmp-name3
(expand-file-name "*?" tmp-name1
))
2346 (setq tmp-name4
(expand-file-name "[a-z0-9]" tmp-name2
))
2347 (write-region "foo" nil tmp-name3
)
2348 (should (file-exists-p tmp-name3
))
2349 (write-region "foo" nil tmp-name4
)
2350 (should (file-exists-p tmp-name4
))
2352 (with-current-buffer
2356 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2357 (goto-char (point-min))
2362 tmp-name3 tramp-test-temporary-file-directory
))))
2363 (goto-char (point-min))
2369 tramp-test-temporary-file-directory
)))))
2370 (kill-buffer buffer
))
2373 (ignore-errors (kill-buffer buffer
))
2374 (ignore-errors (delete-directory tmp-name1
'recursive
))
2375 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2377 (ert-deftest tramp-test18-file-attributes
()
2378 "Check `file-attributes'.
2379 This tests also `file-readable-p', `file-regular-p' and
2380 `file-ownership-preserved-p'."
2381 (skip-unless (tramp--test-enabled))
2383 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2384 ;; We must use `file-truename' for the temporary directory,
2385 ;; because it could be located on a symlinked directory. This
2386 ;; would let the test fail.
2387 (let* ((tramp-test-temporary-file-directory
2388 (file-truename tramp-test-temporary-file-directory
))
2389 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2390 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2391 ;; File name with "//".
2395 (file-remote-p tmp-name1
)
2396 (replace-regexp-in-string
2397 "/" "//" (file-remote-p tmp-name1
'localname
))))
2401 ;; `file-ownership-preserved-p' should return t for
2402 ;; non-existing files. It is implemented only in tramp-sh.el.
2403 (when (tramp--test-sh-p)
2404 (should (file-ownership-preserved-p tmp-name1
'group
)))
2405 (write-region "foo" nil tmp-name1
)
2406 (should (file-exists-p tmp-name1
))
2407 (should (file-readable-p tmp-name1
))
2408 (should (file-regular-p tmp-name1
))
2409 (when (tramp--test-sh-p)
2410 (should (file-ownership-preserved-p tmp-name1
'group
)))
2412 ;; We do not test inodes and device numbers.
2413 (setq attr
(file-attributes tmp-name1
))
2414 (should (consp attr
))
2415 (should (null (car attr
)))
2416 (should (numberp (nth 1 attr
))) ;; Link.
2417 (should (numberp (nth 2 attr
))) ;; Uid.
2418 (should (numberp (nth 3 attr
))) ;; Gid.
2419 ;; Last access time.
2420 (should (stringp (current-time-string (nth 4 attr
))))
2421 ;; Last modification time.
2422 (should (stringp (current-time-string (nth 5 attr
))))
2423 ;; Last status change time.
2424 (should (stringp (current-time-string (nth 6 attr
))))
2425 (should (numberp (nth 7 attr
))) ;; Size.
2426 (should (stringp (nth 8 attr
))) ;; Modes.
2428 (setq attr
(file-attributes tmp-name1
'string
))
2429 (should (stringp (nth 2 attr
))) ;; Uid.
2430 (should (stringp (nth 3 attr
))) ;; Gid.
2434 (when (tramp--test-sh-p)
2435 (should (file-ownership-preserved-p tmp-name2
'group
)))
2436 (make-symbolic-link tmp-name1 tmp-name2
)
2437 (should (file-exists-p tmp-name2
))
2438 (should (file-symlink-p tmp-name2
))
2439 (when (tramp--test-sh-p)
2440 (should (file-ownership-preserved-p tmp-name2
'group
)))
2441 (setq attr
(file-attributes tmp-name2
))
2445 (if quoted
'tramp-compat-file-name-quote
'identity
)
2447 (file-remote-p (file-truename tmp-name1
) 'localname
)))
2448 (delete-file tmp-name2
))
2450 (should (string-equal (error-message-string err
)
2451 "make-symbolic-link not supported"))))
2453 ;; Check, that "//" in symlinks are handled properly.
2455 (let ((default-directory tramp-test-temporary-file-directory
))
2459 (tramp-file-name-localname
2460 (tramp-dissect-file-name tmp-name3
))
2461 (tramp-file-name-localname
2462 (tramp-dissect-file-name tmp-name2
)))
2464 (when (file-symlink-p tmp-name2
)
2465 (setq attr
(file-attributes tmp-name2
))
2469 (tramp-file-name-localname
2470 (tramp-dissect-file-name tmp-name3
))))
2471 (delete-file tmp-name2
))
2473 (when (tramp--test-sh-p)
2474 (should (file-ownership-preserved-p tmp-name1
'group
)))
2475 (delete-file tmp-name1
)
2476 (make-directory tmp-name1
)
2477 (should (file-exists-p tmp-name1
))
2478 (should (file-readable-p tmp-name1
))
2479 (should-not (file-regular-p tmp-name1
))
2480 (when (tramp--test-sh-p)
2481 (should (file-ownership-preserved-p tmp-name1
'group
)))
2482 (setq attr
(file-attributes tmp-name1
))
2483 (should (eq (car attr
) t
)))
2486 (ignore-errors (delete-directory tmp-name1
))
2487 (ignore-errors (delete-file tmp-name1
))
2488 (ignore-errors (delete-file tmp-name2
))))))
2490 (ert-deftest tramp-test19-directory-files-and-attributes
()
2491 "Check `directory-files-and-attributes'."
2492 (skip-unless (tramp--test-enabled))
2494 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2495 ;; `directory-files-and-attributes' contains also values for
2496 ;; "../". Ensure that this doesn't change during tests, for
2497 ;; example due to handling temporary files.
2498 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2499 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2503 (make-directory tmp-name1
)
2504 (should (file-directory-p tmp-name1
))
2505 (make-directory tmp-name2
)
2506 (should (file-directory-p tmp-name2
))
2507 (write-region "foo" nil
(expand-file-name "foo" tmp-name2
))
2508 (write-region "bar" nil
(expand-file-name "bar" tmp-name2
))
2509 (write-region "boz" nil
(expand-file-name "boz" tmp-name2
))
2510 (setq attr
(directory-files-and-attributes tmp-name2
))
2511 (should (consp attr
))
2512 ;; Dumb remote shells without perl(1) or stat(1) are not
2513 ;; able to return the date correctly. They say "don't know".
2518 5 (file-attributes (expand-file-name (car elt
) tmp-name2
)))
2521 (equal (file-attributes (expand-file-name (car elt
) tmp-name2
))
2523 (setq attr
(directory-files-and-attributes tmp-name2
'full
))
2525 (unless (equal (nth 5 (file-attributes (car elt
))) '(0 0))
2527 (equal (file-attributes (car elt
)) (cdr elt
)))))
2528 (setq attr
(directory-files-and-attributes tmp-name2 nil
"^b"))
2529 (should (equal (mapcar 'car attr
) '("bar" "boz"))))
2532 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2534 (ert-deftest tramp-test20-file-modes
()
2535 "Check `file-modes'.
2536 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2537 (skip-unless (tramp--test-enabled))
2538 (skip-unless (tramp--test-sh-p))
2540 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2541 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2544 (write-region "foo" nil tmp-name
)
2545 (should (file-exists-p tmp-name
))
2546 (set-file-modes tmp-name
#o777
)
2547 (should (= (file-modes tmp-name
) #o777
))
2548 (should (file-executable-p tmp-name
))
2549 (should (file-writable-p tmp-name
))
2550 (set-file-modes tmp-name
#o444
)
2551 (should (= (file-modes tmp-name
) #o444
))
2552 (should-not (file-executable-p tmp-name
))
2553 ;; A file is always writable for user "root".
2554 (unless (zerop (nth 2 (file-attributes tmp-name
)))
2555 (should-not (file-writable-p tmp-name
))))
2558 (ignore-errors (delete-file tmp-name
))))))
2560 (ert-deftest tramp-test21-file-links
()
2561 "Check `file-symlink-p'.
2562 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2563 (skip-unless (tramp--test-enabled))
2565 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2566 ;; We must use `file-truename' for the temporary directory,
2567 ;; because it could be located on a symlinked directory. This
2568 ;; would let the test fail.
2569 (let* ((tramp-test-temporary-file-directory
2570 (file-truename tramp-test-temporary-file-directory
))
2571 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2572 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2573 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
2575 ;; Check `make-symbolic-link'.
2578 (write-region "foo" nil tmp-name1
)
2579 (should (file-exists-p tmp-name1
))
2580 ;; Method "smb" supports `make-symbolic-link' only if the
2581 ;; remote host has CIFS capabilities. tramp-adb.el and
2582 ;; tramp-gvfs.el do not support symbolic links at all.
2584 (make-symbolic-link tmp-name1 tmp-name2
)
2587 (not (string-equal (error-message-string err
)
2588 "make-symbolic-link not supported")))))
2589 (should (file-symlink-p tmp-name2
))
2590 (should-error (make-symbolic-link tmp-name1 tmp-name2
))
2591 (make-symbolic-link tmp-name1 tmp-name2
'ok-if-already-exists
)
2592 (should (file-symlink-p tmp-name2
))
2593 ;; `tmp-name3' is a local file name.
2594 (should-error (make-symbolic-link tmp-name1 tmp-name3
)))
2598 (delete-file tmp-name1
)
2599 (delete-file tmp-name2
)))
2601 ;; Check `add-name-to-file'.
2604 (write-region "foo" nil tmp-name1
)
2605 (should (file-exists-p tmp-name1
))
2606 (add-name-to-file tmp-name1 tmp-name2
)
2607 (should-not (file-symlink-p tmp-name2
))
2608 (should-error (add-name-to-file tmp-name1 tmp-name2
))
2609 (add-name-to-file tmp-name1 tmp-name2
'ok-if-already-exists
)
2610 (should-not (file-symlink-p tmp-name2
))
2611 ;; `tmp-name3' is a local file name.
2612 (should-error (add-name-to-file tmp-name1 tmp-name3
)))
2616 (delete-file tmp-name1
)
2617 (delete-file tmp-name2
)))
2619 ;; Check `file-truename'.
2622 (write-region "foo" nil tmp-name1
)
2623 (should (file-exists-p tmp-name1
))
2624 (make-symbolic-link tmp-name1 tmp-name2
)
2625 (should (file-symlink-p tmp-name2
))
2626 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
2628 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
)))
2629 (should (file-equal-p tmp-name1 tmp-name2
)))
2631 (delete-file tmp-name1
)
2632 (delete-file tmp-name2
)))
2634 ;; `file-truename' shall preserve trailing link of directories.
2635 (unless (file-symlink-p tramp-test-temporary-file-directory
)
2636 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory
))
2637 (dir2 (file-name-as-directory dir1
)))
2638 (should (string-equal (file-truename dir1
) (expand-file-name dir1
)))
2640 (string-equal (file-truename dir2
) (expand-file-name dir2
))))))))
2642 (ert-deftest tramp-test22-file-times
()
2643 "Check `set-file-times' and `file-newer-than-file-p'."
2644 (skip-unless (tramp--test-enabled))
2645 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2647 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2648 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2649 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2650 (tmp-name3 (tramp--test-make-temp-name nil quoted
)))
2653 (write-region "foo" nil tmp-name1
)
2654 (should (file-exists-p tmp-name1
))
2655 (should (consp (nth 5 (file-attributes tmp-name1
))))
2656 ;; '(0 0) means don't know, and will be replaced by
2657 ;; `current-time'. Therefore, we use '(0 1). We skip the
2658 ;; test, if the remote handler is not able to set the
2660 (skip-unless (set-file-times tmp-name1
'(0 1)))
2661 ;; Dumb remote shells without perl(1) or stat(1) are not
2662 ;; able to return the date correctly. They say "don't know".
2663 (unless (equal (nth 5 (file-attributes tmp-name1
)) '(0 0))
2664 (should (equal (nth 5 (file-attributes tmp-name1
)) '(0 1)))
2665 (write-region "bla" nil tmp-name2
)
2666 (should (file-exists-p tmp-name2
))
2667 (should (file-newer-than-file-p tmp-name2 tmp-name1
))
2668 ;; `tmp-name3' does not exist.
2669 (should (file-newer-than-file-p tmp-name2 tmp-name3
))
2670 (should-not (file-newer-than-file-p tmp-name3 tmp-name1
))))
2674 (delete-file tmp-name1
)
2675 (delete-file tmp-name2
))))))
2677 (ert-deftest tramp-test23-visited-file-modtime
()
2678 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
2679 (skip-unless (tramp--test-enabled))
2681 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2682 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2685 (write-region "foo" nil tmp-name
)
2686 (should (file-exists-p tmp-name
))
2688 (insert-file-contents tmp-name
)
2689 (should (verify-visited-file-modtime))
2690 (set-visited-file-modtime '(0 1))
2691 (should (verify-visited-file-modtime))
2692 (should (equal (visited-file-modtime) '(0 1 0 0)))))
2695 (ignore-errors (delete-file tmp-name
))))))
2697 (ert-deftest tramp-test24-file-name-completion
()
2698 "Check `file-name-completion' and `file-name-all-completions'."
2699 (skip-unless (tramp--test-enabled))
2701 ;; Method and host name in completion mode. This kind of completion
2702 ;; does not work on MS Windows.
2703 (when (not (memq system-type
'(cygwin windows-nt
)))
2704 (let ((method (file-remote-p tramp-test-temporary-file-directory
'method
))
2705 (host (file-remote-p tramp-test-temporary-file-directory
'host
))
2706 (orig-syntax tramp-syntax
))
2707 (when (and (stringp host
) (string-match tramp-host-with-port-regexp host
))
2708 (setq host
(match-string 1 host
)))
2713 (if tramp--test-expensive-test
2714 (tramp-syntax-values) `(,orig-syntax
)))
2715 (tramp-change-syntax syntax
)
2716 (let ;; This is needed for the `simplified' syntax.
2718 (if (zerop (length (tramp-method-regexp)))
2719 "" tramp-default-method-marker
))
2720 ;; This is needed for the `separate' syntax.
2721 (prefix-format (substring (tramp-prefix-format) 1)))
2722 ;; Complete method name.
2723 (unless (or (zerop (length method
))
2724 (zerop (length (tramp-method-regexp))))
2727 (concat prefix-format method
(tramp-postfix-method-format))
2728 (file-name-all-completions
2729 (concat prefix-format
(substring method
0 1)) "/"))))
2730 ;; Complete host name for default method. With gvfs
2731 ;; based methods, host name will be determined as
2732 ;; host.local, so we omit the test.
2733 (let ((tramp-default-method (or method tramp-default-method
)))
2734 (unless (or (zerop (length host
))
2735 (tramp--test-gvfs-p tramp-default-method
))
2739 prefix-format method-marker
(tramp-postfix-method-format)
2740 host
(tramp-postfix-host-format))
2741 (file-name-all-completions
2743 prefix-format method-marker
(tramp-postfix-method-format)
2744 (substring host
0 1))
2746 ;; Complete host name.
2747 (unless (or (zerop (length method
))
2748 (zerop (length (tramp-method-regexp)))
2749 (zerop (length host
))
2750 (tramp--test-gvfs-p method
))
2754 prefix-format method
(tramp-postfix-method-format)
2755 host
(tramp-postfix-host-format))
2756 (file-name-all-completions
2757 (concat prefix-format method
(tramp-postfix-method-format))
2761 (tramp-change-syntax orig-syntax
))))
2763 (dolist (n-e '(nil t
))
2764 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2765 (let ((non-essential n-e
)
2766 (tmp-name (tramp--test-make-temp-name nil quoted
)))
2771 (make-directory tmp-name
)
2772 (should (file-directory-p tmp-name
))
2773 (write-region "foo" nil
(expand-file-name "foo" tmp-name
))
2774 (should (file-exists-p (expand-file-name "foo" tmp-name
)))
2775 (write-region "bar" nil
(expand-file-name "bold" tmp-name
))
2776 (should (file-exists-p (expand-file-name "bold" tmp-name
)))
2777 (make-directory (expand-file-name "boz" tmp-name
))
2778 (should (file-directory-p (expand-file-name "boz" tmp-name
)))
2779 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
2780 (should (equal (file-name-completion "foo" tmp-name
) t
))
2781 (should (equal (file-name-completion "b" tmp-name
) "bo"))
2782 (should-not (file-name-completion "a" tmp-name
))
2785 (file-name-completion "b" tmp-name
'file-directory-p
) "boz/"))
2787 (equal (file-name-all-completions "fo" tmp-name
) '("foo")))
2790 (sort (file-name-all-completions "b" tmp-name
) 'string-lessp
)
2792 (should-not (file-name-all-completions "a" tmp-name
))
2793 ;; `completion-regexp-list' restricts the completion to
2794 ;; files which match all expressions in this list.
2795 (let ((completion-regexp-list
2796 `(,directory-files-no-dot-files-regexp
"b")))
2798 (equal (file-name-completion "" tmp-name
) "bo"))
2801 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
2803 ;; `file-name-completion' ignores file names that end in
2804 ;; any string in `completion-ignored-extensions'.
2805 (let ((completion-ignored-extensions '(".ext")))
2806 (write-region "foo" nil
(expand-file-name "foo.ext" tmp-name
))
2807 (should (file-exists-p (expand-file-name "foo.ext" tmp-name
)))
2808 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
2809 (should (equal (file-name-completion "foo" tmp-name
) t
))
2811 (equal (file-name-completion "foo." tmp-name
) "foo.ext"))
2812 (should (equal (file-name-completion "foo.ext" tmp-name
) t
))
2813 ;; `file-name-all-completions' is not affected.
2816 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
2817 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
2820 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
2822 (ert-deftest tramp-test25-load
()
2824 (skip-unless (tramp--test-enabled))
2826 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2827 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2830 (load tmp-name
'noerror
'nomessage
)
2831 (should-not (featurep 'tramp-test-load
))
2832 (write-region "(provide 'tramp-test-load)" nil tmp-name
)
2833 ;; `load' in lread.c does not pass `must-suffix'. Why?
2835 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
2836 (load tmp-name nil
'nomessage
'nosuffix
)
2837 (should (featurep 'tramp-test-load
)))
2841 (and (featurep 'tramp-test-load
) (unload-feature 'tramp-test-load
))
2842 (delete-file tmp-name
))))))
2844 (ert-deftest tramp-test26-process-file
()
2845 "Check `process-file'."
2846 :tags
'(:expensive-test
)
2847 (skip-unless (tramp--test-enabled))
2848 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2850 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2851 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
2852 (fnnd (file-name-nondirectory tmp-name
))
2853 (default-directory tramp-test-temporary-file-directory
)
2854 kill-buffer-query-functions
)
2857 ;; We cannot use "/bin/true" and "/bin/false"; those paths
2858 ;; do not exist on hydra.
2859 (should (zerop (process-file "true")))
2860 (should-not (zerop (process-file "false")))
2861 (should-not (zerop (process-file "binary-does-not-exist")))
2863 (write-region "foo" nil tmp-name
)
2864 (should (file-exists-p tmp-name
))
2865 (should (zerop (process-file "ls" nil t nil fnnd
)))
2866 ;; `ls' could produce colorized output.
2867 (goto-char (point-min))
2869 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
2870 (replace-match "" nil nil
))
2871 (should (string-equal (format "%s\n" fnnd
) (buffer-string)))
2872 (should-not (get-buffer-window (current-buffer) t
))
2874 ;; Second run. The output must be appended.
2875 (goto-char (point-max))
2876 (should (zerop (process-file "ls" nil t t fnnd
)))
2877 ;; `ls' could produce colorized output.
2878 (goto-char (point-min))
2880 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
2881 (replace-match "" nil nil
))
2883 (string-equal (format "%s\n%s\n" fnnd fnnd
) (buffer-string)))
2884 ;; A non-nil DISPLAY must not raise the buffer.
2885 (should-not (get-buffer-window (current-buffer) t
))))
2888 (ignore-errors (delete-file tmp-name
))))))
2890 (ert-deftest tramp-test27-start-file-process
()
2891 "Check `start-file-process'."
2892 :tags
'(:expensive-test
)
2893 (skip-unless (tramp--test-enabled))
2894 (skip-unless (tramp--test-sh-p))
2896 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2897 (let ((default-directory tramp-test-temporary-file-directory
)
2898 (tmp-name (tramp--test-make-temp-name nil quoted
))
2899 kill-buffer-query-functions proc
)
2902 (setq proc
(start-file-process "test1" (current-buffer) "cat"))
2903 (should (processp proc
))
2904 (should (equal (process-status proc
) 'run
))
2905 (process-send-string proc
"foo")
2906 (process-send-eof proc
)
2908 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2909 (while (< (- (point-max) (point-min)) (length "foo"))
2910 (accept-process-output proc
0.1)))
2911 (should (string-equal (buffer-string) "foo")))
2914 (ignore-errors (delete-process proc
)))
2918 (write-region "foo" nil tmp-name
)
2919 (should (file-exists-p tmp-name
))
2922 "test2" (current-buffer)
2923 "cat" (file-name-nondirectory tmp-name
)))
2924 (should (processp proc
))
2926 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2927 (while (< (- (point-max) (point-min)) (length "foo"))
2928 (accept-process-output proc
0.1)))
2929 (should (string-equal (buffer-string) "foo")))
2933 (delete-process proc
)
2934 (delete-file tmp-name
)))
2938 (setq proc
(start-file-process "test3" (current-buffer) "cat"))
2939 (should (processp proc
))
2940 (should (equal (process-status proc
) 'run
))
2943 (lambda (p s
) (with-current-buffer (process-buffer p
) (insert s
))))
2944 (process-send-string proc
"foo")
2945 (process-send-eof proc
)
2947 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2948 (while (< (- (point-max) (point-min)) (length "foo"))
2949 (accept-process-output proc
0.1)))
2950 (should (string-equal (buffer-string) "foo")))
2953 (ignore-errors (delete-process proc
))))))
2955 (ert-deftest tramp-test28-interrupt-process
()
2956 "Check `interrupt-process'."
2957 :tags
'(:expensive-test
)
2958 (skip-unless (tramp--test-enabled))
2959 (skip-unless (tramp--test-sh-p))
2960 ;; Since Emacs 26.1.
2961 (skip-unless (boundp 'interrupt-process-functions
))
2963 (let ((default-directory tramp-test-temporary-file-directory
)
2964 kill-buffer-query-functions proc
)
2967 (setq proc
(start-file-process "test" (current-buffer) "sleep" "10"))
2968 (should (processp proc
))
2969 (should (process-live-p proc
))
2970 (should (equal (process-status proc
) 'run
))
2971 (should (interrupt-process proc
))
2972 ;; Let the process accept the interrupt.
2973 (accept-process-output proc
1 nil
0)
2974 (should-not (process-live-p proc
))
2975 (should (equal (process-status proc
) 'signal
))
2976 ;; An interrupted process cannot be interrupted, again.
2977 ;; Does not work reliable.
2978 ;; (should-error (interrupt-process proc)))
2982 (ignore-errors (delete-process proc
)))))
2984 (ert-deftest tramp-test29-shell-command
()
2985 "Check `shell-command'."
2986 :tags
'(:expensive-test
)
2987 (skip-unless (tramp--test-enabled))
2988 (skip-unless (tramp--test-sh-p))
2990 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2991 (let ((tmp-name (tramp--test-make-temp-name nil quoted
))
2992 (default-directory tramp-test-temporary-file-directory
)
2993 ;; Suppress nasty messages.
2995 kill-buffer-query-functions
)
2998 (write-region "foo" nil tmp-name
)
2999 (should (file-exists-p tmp-name
))
3001 (format "ls %s" (file-name-nondirectory tmp-name
))
3003 ;; `ls' could produce colorized output.
3004 (goto-char (point-min))
3006 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3007 (replace-match "" nil nil
))
3010 (format "%s\n" (file-name-nondirectory tmp-name
))
3014 (ignore-errors (delete-file tmp-name
)))
3018 (write-region "foo" nil tmp-name
)
3019 (should (file-exists-p tmp-name
))
3020 (async-shell-command
3021 (format "ls %s" (file-name-nondirectory tmp-name
))
3024 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3025 (while (< (- (point-max) (point-min))
3026 (1+ (length (file-name-nondirectory tmp-name
))))
3027 (accept-process-output
3028 (get-buffer-process (current-buffer)) 0.1)))
3029 ;; `ls' could produce colorized output.
3030 (goto-char (point-min))
3032 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3033 (replace-match "" nil nil
))
3034 ;; There might be a nasty "Process *Async Shell* finished" message.
3035 (goto-char (point-min))
3037 (narrow-to-region (point-min) (point))
3040 (format "%s\n" (file-name-nondirectory tmp-name
))
3044 (ignore-errors (delete-file tmp-name
)))
3048 (write-region "foo" nil tmp-name
)
3049 (should (file-exists-p tmp-name
))
3050 (async-shell-command "read line; ls $line" (current-buffer))
3051 (process-send-string
3052 (get-buffer-process (current-buffer))
3053 (format "%s\n" (file-name-nondirectory tmp-name
)))
3055 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3056 (while (< (- (point-max) (point-min))
3057 (1+ (length (file-name-nondirectory tmp-name
))))
3058 (accept-process-output
3059 (get-buffer-process (current-buffer)) 0.1)))
3060 ;; `ls' could produce colorized output.
3061 (goto-char (point-min))
3063 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3064 (replace-match "" nil nil
))
3065 ;; There might be a nasty "Process *Async Shell* finished" message.
3066 (goto-char (point-min))
3068 (narrow-to-region (point-min) (point))
3071 (format "%s\n" (file-name-nondirectory tmp-name
))
3075 (ignore-errors (delete-file tmp-name
))))))
3077 (defun tramp--test-shell-command-to-string-asynchronously (command)
3078 "Like `shell-command-to-string', but for asynchronous processes."
3080 (async-shell-command command
(current-buffer))
3082 (while (get-buffer-process (current-buffer))
3083 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3084 (accept-process-output nil
0.1)
3085 (buffer-substring-no-properties (point-min) (point-max))))
3087 ;; This test is inspired by Bug#23952.
3088 (ert-deftest tramp-test30-environment-variables
()
3089 "Check that remote processes set / unset environment variables properly."
3090 :tags
'(:expensive-test
)
3091 (skip-unless (tramp--test-enabled))
3092 (skip-unless (tramp--test-sh-p))
3094 (dolist (this-shell-command-to-string
3096 shell-command-to-string
3098 tramp--test-shell-command-to-string-asynchronously
))
3100 (let ((default-directory tramp-test-temporary-file-directory
)
3101 (shell-file-name "/bin/sh")
3102 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3103 kill-buffer-query-functions
)
3107 (let ((process-environment
3108 (cons (concat envvar
"=foo") process-environment
)))
3114 this-shell-command-to-string
3115 (format "echo -n ${%s:?bla}" envvar
))))))
3118 ;; Set the empty value.
3119 (let ((process-environment
3120 (cons (concat envvar
"=") process-environment
)))
3126 this-shell-command-to-string
3127 (format "echo -n ${%s:?bla}" envvar
))))
3131 (regexp-quote envvar
)
3132 (funcall this-shell-command-to-string
"set")))))
3134 ;; We force a reconnect, in order to have a clean environment.
3135 (tramp-cleanup-connection
3136 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3137 'keep-debug
'keep-password
)
3139 ;; Unset the variable.
3140 (let ((tramp-remote-process-environment
3141 (cons (concat envvar
"=foo")
3142 tramp-remote-process-environment
)))
3143 ;; Set the initial value, we want to unset below.
3148 this-shell-command-to-string
3149 (format "echo -n ${%s:?bla}" envvar
))))
3150 (let ((process-environment
3151 (cons envvar process-environment
)))
3152 ;; Variable is unset.
3157 this-shell-command-to-string
3158 (format "echo -n ${%s:?bla}" envvar
))))
3159 ;; Variable is unset.
3162 (regexp-quote envvar
)
3163 (funcall this-shell-command-to-string
"set")))))))))
3165 ;; This test is inspired by Bug#27009.
3166 (ert-deftest tramp-test30-environment-variables-and-port-numbers
()
3167 "Check that two connections with separate ports are different."
3168 (skip-unless (tramp--test-enabled))
3169 ;; We test it only for the mock-up connection; otherwise there might
3170 ;; be problems with the used ports.
3173 (eq tramp-syntax
'default
)
3175 "mock" (file-remote-p tramp-test-temporary-file-directory
'method
))))
3177 ;; We force a reconnect, in order to have a clean environment.
3178 (dolist (dir `(,tramp-test-temporary-file-directory
3179 "/mock:localhost#11111:" "/mock:localhost#22222:"))
3180 (tramp-cleanup-connection
3181 (tramp-dissect-file-name dir
) 'keep-debug
'keep-password
))
3184 (dolist (port '(11111 22222))
3185 (let* ((default-directory
3186 (format "/mock:localhost#%d:%s" port temporary-file-directory
))
3187 (shell-file-name "/bin/sh")
3188 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3189 ;; We cannot use `process-environment', because this
3190 ;; would be applied in `process-file'.
3191 (tramp-remote-process-environment
3193 (format "%s=%d" envvar port
)
3194 tramp-remote-process-environment
)))
3197 (number-to-string port
)
3198 (shell-command-to-string (format "echo -n $%s" envvar
))))))
3201 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3202 (tramp-cleanup-connection (tramp-dissect-file-name dir
)))))
3204 ;; The functions were introduced in Emacs 26.1.
3205 (ert-deftest tramp-test31-explicit-shell-file-name
()
3206 "Check that connection-local `explicit-shell-file-name' is set."
3207 :tags
'(:expensive-test
)
3208 (skip-unless (tramp--test-enabled))
3209 (skip-unless (tramp--test-sh-p))
3210 ;; Since Emacs 26.1.
3211 (skip-unless (and (fboundp 'connection-local-set-profile-variables
)
3212 (fboundp 'connection-local-set-profiles
)))
3214 ;; `connection-local-set-profile-variables' and
3215 ;; `connection-local-set-profiles' exists since Emacs 26. We don't
3216 ;; want to see compiler warnings for older Emacsen.
3217 (let ((default-directory tramp-test-temporary-file-directory
)
3218 explicit-shell-file-name kill-buffer-query-functions
)
3221 ;; `shell-mode' would ruin our test, because it deletes all
3222 ;; buffer local variables.
3223 (put 'explicit-shell-file-name
'permanent-local t
)
3224 ;; Declare connection-local variable `explicit-shell-file-name'.
3226 (connection-local-set-profile-variables
3228 '((explicit-shell-file-name .
"/bin/sh")
3229 (explicit-sh-args .
("-i"))))
3230 (connection-local-set-profiles
3231 `(:application tramp
3232 :protocol
,(file-remote-p default-directory
'method
)
3233 :user
,(file-remote-p default-directory
'user
)
3234 :machine
,(file-remote-p default-directory
'host
))
3237 ;; Run interactive shell. Since the default directory is
3238 ;; remote, `explicit-shell-file-name' shall be set in order
3239 ;; to avoid a question.
3240 (with-current-buffer (get-buffer-create "*shell*")
3241 (ignore-errors (kill-process (current-buffer)))
3242 (should-not explicit-shell-file-name
)
3243 (call-interactively 'shell
)
3244 (should explicit-shell-file-name
)))
3246 (put 'explicit-shell-file-name
'permanent-local nil
)
3247 (kill-buffer "*shell*"))))
3249 (ert-deftest tramp-test32-vc-registered
()
3250 "Check `vc-registered'."
3251 :tags
'(:expensive-test
)
3252 (skip-unless (tramp--test-enabled))
3253 (skip-unless (tramp--test-sh-p))
3255 ;; TODO: This test fails.
3256 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3257 (let* ((default-directory tramp-test-temporary-file-directory
)
3258 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
3259 (tmp-name2 (expand-file-name "foo" tmp-name1
))
3260 (tramp-remote-process-environment tramp-remote-process-environment
)
3261 (vc-handled-backends
3262 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3264 ((tramp-find-executable
3265 v vc-git-program
(tramp-get-remote-path v
))
3267 ((tramp-find-executable
3268 v vc-hg-program
(tramp-get-remote-path v
))
3270 ((tramp-find-executable
3271 v vc-bzr-program
(tramp-get-remote-path v
))
3272 (setq tramp-remote-process-environment
3273 (cons (format "BZR_HOME=%s"
3274 (file-remote-p tmp-name1
'localname
))
3275 tramp-remote-process-environment
))
3276 ;; We must force a reconnect, in order to activate $BZR_HOME.
3277 (tramp-cleanup-connection
3278 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3279 'keep-debug
'keep-password
)
3282 ;; Suppress nasty messages.
3283 (inhibit-message t
))
3284 (skip-unless vc-handled-backends
)
3285 (unless quoted
(tramp--test-message "%s" vc-handled-backends
))
3289 (make-directory tmp-name1
)
3290 (write-region "foo" nil tmp-name2
)
3291 (should (file-directory-p tmp-name1
))
3292 (should (file-exists-p tmp-name2
))
3293 (should-not (vc-registered tmp-name1
))
3294 (should-not (vc-registered tmp-name2
))
3296 (let ((default-directory tmp-name1
))
3297 ;; Create empty repository, and register the file.
3298 ;; Sometimes, creation of repository fails (bzr!); we
3299 ;; skip the test then.
3301 (vc-create-repo (car vc-handled-backends
))
3302 (error (skip-unless nil
)))
3303 ;; The structure of VC-FILESET is not documented. Let's
3304 ;; hope it won't change.
3307 (list (car vc-handled-backends
)
3308 (list (file-name-nondirectory tmp-name2
))))
3309 ;; `vc-register' has changed its arguments in Emacs 25.1.
3312 nil
(list (car vc-handled-backends
)
3313 (list (file-name-nondirectory tmp-name2
))))))
3314 ;; vc-git uses an own process sentinel, Tramp's sentinel
3315 ;; for flushing the cache isn't used.
3316 (dired-uncache (concat (file-remote-p default-directory
) "/"))
3317 (should (vc-registered (file-name-nondirectory tmp-name2
)))))
3320 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
3322 (ert-deftest tramp-test33-make-auto-save-file-name
()
3323 "Check `make-auto-save-file-name'."
3324 (skip-unless (tramp--test-enabled))
3326 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3327 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
3328 (tmp-name2 (tramp--test-make-temp-name nil quoted
)))
3332 ;; Use default `auto-save-file-name-transforms' mechanism.
3333 (let (tramp-auto-save-directory)
3335 (setq buffer-file-name tmp-name1
)
3338 (make-auto-save-file-name)
3339 ;; This is taken from original `make-auto-save-file-name'.
3340 ;; We call `convert-standard-filename', because on
3341 ;; MS Windows the (local) colons must be replaced by
3342 ;; exclamation marks.
3343 (convert-standard-filename
3347 (subst-char-in-string
3348 ?
/ ?
! (replace-regexp-in-string "!" "!!" tmp-name1
)))
3349 temporary-file-directory
))))))
3352 (let (tramp-auto-save-directory auto-save-file-name-transforms
)
3354 (setq buffer-file-name tmp-name1
)
3357 (make-auto-save-file-name)
3359 (if quoted
'tramp-compat-file-name-quote
'identity
)
3361 (format "#%s#" (file-name-nondirectory tmp-name1
))
3362 tramp-test-temporary-file-directory
))))))
3364 ;; TODO: The following two cases don't work yet.
3366 ;; Use default `tramp-auto-save-directory' mechanism.
3367 (let ((tramp-auto-save-directory tmp-name2
))
3369 (setq buffer-file-name tmp-name1
)
3372 (make-auto-save-file-name)
3373 ;; This is taken from Tramp.
3377 (tramp-subst-strs-in-string
3384 (tramp-compat-file-name-unquote tmp-name1
)))
3386 (should (file-directory-p tmp-name2
))))
3388 ;; Relative file names shall work, too.
3389 (let ((tramp-auto-save-directory "."))
3391 (setq buffer-file-name tmp-name1
3392 default-directory tmp-name2
)
3395 (make-auto-save-file-name)
3396 ;; This is taken from Tramp.
3400 (tramp-subst-strs-in-string
3407 (tramp-compat-file-name-unquote tmp-name1
)))
3409 (should (file-directory-p tmp-name2
)))))
3413 (ignore-errors (delete-file tmp-name1
))
3414 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
3416 ;; The functions were introduced in Emacs 26.1.
3417 (ert-deftest tramp-test34-make-nearby-temp-file
()
3418 "Check `make-nearby-temp-file' and `temporary-file-directory'."
3419 (skip-unless (tramp--test-enabled))
3420 ;; Since Emacs 26.1.
3422 (and (fboundp 'make-nearby-temp-file
) (fboundp 'temporary-file-directory
)))
3424 ;; `make-nearby-temp-file' and `temporary-file-directory' exists
3425 ;; since Emacs 26. We don't want to see compiler warnings for older
3427 (let ((default-directory tramp-test-temporary-file-directory
)
3429 ;; The remote host shall know a temporary file directory.
3430 (should (stringp (with-no-warnings (temporary-file-directory))))
3433 (file-remote-p default-directory
)
3434 (file-remote-p (with-no-warnings (temporary-file-directory)))))
3436 ;; The temporary file shall be located on the remote host.
3437 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test")))
3438 (should (file-exists-p tmp-file
))
3439 (should (file-regular-p tmp-file
))
3442 (file-remote-p default-directory
)
3443 (file-remote-p tmp-file
)))
3444 (delete-file tmp-file
)
3445 (should-not (file-exists-p tmp-file
))
3447 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test" 'dir
)))
3448 (should (file-exists-p tmp-file
))
3449 (should (file-directory-p tmp-file
))
3450 (delete-directory tmp-file
)
3451 (should-not (file-exists-p tmp-file
))))
3453 (defun tramp--test-adb-p ()
3454 "Check, whether the remote host runs Android.
3455 This requires restrictions of file name syntax."
3456 (tramp-adb-file-name-p tramp-test-temporary-file-directory
))
3458 (defun tramp--test-docker-p ()
3459 "Check, whether the docker method is used.
3460 This does not support some special file names."
3462 "docker" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3464 (defun tramp--test-ftp-p ()
3465 "Check, whether an FTP-like method is used.
3466 This does not support globbing characters in file names (yet)."
3467 ;; Globbing characters are ??, ?* and ?\[.
3469 "ftp$" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3471 (defun tramp--test-gvfs-p (&optional method
)
3472 "Check, whether the remote host runs a GVFS based method.
3473 This requires restrictions of file name syntax."
3474 (or (member method tramp-gvfs-methods
)
3475 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory
)))
3477 (defun tramp--test-hpux-p ()
3478 "Check, whether the remote host runs HP-UX.
3479 Several special characters do not work properly there."
3480 ;; We must refill the cache. `file-truename' does it.
3481 (with-parsed-tramp-file-name
3482 (file-truename tramp-test-temporary-file-directory
) nil
3483 (string-match "^HP-UX" (tramp-get-connection-property v
"uname" ""))))
3485 (defun tramp--test-rsync-p ()
3486 "Check, whether the rsync method is used.
3487 This does not support special file names."
3489 "rsync" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3491 (defun tramp--test-sh-p ()
3492 "Check, whether the remote host runs a based method from tramp-sh.el."
3494 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
3495 'tramp-sh-file-name-handler
))
3497 (defun tramp--test-windows-nt-and-batch ()
3498 "Check, whether the locale host runs MS Windows in batch mode.
3499 This does not support special characters."
3500 (and (eq system-type
'windows-nt
) noninteractive
))
3502 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
3503 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
3504 This does not support utf8 based file transfer."
3505 (and (eq system-type
'windows-nt
)
3507 (regexp-opt '("pscp" "psftp"))
3508 (file-remote-p tramp-test-temporary-file-directory
'method
))))
3510 (defun tramp--test-windows-nt-or-smb-p ()
3511 "Check, whether the locale or remote host runs MS Windows.
3512 This requires restrictions of file name syntax."
3513 (or (eq system-type
'windows-nt
)
3514 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)))
3516 (defun tramp--test-check-files (&rest files
)
3517 "Run a simple but comprehensive test over every file in FILES."
3518 ;; TODO: The quoted case does not work.
3519 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3521 ;; We must use `file-truename' for the temporary directory,
3522 ;; because it could be located on a symlinked directory. This
3523 ;; would let the test fail.
3524 (let* ((tramp-test-temporary-file-directory
3525 (file-truename tramp-test-temporary-file-directory
))
3526 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
3527 (tmp-name2 (tramp--test-make-temp-name 'local quoted
))
3528 (files (delq nil files
))
3529 (process-environment process-environment
))
3532 (make-directory tmp-name1
)
3533 (make-directory tmp-name2
)
3536 (let* ((file1 (expand-file-name elt tmp-name1
))
3537 (file2 (expand-file-name elt tmp-name2
))
3538 (file3 (expand-file-name (concat elt
"foo") tmp-name1
)))
3539 (write-region elt nil file1
)
3540 (should (file-exists-p file1
))
3542 ;; Check file contents.
3544 (insert-file-contents file1
)
3545 (should (string-equal (buffer-string) elt
)))
3547 ;; Copy file both directions.
3548 (copy-file file1 tmp-name2
)
3549 (should (file-exists-p file2
))
3551 (should-not (file-exists-p file1
))
3552 (copy-file file2 tmp-name1
)
3553 (should (file-exists-p file1
))
3555 ;; Method "smb" supports `make-symbolic-link' only if the
3556 ;; remote host has CIFS capabilities. tramp-adb.el and
3557 ;; tramp-gvfs.el do not support symbolic links at all.
3560 (make-symbolic-link file1 file3
)
3561 (should (file-symlink-p file3
))
3564 (expand-file-name file1
) (file-truename file3
)))
3568 (if quoted
'tramp-compat-file-name-quote
'identity
)
3569 (car (file-attributes file3
)))
3570 (file-remote-p (file-truename file1
) 'localname
)))
3571 ;; Check file contents.
3573 (insert-file-contents file3
)
3574 (should (string-equal (buffer-string) elt
)))
3575 (delete-file file3
))
3578 (string-equal (error-message-string err
)
3579 "make-symbolic-link not supported"))))))
3581 ;; Check file names.
3582 (should (equal (directory-files
3583 tmp-name1 nil directory-files-no-dot-files-regexp
)
3584 (sort (copy-sequence files
) 'string-lessp
)))
3585 (should (equal (directory-files
3586 tmp-name2 nil directory-files-no-dot-files-regexp
)
3587 (sort (copy-sequence files
) 'string-lessp
)))
3589 ;; `substitute-in-file-name' could return different
3590 ;; values. For `adb', there could be strange file
3591 ;; permissions preventing overwriting a file. We don't
3592 ;; care in this testcase.
3595 (substitute-in-file-name (expand-file-name elt tmp-name1
)))
3597 (substitute-in-file-name
3598 (expand-file-name elt tmp-name2
))))
3599 (ignore-errors (write-region elt nil file1
))
3600 (should (file-exists-p file1
))
3601 (ignore-errors (write-region elt nil file2 nil
'nomessage
))
3602 (should (file-exists-p file2
))))
3604 (should (equal (directory-files
3605 tmp-name1 nil directory-files-no-dot-files-regexp
)
3607 tmp-name2 nil directory-files-no-dot-files-regexp
)))
3609 ;; Check directory creation. We use a subdirectory "foo"
3610 ;; in order to avoid conflicts with previous file name tests.
3612 (let* ((elt1 (concat elt
"foo"))
3613 (file1 (expand-file-name (concat "foo/" elt
) tmp-name1
))
3614 (file2 (expand-file-name elt file1
))
3615 (file3 (expand-file-name elt1 file1
)))
3616 (make-directory file1
'parents
)
3617 (should (file-directory-p file1
))
3618 (write-region elt nil file2
)
3619 (should (file-exists-p file2
))
3623 file1 nil directory-files-no-dot-files-regexp
)
3627 (caar (directory-files-and-attributes
3628 file1 nil directory-files-no-dot-files-regexp
))
3631 ;; Check symlink in `directory-files-and-attributes'.
3634 (make-symbolic-link file2 file3
)
3635 (should (file-symlink-p file3
))
3638 (caar (directory-files-and-attributes
3639 file1 nil
(regexp-quote elt1
)))
3644 (if quoted
'tramp-compat-file-name-quote
'identity
)
3645 (cadr (car (directory-files-and-attributes
3646 file1 nil
(regexp-quote elt1
)))))
3647 (file-remote-p (file-truename file2
) 'localname
)))
3649 (should-not (file-exists-p file3
)))
3651 (should (string-equal (error-message-string err
)
3652 "make-symbolic-link not supported"))))
3655 (should-not (file-exists-p file2
))
3656 (delete-directory file1
)
3657 (should-not (file-exists-p file1
))))
3659 ;; Check, that environment variables are set correctly.
3660 (when (and tramp--test-expensive-test
(tramp--test-sh-p))
3662 (let ((envvar (concat "VAR_" (upcase (md5 elt
))))
3663 (default-directory tramp-test-temporary-file-directory
)
3664 (process-environment process-environment
))
3666 ;; The value of PS1 could confuse Tramp's detection
3667 ;; of process output. So we unset it temporarily.
3670 (should (zerop (process-file "env" nil t nil
)))
3671 (goto-char (point-min))
3676 (regexp-quote envvar
)
3677 (regexp-quote (getenv envvar
))))))))))
3680 (ignore-errors (delete-directory tmp-name1
'recursive
))
3681 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
3683 (defun tramp--test-special-characters ()
3684 "Perform the test in `tramp-test35-special-characters*'."
3685 ;; Newlines, slashes and backslashes in file names are not
3686 ;; supported. So we don't test. And we don't test the tab
3687 ;; character on Windows or Cygwin, because the backslash is
3688 ;; interpreted as a path separator, preventing "\t" from being
3689 ;; expanded to <TAB>.
3690 (tramp--test-check-files
3691 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3693 (if (or (tramp--test-adb-p)
3694 (tramp--test-docker-p)
3695 (eq system-type
'cygwin
))
3702 (unless (or (tramp--test-ftp-p)
3703 (tramp--test-gvfs-p)
3704 (tramp--test-windows-nt-or-smb-p))
3706 (unless (or (tramp--test-ftp-p)
3707 (tramp--test-gvfs-p)
3708 (tramp--test-windows-nt-or-smb-p))
3710 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3714 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3717 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3720 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3723 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
3726 ;; These tests are inspired by Bug#17238.
3727 (ert-deftest tramp-test35-special-characters
()
3728 "Check special characters in file names."
3729 (skip-unless (tramp--test-enabled))
3730 (skip-unless (not (tramp--test-rsync-p)))
3731 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3733 (tramp--test-special-characters))
3735 (ert-deftest tramp-test35-special-characters-with-stat
()
3736 "Check special characters in file names.
3737 Use the `stat' command."
3738 :tags
'(:expensive-test
)
3739 (skip-unless (tramp--test-enabled))
3740 (skip-unless (tramp--test-sh-p))
3741 (skip-unless (not (tramp--test-rsync-p)))
3742 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3743 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3744 (skip-unless (tramp-get-remote-stat v
)))
3746 (let ((tramp-connection-properties
3748 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3750 tramp-connection-properties
)))
3751 (tramp--test-special-characters)))
3753 (ert-deftest tramp-test35-special-characters-with-perl
()
3754 "Check special characters in file names.
3755 Use the `perl' command."
3756 :tags
'(:expensive-test
)
3757 (skip-unless (tramp--test-enabled))
3758 (skip-unless (tramp--test-sh-p))
3759 (skip-unless (not (tramp--test-rsync-p)))
3760 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3761 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3762 (skip-unless (tramp-get-remote-perl v
)))
3764 (let ((tramp-connection-properties
3766 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3768 ;; See `tramp-sh-handle-file-truename'.
3769 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3771 tramp-connection-properties
)))
3772 (tramp--test-special-characters)))
3774 (ert-deftest tramp-test35-special-characters-with-ls
()
3775 "Check special characters in file names.
3776 Use the `ls' command."
3777 :tags
'(:expensive-test
)
3778 (skip-unless (tramp--test-enabled))
3779 (skip-unless (tramp--test-sh-p))
3780 (skip-unless (not (tramp--test-rsync-p)))
3781 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3782 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3784 (let ((tramp-connection-properties
3786 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3788 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3790 ;; See `tramp-sh-handle-file-truename'.
3791 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3793 tramp-connection-properties
)))
3794 (tramp--test-special-characters)))
3796 (defun tramp--test-utf8 ()
3797 "Perform the test in `tramp-test36-utf8*'."
3798 (let* ((utf8 (if (and (eq system-type
'darwin
)
3799 (memq 'utf-8-hfs
(coding-system-list)))
3801 (coding-system-for-read utf8
)
3802 (coding-system-for-write utf8
)
3803 (file-name-coding-system
3804 (coding-system-change-eol-conversion utf8
'unix
)))
3805 (tramp--test-check-files
3806 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
3807 (unless (tramp--test-hpux-p)
3808 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
3810 "Автостопом по гала́ктике")))
3812 (ert-deftest tramp-test36-utf8
()
3813 "Check UTF8 encoding in file names and file contents."
3814 (skip-unless (tramp--test-enabled))
3815 (skip-unless (not (tramp--test-docker-p)))
3816 (skip-unless (not (tramp--test-rsync-p)))
3817 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3818 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3822 (ert-deftest tramp-test36-utf8-with-stat
()
3823 "Check UTF8 encoding in file names and file contents.
3824 Use the `stat' command."
3825 :tags
'(:expensive-test
)
3826 (skip-unless (tramp--test-enabled))
3827 (skip-unless (tramp--test-sh-p))
3828 (skip-unless (not (tramp--test-docker-p)))
3829 (skip-unless (not (tramp--test-rsync-p)))
3830 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3831 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3832 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3833 (skip-unless (tramp-get-remote-stat v
)))
3835 (let ((tramp-connection-properties
3837 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3839 tramp-connection-properties
)))
3840 (tramp--test-utf8)))
3842 (ert-deftest tramp-test36-utf8-with-perl
()
3843 "Check UTF8 encoding in file names and file contents.
3844 Use the `perl' command."
3845 :tags
'(:expensive-test
)
3846 (skip-unless (tramp--test-enabled))
3847 (skip-unless (tramp--test-sh-p))
3848 (skip-unless (not (tramp--test-docker-p)))
3849 (skip-unless (not (tramp--test-rsync-p)))
3850 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3851 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3852 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3853 (skip-unless (tramp-get-remote-perl v
)))
3855 (let ((tramp-connection-properties
3857 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3859 ;; See `tramp-sh-handle-file-truename'.
3860 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3862 tramp-connection-properties
)))
3863 (tramp--test-utf8)))
3865 (ert-deftest tramp-test36-utf8-with-ls
()
3866 "Check UTF8 encoding in file names and file contents.
3867 Use the `ls' command."
3868 :tags
'(:expensive-test
)
3869 (skip-unless (tramp--test-enabled))
3870 (skip-unless (tramp--test-sh-p))
3871 (skip-unless (not (tramp--test-docker-p)))
3872 (skip-unless (not (tramp--test-rsync-p)))
3873 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3874 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3876 (let ((tramp-connection-properties
3878 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3880 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3882 ;; See `tramp-sh-handle-file-truename'.
3883 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3885 tramp-connection-properties
)))
3886 (tramp--test-utf8)))
3888 (defun tramp--test-timeout-handler ()
3890 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
3892 ;; This test is inspired by Bug#16928.
3893 (ert-deftest tramp-test37-asynchronous-requests
()
3894 "Check parallel asynchronous requests.
3895 Such requests could arrive from timers, process filters and
3896 process sentinels. They shall not disturb each other."
3897 :tags
'(:expensive-test
)
3898 (skip-unless (tramp--test-enabled))
3899 (skip-unless (tramp--test-sh-p))
3901 ;; This test could be blocked on hydra. So we set a timeout of 300
3902 ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
3903 (with-timeout (300 (tramp--test-timeout-handler))
3904 (define-key special-event-map
[sigusr1] 'tramp--test-timeout-handler)
3905 (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
3906 (let* (;; For the watchdog.
3907 (default-directory (expand-file-name temporary-file-directory))
3910 "*watchdog*" nil shell-file-name shell-command-switch
3911 (format "sleep 300; kill -USR1 %d" (emacs-pid))))
3912 (tmp-name (tramp--test-make-temp-name))
3913 (default-directory tmp-name)
3914 ;; Do not cache Tramp properties.
3915 (remote-file-name-inhibit-cache t)
3916 (process-file-side-effects t)
3917 ;; Suppress nasty messages.
3919 ;; Do not run delayed timers.
3920 (timer-max-repeats 0)
3921 ;; Number of asynchronous processes for test.
3923 ;; On hydra, timings are bad.
3926 ((getenv "EMACS_HYDRA_CI") 10)
3928 ;; We must distinguish due to performance reasons.
3931 ((string-equal "mock" (file-remote-p tmp-name 'method))
3933 (t 'file-attributes)))
3934 timer buffers kill-buffer-query-functions)
3938 (make-directory tmp-name)
3940 ;; Setup a timer in order to raise an ordinary command
3941 ;; again and again. `vc-registered' is well suited,
3942 ;; because there are many checks.
3949 (let ((time (float-time))
3950 (default-directory tmp-name)
3952 (buffer-name (nth (random (length buffers)) buffers))))
3953 (tramp--test-message
3954 "Start timer %s %s" file (current-time-string))
3955 (funcall timer-operation file)
3956 ;; Adjust timer if it takes too much time.
3957 (when (> (- (float-time) time) timer-repeat)
3958 (setq timer-repeat (* 1.5 timer-repeat))
3959 (setf (timer--repeat-delay timer) timer-repeat)
3960 (tramp--test-message "Increase timer %s" timer-repeat))
3961 (tramp--test-message
3962 "Stop timer %s %s" file (current-time-string)))))))
3964 ;; Create temporary buffers. The number of buffers
3965 ;; corresponds to the number of processes; it could be
3966 ;; increased in order to make pressure on Tramp.
3967 (dotimes (_i number-proc)
3968 (setq buffers (cons (generate-new-buffer "foo") buffers)))
3970 ;; Open asynchronous processes. Set process filter and sentinel.
3971 (dolist (buf buffers)
3973 (sit-for 0.01 'nodisp)
3975 (start-file-process-shell-command
3976 (buffer-name buf) buf
3978 "(read line && echo $line >$line);"
3979 "(read line && cat $line);"
3980 "(read line && rm $line)")))
3981 (file (expand-file-name (buffer-name buf))))
3982 ;; Remember the file name. Add counter.
3983 (process-put proc 'foo file)
3984 (process-put proc 'bar 0)
3985 ;; Add process filter.
3988 (lambda (proc string)
3989 (with-current-buffer (process-buffer proc)
3991 (unless (zerop (length string))
3992 (should (file-attributes (process-get proc 'foo))))))
3993 ;; Add process sentinel.
3994 (set-process-sentinel
3996 (lambda (proc _state)
3997 (should-not (file-attributes (process-get proc 'foo)))))))
3999 ;; Send a string. Use a random order of the buffers. Mix
4000 ;; with regular operation.
4001 (let ((buffers (copy-sequence buffers)))
4004 (sit-for 0.01 'nodisp)
4005 (let* ((buf (nth (random (length buffers)) buffers))
4006 (proc (get-buffer-process buf))
4007 (file (process-get proc 'foo))
4008 (count (process-get proc 'bar)))
4009 (tramp--test-message
4010 "Start action %d %s %s" count buf (current-time-string))
4011 ;; Regular operation prior process action.
4013 (should-not (file-attributes file))
4014 (should (file-attributes file)))
4015 ;; Send string to process.
4016 (process-send-string proc (format "%s\n" (buffer-name buf)))
4017 (accept-process-output proc 0.1 nil 0)
4018 ;; Give the watchdog a chance.
4019 (read-event nil nil 0.01)
4020 ;; Regular operation post process action.
4022 (should-not (file-attributes file))
4023 (should (file-attributes file)))
4024 (tramp--test-message
4025 "Stop action %d %s %s" count buf (current-time-string))
4026 (process-put proc 'bar (1+ count))
4027 (unless (process-live-p proc)
4028 (setq buffers (delq buf buffers))))))
4030 ;; Checks. All process output shall exists in the
4031 ;; respective buffers. All created files shall be
4033 (tramp--test-message "Check %s" (current-time-string))
4034 (dolist (buf buffers)
4035 (with-current-buffer buf
4036 (should (string-equal (format "%s\n" buf) (buffer-string)))))
4039 tmp-name nil directory-files-no-dot-files-regexp)))
4042 (define-key special-event-map [sigusr1] 'ignore
)
4043 (ignore-errors (quit-process watchdog
))
4044 (dolist (buf buffers
)
4045 (ignore-errors (delete-process (get-buffer-process buf
)))
4046 (ignore-errors (kill-buffer buf
)))
4047 (ignore-errors (cancel-timer timer
))
4048 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
4050 (ert-deftest tramp-test38-recursive-load
()
4051 "Check that Tramp does not fail due to recursive load."
4052 (skip-unless (tramp--test-enabled))
4054 (let ((default-directory (expand-file-name temporary-file-directory
)))
4058 "(expand-file-name %S)" tramp-test-temporary-file-directory
)
4060 "(let ((default-directory %S)) (expand-file-name %S))"
4061 tramp-test-temporary-file-directory
4062 temporary-file-directory
)))
4066 (shell-command-to-string
4068 "%s -batch -Q -L %s --eval %s"
4069 (expand-file-name invocation-name invocation-directory
)
4070 (mapconcat 'shell-quote-argument load-path
" -L ")
4071 (shell-quote-argument code
))))))))
4073 (ert-deftest tramp-test39-remote-load-path
()
4074 "Check that Tramp autoloads its packages with remote `load-path'."
4075 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
4076 ;; It shall still work, when a remote file name is in the
4078 (let ((default-directory (expand-file-name temporary-file-directory
))
4080 "(let ((force-load-messages t) \
4081 (load-path (cons \"/foo:bar:\" load-path))) \
4082 (tramp-cleanup-all-connections))"))
4088 "tramp-cmds" (file-name-directory (locate-library "tramp"))))
4089 (shell-command-to-string
4091 "%s -batch -Q -L %s -l tramp-sh --eval %s"
4092 (expand-file-name invocation-name invocation-directory
)
4093 (mapconcat 'shell-quote-argument load-path
" -L ")
4094 (shell-quote-argument code
)))))))
4096 (ert-deftest tramp-test40-unload
()
4097 "Check that Tramp and its subpackages unload completely.
4098 Since it unloads Tramp, it shall be the last test to run."
4099 :tags
'(:expensive-test
)
4100 (skip-unless noninteractive
)
4102 (when (featurep 'tramp
)
4103 (unload-feature 'tramp
'force
)
4104 ;; No Tramp feature must be left.
4105 (should-not (featurep 'tramp
))
4106 (should-not (all-completions "tramp" (delq 'tramp-tests features
)))
4107 ;; `file-name-handler-alist' must be clean.
4108 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist
)))
4109 ;; There shouldn't be left a bound symbol, except buffer-local
4110 ;; variables, and autoload functions. We do not regard our test
4111 ;; symbols, and the Tramp unload hooks.
4114 (and (or (and (boundp x
) (null (local-variable-if-set-p x
)))
4115 (and (functionp x
) (null (autoloadp (symbol-function x
)))))
4116 (string-match "^tramp" (symbol-name x
))
4117 (not (string-match "^tramp--?test" (symbol-name x
)))
4118 (not (string-match "unload-hook$" (symbol-name x
)))
4119 (ert-fail (format "`%s' still bound" x
)))))
4120 ;; The defstruct `tramp-file-name' and all its internal functions
4122 (should-not (cl--find-class 'tramp-file-name
))
4126 (string-match "tramp-file-name" (symbol-name x
))
4127 (ert-fail (format "Structure function `%s' still exists" x
)))))
4128 ;; There shouldn't be left a hook function containing a Tramp
4129 ;; function. We do not regard the Tramp unload hooks.
4133 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x
))
4134 (not (string-match "unload-hook$" (symbol-name x
)))
4135 (consp (symbol-value x
))
4136 (ignore-errors (all-completions "tramp" (symbol-value x
)))
4137 (ert-fail (format "Hook `%s' still contains Tramp function" x
)))))))
4141 ;; * dired-compress-file
4144 ;; * file-name-case-insensitive-p
4145 ;; * file-selinux-context
4146 ;; * find-backup-file-name
4148 ;; * set-file-selinux-context
4150 ;; * Work on skipped tests. Make a comment, when it is impossible.
4151 ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
4152 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4153 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
4154 ;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'.
4156 (defun tramp-test-all (&optional interactive
)
4157 "Run all tests for \\[tramp]."
4160 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
4162 (provide 'tramp-tests
)
4163 ;;; tramp-tests.el ends here
