Fix (Bug#32218). Do not merge with master
[emacs.git] / test / lisp / net / tramp-tests.el
blob8f810818af1d92f5d3c895b88cbec6f3c4459214
1 ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `https://www.gnu.org/licenses/'.
20 ;;; Commentary:
22 ;; The tests require a recent ert.el from Emacs 24.4.
24 ;; Some of the tests require access to a remote host files. Since
25 ;; this could be problematic, a mock-up connection method "mock" is
26 ;; used. Emulating a remote connection, it simply calls "sh -i".
27 ;; Tramp's file name handlers still run, so this test is sufficient
28 ;; except for connection establishing.
30 ;; If you want to test a real Tramp connection, set
31 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
32 ;; overwrite the default value. If you want to skip tests accessing a
33 ;; remote host, set this environment variable to "/dev/null" or
34 ;; whatever is appropriate on your system.
36 ;; For slow remote connections, `tramp-test41-asynchronous-requests'
37 ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
38 ;; value less than 10 could help.
40 ;; A whole test run can be performed calling the command `tramp-test-all'.
42 ;;; Code:
44 (require 'dired)
45 (require 'ert)
46 (require 'ert-x)
47 (require 'tramp)
48 (require 'vc)
49 (require 'vc-bzr)
50 (require 'vc-git)
51 (require 'vc-hg)
53 (declare-function tramp-find-executable "tramp-sh")
54 (declare-function tramp-get-remote-path "tramp-sh")
55 (declare-function tramp-get-remote-stat "tramp-sh")
56 (declare-function tramp-get-remote-perl "tramp-sh")
57 (defvar auto-save-file-name-transforms)
58 (defvar tramp-copy-size-limit)
59 (defvar tramp-persistency-file-name)
60 (defvar tramp-remote-process-environment)
61 ;; Suppress nasty messages.
62 (fset 'shell-command-sentinel 'ignore)
64 ;; There is no default value on w32 systems, which could work out of the box.
65 (defconst tramp-test-temporary-file-directory
66 (cond
67 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
68 ((eq system-type 'windows-nt) null-device)
69 (t (add-to-list
70 'tramp-methods
71 '("mock"
72 (tramp-login-program "sh")
73 (tramp-login-args (("-i")))
74 (tramp-remote-shell "/bin/sh")
75 (tramp-remote-shell-args ("-c"))
76 (tramp-connection-timeout 10)))
77 (add-to-list
78 'tramp-default-host-alist
79 `("\\`mock\\'" nil ,(system-name)))
80 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
81 ;; batch mode only, therefore.
82 (unless (and (null noninteractive) (file-directory-p "~/"))
83 (setenv "HOME" temporary-file-directory))
84 (format "/mock::%s" temporary-file-directory)))
85 "Temporary directory for Tramp tests.")
87 (setq password-cache-expiry nil
88 tramp-verbose 0
89 tramp-cache-read-persistent-data t ;; For auth-sources.
90 tramp-copy-size-limit nil
91 tramp-message-show-message nil
92 tramp-persistency-file-name nil)
94 ;; This should happen on hydra only.
95 (when (getenv "EMACS_HYDRA_CI")
96 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
98 (defvar tramp--test-expensive-test
99 (null
100 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
101 "Whether expensive tests are run.")
103 (defvar tramp--test-enabled-checked nil
104 "Cached result of `tramp--test-enabled'.
105 If the function did run, the value is a cons cell, the `cdr'
106 being the result.")
108 (defun tramp--test-enabled ()
109 "Whether remote file access is enabled."
110 (unless (consp tramp--test-enabled-checked)
111 (setq
112 tramp--test-enabled-checked
113 (cons
114 t (ignore-errors
115 (and
116 (file-remote-p tramp-test-temporary-file-directory)
117 (file-directory-p tramp-test-temporary-file-directory)
118 (file-writable-p tramp-test-temporary-file-directory))))))
120 (when (cdr tramp--test-enabled-checked)
121 ;; Cleanup connection.
122 (ignore-errors
123 (tramp-cleanup-connection
124 (tramp-dissect-file-name tramp-test-temporary-file-directory)
125 nil 'keep-password)))
127 ;; Return result.
128 (cdr tramp--test-enabled-checked))
130 (defun tramp--test-make-temp-name (&optional local quoted)
131 "Return a temporary file name for test.
132 If LOCAL is non-nil, a local file name is returned.
133 If QUOTED is non-nil, the local part of the file name is quoted.
134 The temporary file is not created."
135 (funcall
136 (if quoted 'tramp-compat-file-name-quote 'identity)
137 (expand-file-name
138 (make-temp-name "tramp-test")
139 (if local temporary-file-directory tramp-test-temporary-file-directory))))
141 ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
142 (defvar tramp--test-instrument-test-case-p nil
143 "Whether `tramp--test-instrument-test-case' run.
144 This shall used dynamically bound only.")
146 (defmacro tramp--test-instrument-test-case (verbose &rest body)
147 "Run BODY with `tramp-verbose' equal VERBOSE.
148 Print the content of the Tramp debug buffer, if BODY does not
149 eval properly in `should' or `should-not'. `should-error' is not
150 handled properly. BODY shall not contain a timeout."
151 (declare (indent 1) (debug (natnump body)))
152 `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
153 (tramp-message-show-message t)
154 (tramp-debug-on-error t)
155 (debug-ignored-errors
156 (cons "^make-symbolic-link not supported$" debug-ignored-errors))
157 inhibit-message)
158 (unwind-protect
159 (let ((tramp--test-instrument-test-case-p t)) ,@body)
160 ;; Unwind forms.
161 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
162 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
163 (with-current-buffer (tramp-get-connection-buffer v)
164 (message "%s" (buffer-string)))
165 (with-current-buffer (tramp-get-debug-buffer v)
166 (message "%s" (buffer-string))))))))
168 (defsubst tramp--test-message (fmt-string &rest arguments)
169 "Emit a message into ERT *Messages*."
170 (tramp--test-instrument-test-case 0
171 (apply
172 'tramp-message
173 (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
174 fmt-string arguments)))
176 (defsubst tramp--test-backtrace ()
177 "Dump a backtrace into ERT *Messages*."
178 (tramp--test-instrument-test-case 10
179 (tramp-backtrace
180 (tramp-dissect-file-name tramp-test-temporary-file-directory))))
182 (ert-deftest tramp-test00-availability ()
183 "Test availability of Tramp functions."
184 :expected-result (if (tramp--test-enabled) :passed :failed)
185 (tramp--test-message
186 "Remote directory: `%s'" tramp-test-temporary-file-directory)
187 (should (ignore-errors
188 (and
189 (file-remote-p tramp-test-temporary-file-directory)
190 (file-directory-p tramp-test-temporary-file-directory)
191 (file-writable-p tramp-test-temporary-file-directory)))))
193 (ert-deftest tramp-test01-file-name-syntax ()
194 "Check remote file name syntax."
195 ;; Simple cases.
196 (should (tramp-tramp-file-p "/method::"))
197 (should (tramp-tramp-file-p "/method:host:"))
198 (should (tramp-tramp-file-p "/method:user@:"))
199 (should (tramp-tramp-file-p "/method:user@host:"))
200 (should (tramp-tramp-file-p "/method:user@email@host:"))
202 ;; Using a port.
203 (should (tramp-tramp-file-p "/method:host#1234:"))
204 (should (tramp-tramp-file-p "/method:user@host#1234:"))
206 ;; Using an IPv4 address.
207 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
208 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
210 ;; Using an IPv6 address.
211 (should (tramp-tramp-file-p "/method:[::1]:"))
212 (should (tramp-tramp-file-p "/method:user@[::1]:"))
214 ;; Local file name part.
215 (should (tramp-tramp-file-p "/method:::"))
216 (should (tramp-tramp-file-p "/method::/:"))
217 (should (tramp-tramp-file-p "/method::/path/to/file"))
218 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
219 (should (tramp-tramp-file-p "/method::file"))
220 (should (tramp-tramp-file-p "/method::/:file"))
222 ;; Multihop.
223 (should (tramp-tramp-file-p "/method1:|method2::"))
224 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
225 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
226 (should (tramp-tramp-file-p
227 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
229 ;; No strings.
230 (should-not (tramp-tramp-file-p nil))
231 (should-not (tramp-tramp-file-p 'symbol))
232 ;; Ange-ftp syntax.
233 (should-not (tramp-tramp-file-p "/host:"))
234 (should-not (tramp-tramp-file-p "/user@host:"))
235 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
236 (should-not (tramp-tramp-file-p "/[]:"))
237 (should-not (tramp-tramp-file-p "/[::1]:"))
238 (should-not (tramp-tramp-file-p "/host:/:"))
239 (should-not (tramp-tramp-file-p "/host1|host2:"))
240 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
241 ;; Quote with "/:" suppresses file name handlers.
242 (should-not (tramp-tramp-file-p "/::"))
243 (should-not (tramp-tramp-file-p "/:@:"))
244 (should-not (tramp-tramp-file-p "/:[]:"))
245 ;; Methods shall be at least two characters on MS Windows, except
246 ;; the default method.
247 (let ((system-type 'windows-nt))
248 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
249 (should-not (tramp-tramp-file-p "/c::/path/to/file"))
250 (should (tramp-tramp-file-p "/-::/path/to/file")))
251 (let ((system-type 'gnu/linux))
252 (should (tramp-tramp-file-p "/-:h:/path/to/file"))
253 (should (tramp-tramp-file-p "/m::/path/to/file"))))
255 (ert-deftest tramp-test01-file-name-syntax-simplified ()
256 "Check simplified file name syntax."
257 :tags '(:expensive-test)
258 (let ((syntax tramp-syntax))
259 (unwind-protect
260 (progn
261 (tramp-change-syntax 'simplified)
262 ;; Simple cases.
263 (should (tramp-tramp-file-p "/host:"))
264 (should (tramp-tramp-file-p "/user@:"))
265 (should (tramp-tramp-file-p "/user@host:"))
266 (should (tramp-tramp-file-p "/user@email@host:"))
268 ;; Using a port.
269 (should (tramp-tramp-file-p "/host#1234:"))
270 (should (tramp-tramp-file-p "/user@host#1234:"))
272 ;; Using an IPv4 address.
273 (should (tramp-tramp-file-p "/1.2.3.4:"))
274 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
276 ;; Using an IPv6 address.
277 (should (tramp-tramp-file-p "/[::1]:"))
278 (should (tramp-tramp-file-p "/user@[::1]:"))
280 ;; Local file name part.
281 (should (tramp-tramp-file-p "/host::"))
282 (should (tramp-tramp-file-p "/host:/:"))
283 (should (tramp-tramp-file-p "/host:/path/to/file"))
284 (should (tramp-tramp-file-p "/host:/:/path/to/file"))
285 (should (tramp-tramp-file-p "/host:file"))
286 (should (tramp-tramp-file-p "/host:/:file"))
288 ;; Multihop.
289 (should (tramp-tramp-file-p "/host1|host2:"))
290 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
291 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
293 ;; No strings.
294 (should-not (tramp-tramp-file-p nil))
295 (should-not (tramp-tramp-file-p 'symbol))
296 ;; Quote with "/:" suppresses file name handlers.
297 (should-not (tramp-tramp-file-p "/::"))
298 (should-not (tramp-tramp-file-p "/:@:"))
299 (should-not (tramp-tramp-file-p "/:[]:")))
301 ;; Exit.
302 (tramp-change-syntax syntax))))
304 (ert-deftest tramp-test01-file-name-syntax-separate ()
305 "Check separate file name syntax."
306 :tags '(:expensive-test)
307 (let ((syntax tramp-syntax))
308 (unwind-protect
309 (progn
310 (tramp-change-syntax 'separate)
311 ;; Simple cases.
312 (should (tramp-tramp-file-p "/[method/]"))
313 (should (tramp-tramp-file-p "/[method/host]"))
314 (should (tramp-tramp-file-p "/[method/user@]"))
315 (should (tramp-tramp-file-p "/[method/user@host]"))
316 (should (tramp-tramp-file-p "/[method/user@email@host]"))
318 ;; Using a port.
319 (should (tramp-tramp-file-p "/[method/host#1234]"))
320 (should (tramp-tramp-file-p "/[method/user@host#1234]"))
322 ;; Using an IPv4 address.
323 (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
324 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
326 ;; Using an IPv6 address.
327 (should (tramp-tramp-file-p "/[method/::1]"))
328 (should (tramp-tramp-file-p "/[method/user@::1]"))
330 ;; Local file name part.
331 (should (tramp-tramp-file-p "/[method/]"))
332 (should (tramp-tramp-file-p "/[method/]/:"))
333 (should (tramp-tramp-file-p "/[method/]/path/to/file"))
334 (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
335 (should (tramp-tramp-file-p "/[method/]file"))
336 (should (tramp-tramp-file-p "/[method/]/:file"))
338 ;; Multihop.
339 (should (tramp-tramp-file-p "/[method1/|method2/]"))
340 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
341 (should
342 (tramp-tramp-file-p
343 "/[method1/user1@host1|method2/user2@host2]"))
344 (should
345 (tramp-tramp-file-p
346 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
348 ;; No strings.
349 (should-not (tramp-tramp-file-p nil))
350 (should-not (tramp-tramp-file-p 'symbol))
351 ;; Ange-ftp syntax.
352 (should-not (tramp-tramp-file-p "/host:"))
353 (should-not (tramp-tramp-file-p "/user@host:"))
354 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
355 (should-not (tramp-tramp-file-p "/host:/:"))
356 (should-not (tramp-tramp-file-p "/host1|host2:"))
357 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
358 ;; Quote with "/:" suppresses file name handlers.
359 (should-not (tramp-tramp-file-p "/:[]")))
361 ;; Exit.
362 (tramp-change-syntax syntax))))
364 (ert-deftest tramp-test02-file-name-dissect ()
365 "Check remote file name components."
366 (let ((tramp-default-method "default-method")
367 (tramp-default-user "default-user")
368 (tramp-default-host "default-host"))
369 ;; Expand `tramp-default-user' and `tramp-default-host'.
370 (should (string-equal
371 (file-remote-p "/method::")
372 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
373 (should (string-equal (file-remote-p "/method::" 'method) "method"))
374 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
375 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
376 (should (string-equal (file-remote-p "/method::" 'localname) ""))
377 (should (string-equal (file-remote-p "/method::" 'hop) nil))
379 ;; Expand `tramp-default-method' and `tramp-default-user'.
380 (should (string-equal
381 (file-remote-p "/-:host:")
382 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
383 (should (string-equal (file-remote-p "/-:host:" 'method) "default-method"))
384 (should (string-equal (file-remote-p "/-:host:" 'user) "default-user"))
385 (should (string-equal (file-remote-p "/-:host:" 'host) "host"))
386 (should (string-equal (file-remote-p "/-:host:" 'localname) ""))
387 (should (string-equal (file-remote-p "/-:host:" 'hop) nil))
389 ;; Expand `tramp-default-method' and `tramp-default-host'.
390 (should (string-equal
391 (file-remote-p "/-:user@:")
392 (format "/%s:%s@%s:" "default-method" "user" "default-host")))
393 (should (string-equal (file-remote-p "/-:user@:" 'method) "default-method"))
394 (should (string-equal (file-remote-p "/-:user@:" 'user) "user"))
395 (should (string-equal (file-remote-p "/-:user@:" 'host) "default-host"))
396 (should (string-equal (file-remote-p "/-:user@:" 'localname) ""))
397 (should (string-equal (file-remote-p "/-:user@:" 'hop) nil))
399 ;; Expand `tramp-default-method'.
400 (should (string-equal
401 (file-remote-p "/-:user@host:")
402 (format "/%s:%s@%s:" "default-method" "user" "host")))
403 (should (string-equal
404 (file-remote-p "/-:user@host:" 'method) "default-method"))
405 (should (string-equal (file-remote-p "/-:user@host:" 'user) "user"))
406 (should (string-equal (file-remote-p "/-:user@host:" 'host) "host"))
407 (should (string-equal (file-remote-p "/-:user@host:" 'localname) ""))
408 (should (string-equal (file-remote-p "/-:user@host:" 'hop) nil))
410 ;; Expand `tramp-default-user'.
411 (should (string-equal
412 (file-remote-p "/method:host:")
413 (format "/%s:%s@%s:" "method" "default-user" "host")))
414 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
415 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
416 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
417 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
418 (should (string-equal (file-remote-p "/method:host:" 'hop) nil))
420 ;; Expand `tramp-default-host'.
421 (should (string-equal
422 (file-remote-p "/method:user@:")
423 (format "/%s:%s@%s:" "method" "user" "default-host")))
424 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
425 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
426 (should (string-equal (file-remote-p "/method:user@:" 'host)
427 "default-host"))
428 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
429 (should (string-equal (file-remote-p "/method:user@:" 'hop) nil))
431 ;; No expansion.
432 (should (string-equal
433 (file-remote-p "/method:user@host:")
434 (format "/%s:%s@%s:" "method" "user" "host")))
435 (should (string-equal
436 (file-remote-p "/method:user@host:" 'method) "method"))
437 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
438 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
439 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
440 (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil))
442 ;; No expansion.
443 (should (string-equal
444 (file-remote-p "/method:user@email@host:")
445 (format "/%s:%s@%s:" "method" "user@email" "host")))
446 (should (string-equal
447 (file-remote-p "/method:user@email@host:" 'method) "method"))
448 (should (string-equal
449 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
450 (should (string-equal
451 (file-remote-p "/method:user@email@host:" 'host) "host"))
452 (should (string-equal
453 (file-remote-p "/method:user@email@host:" 'localname) ""))
454 (should (string-equal
455 (file-remote-p "/method:user@email@host:" 'hop) nil))
457 ;; Expand `tramp-default-method' and `tramp-default-user'.
458 (should (string-equal
459 (file-remote-p "/-:host#1234:")
460 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
461 (should (string-equal
462 (file-remote-p "/-:host#1234:" 'method) "default-method"))
463 (should (string-equal (file-remote-p "/-:host#1234:" 'user) "default-user"))
464 (should (string-equal (file-remote-p "/-:host#1234:" 'host) "host#1234"))
465 (should (string-equal (file-remote-p "/-:host#1234:" 'localname) ""))
466 (should (string-equal (file-remote-p "/-:host#1234:" 'hop) nil))
468 ;; Expand `tramp-default-method'.
469 (should (string-equal
470 (file-remote-p "/-:user@host#1234:")
471 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
472 (should (string-equal
473 (file-remote-p "/-:user@host#1234:" 'method) "default-method"))
474 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
475 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
476 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
477 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
479 ;; Expand `tramp-default-user'.
480 (should (string-equal
481 (file-remote-p "/method:host#1234:")
482 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
483 (should (string-equal
484 (file-remote-p "/method:host#1234:" 'method) "method"))
485 (should (string-equal
486 (file-remote-p "/method:host#1234:" 'user) "default-user"))
487 (should (string-equal
488 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
489 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
490 (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil))
492 ;; No expansion.
493 (should (string-equal
494 (file-remote-p "/method:user@host#1234:")
495 (format "/%s:%s@%s:" "method" "user" "host#1234")))
496 (should (string-equal
497 (file-remote-p "/method:user@host#1234:" 'method) "method"))
498 (should (string-equal
499 (file-remote-p "/method:user@host#1234:" 'user) "user"))
500 (should (string-equal
501 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
502 (should (string-equal
503 (file-remote-p "/method:user@host#1234:" 'localname) ""))
504 (should (string-equal
505 (file-remote-p "/method:user@host#1234:" 'hop) nil))
507 ;; Expand `tramp-default-method' and `tramp-default-user'.
508 (should (string-equal
509 (file-remote-p "/-:1.2.3.4:")
510 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
511 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
512 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
513 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
514 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
515 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop) nil))
517 ;; Expand `tramp-default-method'.
518 (should (string-equal
519 (file-remote-p "/-:user@1.2.3.4:")
520 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
521 (should (string-equal
522 (file-remote-p "/-:user@1.2.3.4:" 'method) "default-method"))
523 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user) "user"))
524 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host) "1.2.3.4"))
525 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname) ""))
526 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop) nil))
528 ;; Expand `tramp-default-user'.
529 (should (string-equal
530 (file-remote-p "/method:1.2.3.4:")
531 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
532 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
533 (should (string-equal
534 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
535 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
536 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
537 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil))
539 ;; No expansion.
540 (should (string-equal
541 (file-remote-p "/method:user@1.2.3.4:")
542 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
543 (should (string-equal
544 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
545 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
546 (should (string-equal
547 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
548 (should (string-equal
549 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
550 (should (string-equal
551 (file-remote-p "/method:user@1.2.3.4:" 'hop) nil))
553 ;; Expand `tramp-default-method', `tramp-default-user' and
554 ;; `tramp-default-host'.
555 (should (string-equal
556 (file-remote-p "/-:[]:")
557 (format
558 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
559 (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
560 (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
561 (should (string-equal (file-remote-p "/-:[]:" 'host) "default-host"))
562 (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
563 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil))
565 ;; Expand `tramp-default-method' and `tramp-default-user'.
566 (let ((tramp-default-host "::1"))
567 (should (string-equal
568 (file-remote-p "/-:[]:")
569 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
570 (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
571 (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
572 (should (string-equal (file-remote-p "/-:[]:" 'host) "::1"))
573 (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
574 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil)))
576 ;; Expand `tramp-default-method' and `tramp-default-user'.
577 (should (string-equal
578 (file-remote-p "/-:[::1]:")
579 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
580 (should (string-equal (file-remote-p "/-:[::1]:" 'method) "default-method"))
581 (should (string-equal (file-remote-p "/-:[::1]:" 'user) "default-user"))
582 (should (string-equal (file-remote-p "/-:[::1]:" 'host) "::1"))
583 (should (string-equal (file-remote-p "/-:[::1]:" 'localname) ""))
584 (should (string-equal (file-remote-p "/-:[::1]:" 'hop) nil))
586 ;; Expand `tramp-default-method'.
587 (should (string-equal
588 (file-remote-p "/-:user@[::1]:")
589 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
590 (should (string-equal
591 (file-remote-p "/-:user@[::1]:" 'method) "default-method"))
592 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user) "user"))
593 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host) "::1"))
594 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname) ""))
595 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop) nil))
597 ;; Expand `tramp-default-user'.
598 (should (string-equal
599 (file-remote-p "/method:[::1]:")
600 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
601 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
602 (should (string-equal
603 (file-remote-p "/method:[::1]:" 'user) "default-user"))
604 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
605 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
606 (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
608 ;; No expansion.
609 (should (string-equal
610 (file-remote-p "/method:user@[::1]:")
611 (format "/%s:%s@%s:" "method" "user" "[::1]")))
612 (should (string-equal
613 (file-remote-p "/method:user@[::1]:" 'method) "method"))
614 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
615 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
616 (should (string-equal
617 (file-remote-p "/method:user@[::1]:" 'localname) ""))
618 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
620 ;; Local file name part.
621 (should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
622 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
623 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
624 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
625 (should (string-equal
626 (file-remote-p "/method::/path/to/file" 'localname)
627 "/path/to/file"))
629 ;; Multihop.
630 (should
631 (string-equal
632 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
633 (format "/%s:%s@%s|%s:%s@%s:"
634 "method1" "user1" "host1" "method2" "user2" "host2")))
635 (should
636 (string-equal
637 (file-remote-p
638 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
639 "method2"))
640 (should
641 (string-equal
642 (file-remote-p
643 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
644 "user2"))
645 (should
646 (string-equal
647 (file-remote-p
648 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
649 "host2"))
650 (should
651 (string-equal
652 (file-remote-p
653 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
654 "/path/to/file"))
655 (should
656 (string-equal
657 (file-remote-p
658 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
659 (format "%s:%s@%s|"
660 "method1" "user1" "host1")))
662 (should
663 (string-equal
664 (file-remote-p
665 (concat
666 "/method1:user1@host1"
667 "|method2:user2@host2"
668 "|method3:user3@host3:/path/to/file"))
669 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
670 "method1" "user1" "host1"
671 "method2" "user2" "host2"
672 "method3" "user3" "host3")))
673 (should
674 (string-equal
675 (file-remote-p
676 (concat
677 "/method1:user1@host1"
678 "|method2:user2@host2"
679 "|method3:user3@host3:/path/to/file")
680 'method)
681 "method3"))
682 (should
683 (string-equal
684 (file-remote-p
685 (concat
686 "/method1:user1@host1"
687 "|method2:user2@host2"
688 "|method3:user3@host3:/path/to/file")
689 'user)
690 "user3"))
691 (should
692 (string-equal
693 (file-remote-p
694 (concat
695 "/method1:user1@host1"
696 "|method2:user2@host2"
697 "|method3:user3@host3:/path/to/file")
698 'host)
699 "host3"))
700 (should
701 (string-equal
702 (file-remote-p
703 (concat
704 "/method1:user1@host1"
705 "|method2:user2@host2"
706 "|method3:user3@host3:/path/to/file")
707 'localname)
708 "/path/to/file"))
709 (should
710 (string-equal
711 (file-remote-p
712 (concat
713 "/method1:user1@host1"
714 "|method2:user2@host2"
715 "|method3:user3@host3:/path/to/file")
716 'hop)
717 (format "%s:%s@%s|%s:%s@%s|"
718 "method1" "user1" "host1" "method2" "user2" "host2")))))
720 (ert-deftest tramp-test02-file-name-dissect-simplified ()
721 "Check simplified file name components."
722 :tags '(:expensive-test)
723 (let ((tramp-default-method "default-method")
724 (tramp-default-user "default-user")
725 (tramp-default-host "default-host")
726 (syntax tramp-syntax))
727 (unwind-protect
728 (progn
729 (tramp-change-syntax 'simplified)
730 ;; Expand `tramp-default-method' and `tramp-default-user'.
731 (should (string-equal
732 (file-remote-p "/host:")
733 (format "/%s@%s:" "default-user" "host")))
734 (should (string-equal
735 (file-remote-p "/host:" 'method) "default-method"))
736 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
737 (should (string-equal (file-remote-p "/host:" 'host) "host"))
738 (should (string-equal (file-remote-p "/host:" 'localname) ""))
739 (should (string-equal (file-remote-p "/host:" 'hop) nil))
741 ;; Expand `tramp-default-method' and `tramp-default-host'.
742 (should (string-equal
743 (file-remote-p "/user@:")
744 (format "/%s@%s:" "user" "default-host")))
745 (should (string-equal
746 (file-remote-p "/user@:" 'method) "default-method"))
747 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
748 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
749 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
750 (should (string-equal (file-remote-p "/user@:" 'hop) nil))
752 ;; Expand `tramp-default-method'.
753 (should (string-equal
754 (file-remote-p "/user@host:")
755 (format "/%s@%s:" "user" "host")))
756 (should (string-equal
757 (file-remote-p "/user@host:" 'method) "default-method"))
758 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
759 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
760 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
761 (should (string-equal (file-remote-p "/user@host:" 'hop) nil))
763 ;; No expansion.
764 (should (string-equal
765 (file-remote-p "/user@email@host:")
766 (format "/%s@%s:" "user@email" "host")))
767 (should (string-equal
768 (file-remote-p
769 "/user@email@host:" 'method) "default-method"))
770 (should (string-equal
771 (file-remote-p "/user@email@host:" 'user) "user@email"))
772 (should (string-equal
773 (file-remote-p "/user@email@host:" 'host) "host"))
774 (should (string-equal
775 (file-remote-p "/user@email@host:" 'localname) ""))
776 (should (string-equal
777 (file-remote-p "/user@email@host:" 'hop) nil))
779 ;; Expand `tramp-default-method' and `tramp-default-user'.
780 (should (string-equal
781 (file-remote-p "/host#1234:")
782 (format "/%s@%s:" "default-user" "host#1234")))
783 (should (string-equal
784 (file-remote-p "/host#1234:" 'method) "default-method"))
785 (should (string-equal
786 (file-remote-p "/host#1234:" 'user) "default-user"))
787 (should (string-equal
788 (file-remote-p "/host#1234:" 'host) "host#1234"))
789 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
790 (should (string-equal (file-remote-p "/host#1234:" 'hop) nil))
792 ;; Expand `tramp-default-method'.
793 (should (string-equal
794 (file-remote-p "/user@host#1234:")
795 (format "/%s@%s:" "user" "host#1234")))
796 (should (string-equal
797 (file-remote-p "/user@host#1234:" 'method) "default-method"))
798 (should (string-equal
799 (file-remote-p "/user@host#1234:" 'user) "user"))
800 (should (string-equal
801 (file-remote-p "/user@host#1234:" 'host) "host#1234"))
802 (should (string-equal
803 (file-remote-p "/user@host#1234:" 'localname) ""))
804 (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil))
806 ;; Expand `tramp-default-method' and `tramp-default-user'.
807 (should (string-equal
808 (file-remote-p "/1.2.3.4:")
809 (format "/%s@%s:" "default-user" "1.2.3.4")))
810 (should (string-equal
811 (file-remote-p "/1.2.3.4:" 'method) "default-method"))
812 (should (string-equal
813 (file-remote-p "/1.2.3.4:" 'user) "default-user"))
814 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
815 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
816 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil))
818 ;; Expand `tramp-default-method'.
819 (should (string-equal
820 (file-remote-p "/user@1.2.3.4:")
821 (format "/%s@%s:" "user" "1.2.3.4")))
822 (should (string-equal
823 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
824 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
825 (should (string-equal
826 (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
827 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
828 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil))
830 ;; Expand `tramp-default-method', `tramp-default-user' and
831 ;; `tramp-default-host'.
832 (should (string-equal
833 (file-remote-p "/[]:")
834 (format
835 "/%s@%s:" "default-user" "default-host")))
836 (should (string-equal
837 (file-remote-p "/[]:" 'method) "default-method"))
838 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
839 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
840 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
841 (should (string-equal (file-remote-p "/[]:" 'hop) nil))
843 ;; Expand `tramp-default-method' and `tramp-default-user'.
844 (let ((tramp-default-host "::1"))
845 (should (string-equal
846 (file-remote-p "/[]:")
847 (format "/%s@%s:" "default-user" "[::1]")))
848 (should (string-equal
849 (file-remote-p "/[]:" 'method) "default-method"))
850 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
851 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
852 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
853 (should (string-equal (file-remote-p "/[]:" 'hop) nil)))
855 ;; Expand `tramp-default-method' and `tramp-default-user'.
856 (should (string-equal
857 (file-remote-p "/[::1]:")
858 (format "/%s@%s:" "default-user" "[::1]")))
859 (should (string-equal
860 (file-remote-p "/[::1]:" 'method) "default-method"))
861 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
862 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
863 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
864 (should (string-equal (file-remote-p "/[::1]:" 'hop) nil))
866 ;; Expand `tramp-default-method'.
867 (should (string-equal
868 (file-remote-p "/user@[::1]:")
869 (format "/%s@%s:" "user" "[::1]")))
870 (should (string-equal
871 (file-remote-p "/user@[::1]:" 'method) "default-method"))
872 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
873 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
874 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
875 (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
877 ;; Local file name part.
878 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
879 (should (string-equal (file-remote-p "/host::" 'localname) ":"))
880 (should (string-equal (file-remote-p "/host: " 'localname) " "))
881 (should (string-equal (file-remote-p "/host:file" 'localname) "file"))
882 (should (string-equal
883 (file-remote-p "/host:/path/to/file" 'localname)
884 "/path/to/file"))
886 ;; Multihop.
887 (should
888 (string-equal
889 (file-remote-p "/user1@host1|user2@host2:/path/to/file")
890 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
891 (should
892 (string-equal
893 (file-remote-p
894 "/user1@host1|user2@host2:/path/to/file" 'method)
895 "default-method"))
896 (should
897 (string-equal
898 (file-remote-p
899 "/user1@host1|user2@host2:/path/to/file" 'user)
900 "user2"))
901 (should
902 (string-equal
903 (file-remote-p
904 "/user1@host1|user2@host2:/path/to/file" 'host)
905 "host2"))
906 (should
907 (string-equal
908 (file-remote-p
909 "/user1@host1|user2@host2:/path/to/file" 'localname)
910 "/path/to/file"))
911 (should
912 (string-equal
913 (file-remote-p
914 "/user1@host1|user2@host2:/path/to/file" 'hop)
915 (format "%s@%s|" "user1" "host1")))
917 (should
918 (string-equal
919 (file-remote-p
920 (concat
921 "/user1@host1"
922 "|user2@host2"
923 "|user3@host3:/path/to/file"))
924 (format "/%s@%s|%s@%s|%s@%s:"
925 "user1" "host1"
926 "user2" "host2"
927 "user3" "host3")))
928 (should
929 (string-equal
930 (file-remote-p
931 (concat
932 "/user1@host1"
933 "|user2@host2"
934 "|user3@host3:/path/to/file")
935 'method)
936 "default-method"))
937 (should
938 (string-equal
939 (file-remote-p
940 (concat
941 "/user1@host1"
942 "|user2@host2"
943 "|user3@host3:/path/to/file")
944 'user)
945 "user3"))
946 (should
947 (string-equal
948 (file-remote-p
949 (concat
950 "/user1@host1"
951 "|user2@host2"
952 "|user3@host3:/path/to/file")
953 'host)
954 "host3"))
955 (should
956 (string-equal
957 (file-remote-p
958 (concat
959 "/user1@host1"
960 "|user2@host2"
961 "|user3@host3:/path/to/file")
962 'localname)
963 "/path/to/file"))
964 (should
965 (string-equal
966 (file-remote-p
967 (concat
968 "/user1@host1"
969 "|user2@host2"
970 "|user3@host3:/path/to/file")
971 'hop)
972 (format "%s@%s|%s@%s|"
973 "user1" "host1" "user2" "host2"))))
975 ;; Exit.
976 (tramp-change-syntax syntax))))
978 (ert-deftest tramp-test02-file-name-dissect-separate ()
979 "Check separate file name components."
980 :tags '(:expensive-test)
981 (let ((tramp-default-method "default-method")
982 (tramp-default-user "default-user")
983 (tramp-default-host "default-host")
984 (syntax tramp-syntax))
985 (unwind-protect
986 (progn
987 (tramp-change-syntax 'separate)
988 ;; Expand `tramp-default-user' and `tramp-default-host'.
989 (should (string-equal
990 (file-remote-p "/[method/]")
991 (format
992 "/[%s/%s@%s]" "method" "default-user" "default-host")))
993 (should (string-equal (file-remote-p "/[method/]" 'method) "method"))
994 (should (string-equal
995 (file-remote-p "/[method/]" 'user) "default-user"))
996 (should (string-equal
997 (file-remote-p "/[method/]" 'host) "default-host"))
998 (should (string-equal (file-remote-p "/[method/]" 'localname) ""))
999 (should (string-equal (file-remote-p "/[method/]" 'hop) nil))
1001 ;; Expand `tramp-default-method' and `tramp-default-user'.
1002 (should (string-equal
1003 (file-remote-p "/[/host]")
1004 (format
1005 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1006 (should (string-equal
1007 (file-remote-p "/[/host]" 'method) "default-method"))
1008 (should (string-equal
1009 (file-remote-p "/[/host]" 'user) "default-user"))
1010 (should (string-equal (file-remote-p "/[/host]" 'host) "host"))
1011 (should (string-equal (file-remote-p "/[/host]" 'localname) ""))
1012 (should (string-equal (file-remote-p "/[/host]" 'hop) nil))
1014 ;; Expand `tramp-default-method' and `tramp-default-host'.
1015 (should (string-equal
1016 (file-remote-p "/[/user@]")
1017 (format
1018 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1019 (should (string-equal
1020 (file-remote-p "/[/user@]" 'method) "default-method"))
1021 (should (string-equal (file-remote-p "/[/user@]" 'user) "user"))
1022 (should (string-equal
1023 (file-remote-p "/[/user@]" 'host) "default-host"))
1024 (should (string-equal (file-remote-p "/[/user@]" 'localname) ""))
1025 (should (string-equal (file-remote-p "/[/user@]" 'hop) nil))
1027 ;; Expand `tramp-default-method'.
1028 (should (string-equal
1029 (file-remote-p "/[/user@host]")
1030 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1031 (should (string-equal
1032 (file-remote-p "/[/user@host]" 'method) "default-method"))
1033 (should (string-equal (file-remote-p "/[/user@host]" 'user) "user"))
1034 (should (string-equal (file-remote-p "/[/user@host]" 'host) "host"))
1035 (should (string-equal (file-remote-p "/[/user@host]" 'localname) ""))
1036 (should (string-equal (file-remote-p "/[/user@host]" 'hop) nil))
1038 ;; Expand `tramp-default-method' and `tramp-default-user'.
1039 (should (string-equal
1040 (file-remote-p "/[-/host]")
1041 (format
1042 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1043 (should (string-equal
1044 (file-remote-p "/[-/host]" 'method) "default-method"))
1045 (should (string-equal
1046 (file-remote-p "/[-/host]" 'user) "default-user"))
1047 (should (string-equal (file-remote-p "/[-/host]" 'host) "host"))
1048 (should (string-equal (file-remote-p "/[-/host]" 'localname) ""))
1049 (should (string-equal (file-remote-p "/[-/host]" 'hop) nil))
1051 ;; Expand `tramp-default-method' and `tramp-default-host'.
1052 (should (string-equal
1053 (file-remote-p "/[-/user@]")
1054 (format
1055 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1056 (should (string-equal
1057 (file-remote-p "/[-/user@]" 'method) "default-method"))
1058 (should (string-equal (file-remote-p "/[-/user@]" 'user) "user"))
1059 (should (string-equal
1060 (file-remote-p "/[-/user@]" 'host) "default-host"))
1061 (should (string-equal (file-remote-p "/[-/user@]" 'localname) ""))
1062 (should (string-equal (file-remote-p "/[-/user@]" 'hop) nil))
1064 ;; Expand `tramp-default-method'.
1065 (should (string-equal
1066 (file-remote-p "/[-/user@host]")
1067 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1068 (should (string-equal
1069 (file-remote-p "/[-/user@host]" 'method) "default-method"))
1070 (should (string-equal (file-remote-p "/[-/user@host]" 'user) "user"))
1071 (should (string-equal (file-remote-p "/[-/user@host]" 'host) "host"))
1072 (should (string-equal (file-remote-p "/[-/user@host]" 'localname) ""))
1073 (should (string-equal (file-remote-p "/[-/user@host]" 'hop) nil))
1075 ;; Expand `tramp-default-user'.
1076 (should (string-equal
1077 (file-remote-p "/[method/host]")
1078 (format "/[%s/%s@%s]" "method" "default-user" "host")))
1079 (should (string-equal
1080 (file-remote-p "/[method/host]" 'method) "method"))
1081 (should (string-equal
1082 (file-remote-p "/[method/host]" 'user) "default-user"))
1083 (should (string-equal (file-remote-p "/[method/host]" 'host) "host"))
1084 (should (string-equal (file-remote-p "/[method/host]" 'localname) ""))
1085 (should (string-equal (file-remote-p "/[method/host]" 'hop) nil))
1087 ;; Expand `tramp-default-host'.
1088 (should (string-equal
1089 (file-remote-p "/[method/user@]")
1090 (format "/[%s/%s@%s]" "method" "user" "default-host")))
1091 (should (string-equal
1092 (file-remote-p "/[method/user@]" 'method) "method"))
1093 (should (string-equal (file-remote-p "/[method/user@]" 'user) "user"))
1094 (should (string-equal
1095 (file-remote-p "/[method/user@]" 'host) "default-host"))
1096 (should (string-equal
1097 (file-remote-p "/[method/user@]" 'localname) ""))
1098 (should (string-equal (file-remote-p "/[method/user@]" 'hop) nil))
1100 ;; No expansion.
1101 (should (string-equal
1102 (file-remote-p "/[method/user@host]")
1103 (format "/[%s/%s@%s]" "method" "user" "host")))
1104 (should (string-equal
1105 (file-remote-p "/[method/user@host]" 'method) "method"))
1106 (should (string-equal
1107 (file-remote-p "/[method/user@host]" 'user) "user"))
1108 (should (string-equal
1109 (file-remote-p "/[method/user@host]" 'host) "host"))
1110 (should (string-equal
1111 (file-remote-p "/[method/user@host]" 'localname) ""))
1112 (should (string-equal
1113 (file-remote-p "/[method/user@host]" 'hop) nil))
1115 ;; No expansion.
1116 (should (string-equal
1117 (file-remote-p "/[method/user@email@host]")
1118 (format "/[%s/%s@%s]" "method" "user@email" "host")))
1119 (should (string-equal
1120 (file-remote-p
1121 "/[method/user@email@host]" 'method) "method"))
1122 (should (string-equal
1123 (file-remote-p
1124 "/[method/user@email@host]" 'user) "user@email"))
1125 (should (string-equal
1126 (file-remote-p "/[method/user@email@host]" 'host) "host"))
1127 (should (string-equal
1128 (file-remote-p "/[method/user@email@host]" 'localname) ""))
1129 (should (string-equal
1130 (file-remote-p "/[method/user@email@host]" 'hop) nil))
1132 ;; Expand `tramp-default-method' and `tramp-default-user'.
1133 (should (string-equal
1134 (file-remote-p "/[/host#1234]")
1135 (format
1136 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1137 (should (string-equal
1138 (file-remote-p "/[/host#1234]" 'method) "default-method"))
1139 (should (string-equal
1140 (file-remote-p "/[/host#1234]" 'user) "default-user"))
1141 (should (string-equal
1142 (file-remote-p "/[/host#1234]" 'host) "host#1234"))
1143 (should (string-equal (file-remote-p "/[/host#1234]" 'localname) ""))
1144 (should (string-equal (file-remote-p "/[/host#1234]" 'hop) nil))
1146 ;; Expand `tramp-default-method'.
1147 (should (string-equal
1148 (file-remote-p "/[/user@host#1234]")
1149 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1150 (should (string-equal
1151 (file-remote-p
1152 "/[/user@host#1234]" 'method) "default-method"))
1153 (should (string-equal
1154 (file-remote-p
1155 "/[/user@host#1234]" 'user) "user"))
1156 (should (string-equal
1157 (file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
1158 (should (string-equal
1159 (file-remote-p "/[/user@host#1234]" 'localname) ""))
1160 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop) nil))
1162 ;; Expand `tramp-default-method' and `tramp-default-user'.
1163 (should (string-equal
1164 (file-remote-p "/[-/host#1234]")
1165 (format
1166 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1167 (should (string-equal
1168 (file-remote-p "/[-/host#1234]" 'method) "default-method"))
1169 (should (string-equal
1170 (file-remote-p "/[-/host#1234]" 'user) "default-user"))
1171 (should (string-equal
1172 (file-remote-p "/[-/host#1234]" 'host) "host#1234"))
1173 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname) ""))
1174 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop) nil))
1176 ;; Expand `tramp-default-method'.
1177 (should (string-equal
1178 (file-remote-p "/[-/user@host#1234]")
1179 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1180 (should (string-equal
1181 (file-remote-p
1182 "/[-/user@host#1234]" 'method) "default-method"))
1183 (should (string-equal
1184 (file-remote-p
1185 "/[-/user@host#1234]" 'user) "user"))
1186 (should (string-equal
1187 (file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
1188 (should (string-equal
1189 (file-remote-p "/[-/user@host#1234]" 'localname) ""))
1190 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop) nil))
1192 ;; Expand `tramp-default-user'.
1193 (should (string-equal
1194 (file-remote-p "/[method/host#1234]")
1195 (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1196 (should (string-equal
1197 (file-remote-p "/[method/host#1234]" 'method) "method"))
1198 (should (string-equal
1199 (file-remote-p "/[method/host#1234]" 'user) "default-user"))
1200 (should (string-equal
1201 (file-remote-p "/[method/host#1234]" 'host) "host#1234"))
1202 (should (string-equal
1203 (file-remote-p "/[method/host#1234]" 'localname) ""))
1204 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop) nil))
1206 ;; No expansion.
1207 (should (string-equal
1208 (file-remote-p "/[method/user@host#1234]")
1209 (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1210 (should (string-equal
1211 (file-remote-p "/[method/user@host#1234]" 'method) "method"))
1212 (should (string-equal
1213 (file-remote-p "/[method/user@host#1234]" 'user) "user"))
1214 (should (string-equal
1215 (file-remote-p
1216 "/[method/user@host#1234]" 'host) "host#1234"))
1217 (should (string-equal
1218 (file-remote-p "/[method/user@host#1234]" 'localname) ""))
1219 (should (string-equal
1220 (file-remote-p "/[method/user@host#1234]" 'hop) nil))
1222 ;; Expand `tramp-default-method' and `tramp-default-user'.
1223 (should (string-equal
1224 (file-remote-p "/[/1.2.3.4]")
1225 (format
1226 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1227 (should (string-equal
1228 (file-remote-p "/[/1.2.3.4]" 'method) "default-method"))
1229 (should (string-equal
1230 (file-remote-p "/[/1.2.3.4]" 'user) "default-user"))
1231 (should (string-equal
1232 (file-remote-p "/[/1.2.3.4]" 'host) "1.2.3.4"))
1233 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname) ""))
1234 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop) nil))
1236 ;; Expand `tramp-default-method'.
1237 (should (string-equal
1238 (file-remote-p "/[/user@1.2.3.4]")
1239 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1240 (should (string-equal
1241 (file-remote-p
1242 "/[/user@1.2.3.4]" 'method) "default-method"))
1243 (should (string-equal
1244 (file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
1245 (should (string-equal
1246 (file-remote-p "/[/user@1.2.3.4]" 'host) "1.2.3.4"))
1247 (should (string-equal
1248 (file-remote-p "/[/user@1.2.3.4]" 'localname) ""))
1249 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop) nil))
1251 ;; Expand `tramp-default-method' and `tramp-default-user'.
1252 (should (string-equal
1253 (file-remote-p "/[-/1.2.3.4]")
1254 (format
1255 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1256 (should (string-equal
1257 (file-remote-p "/[-/1.2.3.4]" 'method) "default-method"))
1258 (should (string-equal
1259 (file-remote-p "/[-/1.2.3.4]" 'user) "default-user"))
1260 (should (string-equal
1261 (file-remote-p "/[-/1.2.3.4]" 'host) "1.2.3.4"))
1262 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname) ""))
1263 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop) nil))
1265 ;; Expand `tramp-default-method'.
1266 (should (string-equal
1267 (file-remote-p "/[-/user@1.2.3.4]")
1268 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1269 (should (string-equal
1270 (file-remote-p
1271 "/[-/user@1.2.3.4]" 'method) "default-method"))
1272 (should (string-equal
1273 (file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
1274 (should (string-equal
1275 (file-remote-p "/[-/user@1.2.3.4]" 'host) "1.2.3.4"))
1276 (should (string-equal
1277 (file-remote-p "/[-/user@1.2.3.4]" 'localname) ""))
1278 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop) nil))
1280 ;; Expand `tramp-default-user'.
1281 (should (string-equal
1282 (file-remote-p "/[method/1.2.3.4]")
1283 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1284 (should (string-equal
1285 (file-remote-p "/[method/1.2.3.4]" 'method) "method"))
1286 (should (string-equal
1287 (file-remote-p "/[method/1.2.3.4]" 'user) "default-user"))
1288 (should (string-equal
1289 (file-remote-p "/[method/1.2.3.4]" 'host) "1.2.3.4"))
1290 (should (string-equal
1291 (file-remote-p "/[method/1.2.3.4]" 'localname) ""))
1292 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop) nil))
1294 ;; No expansion.
1295 (should (string-equal
1296 (file-remote-p "/[method/user@1.2.3.4]")
1297 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1298 (should (string-equal
1299 (file-remote-p "/[method/user@1.2.3.4]" 'method) "method"))
1300 (should (string-equal
1301 (file-remote-p "/[method/user@1.2.3.4]" 'user) "user"))
1302 (should (string-equal
1303 (file-remote-p "/[method/user@1.2.3.4]" 'host) "1.2.3.4"))
1304 (should (string-equal
1305 (file-remote-p "/[method/user@1.2.3.4]" 'localname) ""))
1306 (should (string-equal
1307 (file-remote-p "/[method/user@1.2.3.4]" 'hop) nil))
1309 ;; Expand `tramp-default-method', `tramp-default-user' and
1310 ;; `tramp-default-host'.
1311 (should (string-equal
1312 (file-remote-p "/[/]")
1313 (format
1314 "/[%s/%s@%s]"
1315 "default-method" "default-user" "default-host")))
1316 (should (string-equal
1317 (file-remote-p "/[/]" 'method) "default-method"))
1318 (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1319 (should (string-equal (file-remote-p "/[/]" 'host) "default-host"))
1320 (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1321 (should (string-equal (file-remote-p "/[/]" 'hop) nil))
1323 ;; Expand `tramp-default-method' and `tramp-default-user'.
1324 (let ((tramp-default-host "::1"))
1325 (should (string-equal
1326 (file-remote-p "/[/]")
1327 (format
1328 "/[%s/%s@%s]"
1329 "default-method" "default-user" "::1")))
1330 (should (string-equal
1331 (file-remote-p "/[/]" 'method) "default-method"))
1332 (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1333 (should (string-equal (file-remote-p "/[/]" 'host) "::1"))
1334 (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1335 (should (string-equal (file-remote-p "/[/]" 'hop) nil)))
1337 ;; Expand `tramp-default-method' and `tramp-default-user'.
1338 (should (string-equal
1339 (file-remote-p "/[/::1]")
1340 (format
1341 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1342 (should (string-equal
1343 (file-remote-p "/[/::1]" 'method) "default-method"))
1344 (should (string-equal
1345 (file-remote-p "/[/::1]" 'user) "default-user"))
1346 (should (string-equal (file-remote-p "/[/::1]" 'host) "::1"))
1347 (should (string-equal (file-remote-p "/[/::1]" 'localname) ""))
1348 (should (string-equal (file-remote-p "/[/::1]" 'hop) nil))
1350 ;; Expand `tramp-default-method'.
1351 (should (string-equal
1352 (file-remote-p "/[/user@::1]")
1353 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1354 (should (string-equal
1355 (file-remote-p "/[/user@::1]" 'method) "default-method"))
1356 (should (string-equal (file-remote-p "/[/user@::1]" 'user) "user"))
1357 (should (string-equal (file-remote-p "/[/user@::1]" 'host) "::1"))
1358 (should (string-equal (file-remote-p "/[/user@::1]" 'localname) ""))
1359 (should (string-equal (file-remote-p "/[/user@::1]" 'hop) nil))
1361 ;; Expand `tramp-default-method', `tramp-default-user' and
1362 ;; `tramp-default-host'.
1363 (should (string-equal
1364 (file-remote-p "/[-/]")
1365 (format
1366 "/[%s/%s@%s]"
1367 "default-method" "default-user" "default-host")))
1368 (should (string-equal
1369 (file-remote-p "/[-/]" 'method) "default-method"))
1370 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1371 (should (string-equal (file-remote-p "/[-/]" 'host) "default-host"))
1372 (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1373 (should (string-equal (file-remote-p "/[-/]" 'hop) nil))
1375 ;; Expand `tramp-default-method' and `tramp-default-user'.
1376 (let ((tramp-default-host "::1"))
1377 (should (string-equal
1378 (file-remote-p "/[-/]")
1379 (format
1380 "/[%s/%s@%s]"
1381 "default-method" "default-user" "::1")))
1382 (should (string-equal
1383 (file-remote-p "/[-/]" 'method) "default-method"))
1384 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1385 (should (string-equal (file-remote-p "/[-/]" 'host) "::1"))
1386 (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1387 (should (string-equal (file-remote-p "/[-/]" 'hop) nil)))
1389 ;; Expand `tramp-default-method' and `tramp-default-user'.
1390 (should (string-equal
1391 (file-remote-p "/[-/::1]")
1392 (format
1393 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1394 (should (string-equal
1395 (file-remote-p "/[-/::1]" 'method) "default-method"))
1396 (should (string-equal
1397 (file-remote-p "/[-/::1]" 'user) "default-user"))
1398 (should (string-equal (file-remote-p "/[-/::1]" 'host) "::1"))
1399 (should (string-equal (file-remote-p "/[-/::1]" 'localname) ""))
1400 (should (string-equal (file-remote-p "/[-/::1]" 'hop) nil))
1402 ;; Expand `tramp-default-method'.
1403 (should (string-equal
1404 (file-remote-p "/[-/user@::1]")
1405 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1406 (should (string-equal
1407 (file-remote-p "/[-/user@::1]" 'method) "default-method"))
1408 (should (string-equal (file-remote-p "/[-/user@::1]" 'user) "user"))
1409 (should (string-equal (file-remote-p "/[-/user@::1]" 'host) "::1"))
1410 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname) ""))
1411 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop) nil))
1413 ;; Expand `tramp-default-user'.
1414 (should (string-equal
1415 (file-remote-p "/[method/::1]")
1416 (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1417 (should (string-equal
1418 (file-remote-p "/[method/::1]" 'method) "method"))
1419 (should (string-equal
1420 (file-remote-p "/[method/::1]" 'user) "default-user"))
1421 (should (string-equal (file-remote-p "/[method/::1]" 'host) "::1"))
1422 (should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
1423 (should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
1425 ;; No expansion.
1426 (should (string-equal
1427 (file-remote-p "/[method/user@::1]")
1428 (format "/[%s/%s@%s]" "method" "user" "::1")))
1429 (should (string-equal
1430 (file-remote-p "/[method/user@::1]" 'method) "method"))
1431 (should (string-equal
1432 (file-remote-p "/[method/user@::1]" 'user) "user"))
1433 (should (string-equal
1434 (file-remote-p "/[method/user@::1]" 'host) "::1"))
1435 (should (string-equal
1436 (file-remote-p "/[method/user@::1]" 'localname) ""))
1437 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
1439 ;; Local file name part.
1440 (should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
1441 (should (string-equal (file-remote-p "/[-/host]/:" 'localname) "/:"))
1442 (should (string-equal (file-remote-p "/[method/]:" 'localname) ":"))
1443 (should (string-equal (file-remote-p "/[method/] " 'localname) " "))
1444 (should (string-equal
1445 (file-remote-p "/[method/]file" 'localname) "file"))
1446 (should (string-equal
1447 (file-remote-p "/[method/]/path/to/file" 'localname)
1448 "/path/to/file"))
1450 ;; Multihop.
1451 (should
1452 (string-equal
1453 (file-remote-p
1454 "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1455 (format "/[%s/%s@%s|%s/%s@%s]"
1456 "method1" "user1" "host1" "method2" "user2" "host2")))
1457 (should
1458 (string-equal
1459 (file-remote-p
1460 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method)
1461 "method2"))
1462 (should
1463 (string-equal
1464 (file-remote-p
1465 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
1466 "user2"))
1467 (should
1468 (string-equal
1469 (file-remote-p
1470 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
1471 "host2"))
1472 (should
1473 (string-equal
1474 (file-remote-p
1475 "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1476 'localname)
1477 "/path/to/file"))
1478 (should
1479 (string-equal
1480 (file-remote-p
1481 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
1482 (format "%s/%s@%s|"
1483 "method1" "user1" "host1")))
1485 (should
1486 (string-equal
1487 (file-remote-p
1488 (concat
1489 "/[method1/user1@host1"
1490 "|method2/user2@host2"
1491 "|method3/user3@host3]/path/to/file"))
1492 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1493 "method1" "user1" "host1"
1494 "method2" "user2" "host2"
1495 "method3" "user3" "host3")))
1496 (should
1497 (string-equal
1498 (file-remote-p
1499 (concat
1500 "/[method1/user1@host1"
1501 "|method2/user2@host2"
1502 "|method3/user3@host3]/path/to/file")
1503 'method)
1504 "method3"))
1505 (should
1506 (string-equal
1507 (file-remote-p
1508 (concat
1509 "/[method1/user1@host1"
1510 "|method2/user2@host2"
1511 "|method3/user3@host3]/path/to/file")
1512 'user)
1513 "user3"))
1514 (should
1515 (string-equal
1516 (file-remote-p
1517 (concat
1518 "/[method1/user1@host1"
1519 "|method2/user2@host2"
1520 "|method3/user3@host3]/path/to/file")
1521 'host)
1522 "host3"))
1523 (should
1524 (string-equal
1525 (file-remote-p
1526 (concat
1527 "/[method1/user1@host1"
1528 "|method2/user2@host2"
1529 "|method3/user3@host3]/path/to/file")
1530 'localname)
1531 "/path/to/file"))
1532 (should
1533 (string-equal
1534 (file-remote-p
1535 (concat
1536 "/[method1/user1@host1"
1537 "|method2/user2@host2"
1538 "|method3/user3@host3]/path/to/file")
1539 'hop)
1540 (format "%s/%s@%s|%s/%s@%s|"
1541 "method1" "user1" "host1" "method2" "user2" "host2"))))
1543 ;; Exit.
1544 (tramp-change-syntax syntax))))
1546 (ert-deftest tramp-test03-file-name-defaults ()
1547 "Check default values for some methods."
1548 ;; Default values in tramp-adb.el.
1549 (should (string-equal (file-remote-p "/adb::" 'host) ""))
1550 ;; Default values in tramp-ftp.el.
1551 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
1552 (dolist (u '("ftp" "anonymous"))
1553 (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))
1554 ;; Default values in tramp-gvfs.el.
1555 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
1556 (symbol-value 'tramp-gvfs-enabled))
1557 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
1558 ;; Default values in tramp-sh.el.
1559 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1560 (should
1561 (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
1562 (dolist (m '("su" "sudo" "ksu"))
1563 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
1564 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1565 (should
1566 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
1567 ;; Default values in tramp-smb.el.
1568 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
1570 (ert-deftest tramp-test04-substitute-in-file-name ()
1571 "Check `substitute-in-file-name'."
1572 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
1573 (should
1574 (string-equal
1575 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1576 (should
1577 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1578 ;; Quoting local part.
1579 (should
1580 (string-equal
1581 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1582 (should
1583 (string-equal
1584 (substitute-in-file-name "/method:host:/:/path//foo")
1585 "/method:host:/:/path//foo"))
1586 (should
1587 (string-equal
1588 (substitute-in-file-name "/method:host:/:/path///foo")
1589 "/method:host:/:/path///foo"))
1591 (should
1592 (string-equal
1593 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
1594 (should
1595 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
1596 ;; Quoting local part.
1597 (should
1598 (string-equal
1599 (substitute-in-file-name "/method:host:/:/path/~/foo")
1600 "/method:host:/:/path/~/foo"))
1601 (should
1602 (string-equal
1603 (substitute-in-file-name "/method:host:/:/path//~/foo")
1604 "/method:host:/:/path//~/foo"))
1606 (let (process-environment)
1607 (should
1608 (string-equal
1609 (substitute-in-file-name "/method:host:/path/$FOO")
1610 "/method:host:/path/$FOO"))
1611 (setenv "FOO" "bla")
1612 (should
1613 (string-equal
1614 (substitute-in-file-name "/method:host:/path/$FOO")
1615 "/method:host:/path/bla"))
1616 (should
1617 (string-equal
1618 (substitute-in-file-name "/method:host:/path/$$FOO")
1619 "/method:host:/path/$FOO"))
1620 ;; Quoting local part.
1621 (should
1622 (string-equal
1623 (substitute-in-file-name "/method:host:/:/path/$FOO")
1624 "/method:host:/:/path/$FOO"))
1625 (setenv "FOO" "bla")
1626 (should
1627 (string-equal
1628 (substitute-in-file-name "/method:host:/:/path/$FOO")
1629 "/method:host:/:/path/$FOO"))
1630 (should
1631 (string-equal
1632 (substitute-in-file-name "/method:host:/:/path/$$FOO")
1633 "/method:host:/:/path/$$FOO"))))
1635 (ert-deftest tramp-test05-expand-file-name ()
1636 "Check `expand-file-name'."
1637 (should
1638 (string-equal
1639 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1640 (should
1641 (string-equal
1642 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1643 ;; Quoting local part.
1644 (should
1645 (string-equal
1646 (expand-file-name "/method:host:/:/path/./file")
1647 "/method:host:/:/path/file"))
1648 (should
1649 (string-equal
1650 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1651 (should
1652 (string-equal
1653 (expand-file-name "/method:host:/:/~/path/./file")
1654 "/method:host:/:/~/path/file")))
1656 ;; The following test is inspired by Bug#26911. It is rather a bug in
1657 ;; `expand-file-name', and it fails for all Emacs versions. Test
1658 ;; added for later, when it is fixed.
1659 (ert-deftest tramp-test05-expand-file-name-relative ()
1660 "Check `expand-file-name'."
1661 ;; Mark as failed until bug has been fixed.
1662 :expected-result :failed
1663 (skip-unless (tramp--test-enabled))
1664 ;; These are the methods the test doesn't fail.
1665 (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1666 (tramp-smb-file-name-p tramp-test-temporary-file-directory))
1667 (setf (ert-test-expected-result-type
1668 (ert-get-test 'tramp-test05-expand-file-name-relative))
1669 :passed))
1671 (should
1672 (string-equal
1673 (let ((default-directory
1674 (concat
1675 (file-remote-p tramp-test-temporary-file-directory) "/path")))
1676 (expand-file-name ".." "./"))
1677 (concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
1679 (ert-deftest tramp-test06-directory-file-name ()
1680 "Check `directory-file-name'.
1681 This checks also `file-name-as-directory', `file-name-directory',
1682 `file-name-nondirectory' and `unhandled-file-name-directory'."
1683 (should
1684 (string-equal
1685 (directory-file-name "/method:host:/path/to/file")
1686 "/method:host:/path/to/file"))
1687 (should
1688 (string-equal
1689 (directory-file-name "/method:host:/path/to/file/")
1690 "/method:host:/path/to/file"))
1691 (should
1692 (string-equal
1693 (directory-file-name "/method:host:/path/to/file//")
1694 "/method:host:/path/to/file"))
1695 (should
1696 (string-equal
1697 (file-name-as-directory "/method:host:/path/to/file")
1698 "/method:host:/path/to/file/"))
1699 (should
1700 (string-equal
1701 (file-name-as-directory "/method:host:/path/to/file/")
1702 "/method:host:/path/to/file/"))
1703 (should
1704 (string-equal
1705 (file-name-directory "/method:host:/path/to/file")
1706 "/method:host:/path/to/"))
1707 (should
1708 (string-equal
1709 (file-name-directory "/method:host:/path/to/file/")
1710 "/method:host:/path/to/file/"))
1711 (should
1712 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1713 (should
1714 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1715 (should-not
1716 (unhandled-file-name-directory "/method:host:/path/to/file"))
1718 ;; Bug#10085.
1719 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1720 (dolist (n-e '(nil t))
1721 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1722 ;; which ruins the tests.
1723 (let ((non-essential n-e)
1724 tramp-default-method)
1725 (dolist
1726 (file
1727 `(,(format
1728 "/%s::"
1729 (file-remote-p tramp-test-temporary-file-directory 'method))
1730 ,(format
1731 "/-:%s:"
1732 (file-remote-p tramp-test-temporary-file-directory 'host))))
1733 (should (string-equal (directory-file-name file) file))
1734 (should
1735 (string-equal
1736 (file-name-as-directory file)
1737 (if (tramp-completion-mode-p)
1738 file (concat file "./"))))
1739 (should (string-equal (file-name-directory file) file))
1740 (should (string-equal (file-name-nondirectory file) "")))))))
1742 (ert-deftest tramp-test07-file-exists-p ()
1743 "Check `file-exist-p', `write-region' and `delete-file'."
1744 (skip-unless (tramp--test-enabled))
1746 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1747 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1748 (should-not (file-exists-p tmp-name))
1749 (write-region "foo" nil tmp-name)
1750 (should (file-exists-p tmp-name))
1751 (delete-file tmp-name)
1752 (should-not (file-exists-p tmp-name)))))
1754 (ert-deftest tramp-test08-file-local-copy ()
1755 "Check `file-local-copy'."
1756 (skip-unless (tramp--test-enabled))
1758 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1759 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1760 tmp-name2)
1761 (unwind-protect
1762 (progn
1763 (write-region "foo" nil tmp-name1)
1764 (should (setq tmp-name2 (file-local-copy tmp-name1)))
1765 (with-temp-buffer
1766 (insert-file-contents tmp-name2)
1767 (should (string-equal (buffer-string) "foo")))
1768 ;; Check also that a file transfer with compression works.
1769 (let ((default-directory tramp-test-temporary-file-directory)
1770 (tramp-copy-size-limit 4)
1771 (tramp-inline-compress-start-size 2))
1772 (delete-file tmp-name2)
1773 (should (setq tmp-name2 (file-local-copy tmp-name1))))
1774 ;; Error case.
1775 (delete-file tmp-name1)
1776 (delete-file tmp-name2)
1777 (should-error
1778 (setq tmp-name2 (file-local-copy tmp-name1))
1779 :type tramp-file-missing))
1781 ;; Cleanup.
1782 (ignore-errors
1783 (delete-file tmp-name1)
1784 (delete-file tmp-name2))))))
1786 (ert-deftest tramp-test09-insert-file-contents ()
1787 "Check `insert-file-contents'."
1788 (skip-unless (tramp--test-enabled))
1790 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1791 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1792 (unwind-protect
1793 (with-temp-buffer
1794 (write-region "foo" nil tmp-name)
1795 (insert-file-contents tmp-name)
1796 (should (string-equal (buffer-string) "foo"))
1797 (insert-file-contents tmp-name)
1798 (should (string-equal (buffer-string) "foofoo"))
1799 ;; Insert partly.
1800 (insert-file-contents tmp-name nil 1 3)
1801 (should (string-equal (buffer-string) "oofoofoo"))
1802 ;; Replace.
1803 (insert-file-contents tmp-name nil nil nil 'replace)
1804 (should (string-equal (buffer-string) "foo"))
1805 ;; Error case.
1806 (delete-file tmp-name)
1807 (should-error
1808 (insert-file-contents tmp-name)
1809 :type tramp-file-missing))
1811 ;; Cleanup.
1812 (ignore-errors (delete-file tmp-name))))))
1814 (ert-deftest tramp-test10-write-region ()
1815 "Check `write-region'."
1816 (skip-unless (tramp--test-enabled))
1818 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1819 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1820 (unwind-protect
1821 (progn
1822 ;; Write buffer. Use absolute and relative file name.
1823 (with-temp-buffer
1824 (insert "foo")
1825 (write-region nil nil tmp-name))
1826 (with-temp-buffer
1827 (insert-file-contents tmp-name)
1828 (should (string-equal (buffer-string) "foo")))
1829 (delete-file tmp-name)
1830 (with-temp-buffer
1831 (insert "foo")
1832 (should-not (file-exists-p tmp-name))
1833 (let ((default-directory (file-name-directory tmp-name)))
1834 (should-not (file-exists-p (file-name-nondirectory tmp-name)))
1835 (write-region nil nil (file-name-nondirectory tmp-name))
1836 (should (file-exists-p (file-name-nondirectory tmp-name))))
1837 (should (file-exists-p tmp-name)))
1838 (with-temp-buffer
1839 (insert-file-contents tmp-name)
1840 (should (string-equal (buffer-string) "foo")))
1842 ;; Append.
1843 (with-temp-buffer
1844 (insert "bla")
1845 (write-region nil nil tmp-name 'append))
1846 (with-temp-buffer
1847 (insert-file-contents tmp-name)
1848 (should (string-equal (buffer-string) "foobla")))
1849 (with-temp-buffer
1850 (insert "baz")
1851 (write-region nil nil tmp-name 3))
1852 (with-temp-buffer
1853 (insert-file-contents tmp-name)
1854 (should (string-equal (buffer-string) "foobaz")))
1856 ;; Write string.
1857 (write-region "foo" nil tmp-name)
1858 (with-temp-buffer
1859 (insert-file-contents tmp-name)
1860 (should (string-equal (buffer-string) "foo")))
1862 ;; Write partly.
1863 (with-temp-buffer
1864 (insert "123456789")
1865 (write-region 3 5 tmp-name))
1866 (with-temp-buffer
1867 (insert-file-contents tmp-name)
1868 (should (string-equal (buffer-string) "34")))
1870 ;; Check message.
1871 ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
1872 (with-no-warnings (when (symbol-plist 'ert-with-message-capture)
1873 (let ((tramp-message-show-message t))
1874 (dolist (noninteractive '(nil t))
1875 (dolist (visit '(nil t "string" no-message))
1876 (ert-with-message-capture tramp--test-messages
1877 (write-region "foo" nil tmp-name nil visit)
1878 ;; We must check the last line. There could be
1879 ;; other messages from the progress reporter.
1880 (should
1881 (string-match
1882 (if (and (null noninteractive)
1883 (or (eq visit t) (null visit) (stringp visit)))
1884 (format "^Wrote %s\n\\'" tmp-name) "^\\'")
1885 tramp--test-messages))))))))
1887 ;; Do not overwrite if excluded.
1888 (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)))
1889 (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1890 ;; `mustbenew' is passed to Tramp since Emacs 26.1.
1891 (when (tramp--test-emacs26-p)
1892 (should-error
1893 (cl-letf (((symbol-function 'y-or-n-p) 'ignore))
1894 (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1895 :type 'file-already-exists)
1896 (should-error
1897 (write-region "foo" nil tmp-name nil nil nil 'excl)
1898 :type 'file-already-exists)))
1900 ;; Cleanup.
1901 (ignore-errors (delete-file tmp-name))))))
1903 (ert-deftest tramp-test11-copy-file ()
1904 "Check `copy-file'."
1905 (skip-unless (tramp--test-enabled))
1907 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
1908 (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p))
1909 '(nil t) '(nil)))
1910 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1911 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1912 (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
1913 (dolist (source-target
1914 `(;; Copy on remote side.
1915 (,tmp-name1 . ,tmp-name2)
1916 ;; Copy from remote side to local side.
1917 (,tmp-name1 . ,tmp-name3)
1918 ;; Copy from local side to remote side.
1919 (,tmp-name3 . ,tmp-name1)))
1920 (let ((source (car source-target))
1921 (target (cdr source-target)))
1923 ;; Copy simple file.
1924 (unwind-protect
1925 (progn
1926 (write-region "foo" nil source)
1927 (should (file-exists-p source))
1928 (copy-file source target)
1929 (should (file-exists-p target))
1930 (with-temp-buffer
1931 (insert-file-contents target)
1932 (should (string-equal (buffer-string) "foo")))
1933 (should-error
1934 (copy-file source target)
1935 :type 'file-already-exists)
1936 (copy-file source target 'ok))
1938 ;; Cleanup.
1939 (ignore-errors (delete-file source))
1940 (ignore-errors (delete-file target)))
1942 ;; Copy file to directory.
1943 (unwind-protect
1944 (progn
1945 (write-region "foo" nil source)
1946 (should (file-exists-p source))
1947 (make-directory target)
1948 (should (file-directory-p target))
1949 ;; This has been changed in Emacs 26.1.
1950 (when (tramp--test-emacs26-p)
1951 (should-error
1952 (copy-file source target)
1953 :type 'file-already-exists))
1954 (copy-file source (file-name-as-directory target))
1955 (should
1956 (file-exists-p
1957 (expand-file-name (file-name-nondirectory source) target))))
1959 ;; Cleanup.
1960 (ignore-errors (delete-file source))
1961 (ignore-errors (delete-directory target 'recursive)))
1963 ;; Copy directory to existing directory.
1964 (unwind-protect
1965 (progn
1966 (make-directory source)
1967 (should (file-directory-p source))
1968 (write-region "foo" nil (expand-file-name "foo" source))
1969 (should (file-exists-p (expand-file-name "foo" source)))
1970 (make-directory target)
1971 (should (file-directory-p target))
1972 ;; Directory `target' exists already, so we must use
1973 ;; `file-name-as-directory'.
1974 (copy-file source (file-name-as-directory target))
1975 (should
1976 (file-exists-p
1977 (expand-file-name
1978 (concat (file-name-nondirectory source) "/foo") target))))
1980 ;; Cleanup.
1981 (ignore-errors (delete-directory source 'recursive))
1982 (ignore-errors (delete-directory target 'recursive)))
1984 ;; Copy directory/file to non-existing directory.
1985 (unwind-protect
1986 (progn
1987 (make-directory source)
1988 (should (file-directory-p source))
1989 (write-region "foo" nil (expand-file-name "foo" source))
1990 (should (file-exists-p (expand-file-name "foo" source)))
1991 (make-directory target)
1992 (should (file-directory-p target))
1993 (copy-file
1994 source
1995 (expand-file-name (file-name-nondirectory source) target))
1996 (should
1997 (file-exists-p
1998 (expand-file-name
1999 (concat (file-name-nondirectory source) "/foo") target))))
2001 ;; Cleanup.
2002 (ignore-errors (delete-directory source 'recursive))
2003 (ignore-errors (delete-directory target 'recursive))))))))
2005 (ert-deftest tramp-test12-rename-file ()
2006 "Check `rename-file'."
2007 (skip-unless (tramp--test-enabled))
2009 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
2010 (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p))
2011 '(nil t) '(nil)))
2012 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2013 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2014 (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
2015 (dolist (source-target
2016 `(;; Rename on remote side.
2017 (,tmp-name1 . ,tmp-name2)
2018 ;; Rename from remote side to local side.
2019 (,tmp-name1 . ,tmp-name3)
2020 ;; Rename from local side to remote side.
2021 (,tmp-name3 . ,tmp-name1)))
2022 (let ((source (car source-target))
2023 (target (cdr source-target)))
2025 ;; Rename simple file.
2026 (unwind-protect
2027 (progn
2028 (write-region "foo" nil source)
2029 (should (file-exists-p source))
2030 (rename-file source target)
2031 (should-not (file-exists-p source))
2032 (should (file-exists-p target))
2033 (with-temp-buffer
2034 (insert-file-contents target)
2035 (should (string-equal (buffer-string) "foo")))
2036 (write-region "foo" nil source)
2037 (should (file-exists-p source))
2038 (should-error
2039 (rename-file source target)
2040 :type 'file-already-exists)
2041 (rename-file source target 'ok)
2042 (should-not (file-exists-p source)))
2044 ;; Cleanup.
2045 (ignore-errors (delete-file source))
2046 (ignore-errors (delete-file target)))
2048 ;; Rename file to directory.
2049 (unwind-protect
2050 (progn
2051 (write-region "foo" nil source)
2052 (should (file-exists-p source))
2053 (make-directory target)
2054 (should (file-directory-p target))
2055 ;; This has been changed in Emacs 26.1.
2056 (when (tramp--test-emacs26-p)
2057 (should-error
2058 (rename-file source target)
2059 :type 'file-already-exists))
2060 (rename-file source (file-name-as-directory target))
2061 (should-not (file-exists-p source))
2062 (should
2063 (file-exists-p
2064 (expand-file-name (file-name-nondirectory source) target))))
2066 ;; Cleanup.
2067 (ignore-errors (delete-file source))
2068 (ignore-errors (delete-directory target 'recursive)))
2070 ;; Rename directory to existing directory.
2071 (unwind-protect
2072 (progn
2073 (make-directory source)
2074 (should (file-directory-p source))
2075 (write-region "foo" nil (expand-file-name "foo" source))
2076 (should (file-exists-p (expand-file-name "foo" source)))
2077 (make-directory target)
2078 (should (file-directory-p target))
2079 ;; Directory `target' exists already, so we must use
2080 ;; `file-name-as-directory'.
2081 (rename-file source (file-name-as-directory target))
2082 (should-not (file-exists-p source))
2083 (should
2084 (file-exists-p
2085 (expand-file-name
2086 (concat (file-name-nondirectory source) "/foo") target))))
2088 ;; Cleanup.
2089 (ignore-errors (delete-directory source 'recursive))
2090 (ignore-errors (delete-directory target 'recursive)))
2092 ;; Rename directory/file to non-existing directory.
2093 (unwind-protect
2094 (progn
2095 (make-directory source)
2096 (should (file-directory-p source))
2097 (write-region "foo" nil (expand-file-name "foo" source))
2098 (should (file-exists-p (expand-file-name "foo" source)))
2099 (make-directory target)
2100 (should (file-directory-p target))
2101 (rename-file
2102 source
2103 (expand-file-name (file-name-nondirectory source) target))
2104 (should-not (file-exists-p source))
2105 (should
2106 (file-exists-p
2107 (expand-file-name
2108 (concat (file-name-nondirectory source) "/foo") target))))
2110 ;; Cleanup.
2111 (ignore-errors (delete-directory source 'recursive))
2112 (ignore-errors (delete-directory target 'recursive))))))))
2114 (ert-deftest tramp-test13-make-directory ()
2115 "Check `make-directory'.
2116 This tests also `file-directory-p' and `file-accessible-directory-p'."
2117 (skip-unless (tramp--test-enabled))
2119 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2120 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2121 (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
2122 (unwind-protect
2123 (progn
2124 (make-directory tmp-name1)
2125 (should (file-directory-p tmp-name1))
2126 (should (file-accessible-directory-p tmp-name1))
2127 (should-error (make-directory tmp-name2) :type 'file-error)
2128 (make-directory tmp-name2 'parents)
2129 (should (file-directory-p tmp-name2))
2130 (should (file-accessible-directory-p tmp-name2))
2131 ;; If PARENTS is non-nil, `make-directory' shall not
2132 ;; signal an error when DIR exists already.
2133 (make-directory tmp-name2 'parents))
2135 ;; Cleanup.
2136 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2138 (ert-deftest tramp-test14-delete-directory ()
2139 "Check `delete-directory'."
2140 (skip-unless (tramp--test-enabled))
2142 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2143 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2144 ;; Delete empty directory.
2145 (make-directory tmp-name)
2146 (should (file-directory-p tmp-name))
2147 (delete-directory tmp-name)
2148 (should-not (file-directory-p tmp-name))
2149 ;; Delete non-empty directory.
2150 (make-directory tmp-name)
2151 (should (file-directory-p tmp-name))
2152 (write-region "foo" nil (expand-file-name "bla" tmp-name))
2153 (should (file-exists-p (expand-file-name "bla" tmp-name)))
2154 (should-error (delete-directory tmp-name) :type 'file-error)
2155 (delete-directory tmp-name 'recursive)
2156 (should-not (file-directory-p tmp-name)))))
2158 (ert-deftest tramp-test15-copy-directory ()
2159 "Check `copy-directory'."
2160 (skip-unless (tramp--test-enabled))
2162 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2163 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2164 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2165 (tmp-name3 (expand-file-name
2166 (file-name-nondirectory tmp-name1) tmp-name2))
2167 (tmp-name4 (expand-file-name "foo" tmp-name1))
2168 (tmp-name5 (expand-file-name "foo" tmp-name2))
2169 (tmp-name6 (expand-file-name "foo" tmp-name3)))
2171 ;; Copy complete directory.
2172 (unwind-protect
2173 (progn
2174 ;; Copy empty directory.
2175 (make-directory tmp-name1)
2176 (write-region "foo" nil tmp-name4)
2177 (should (file-directory-p tmp-name1))
2178 (should (file-exists-p tmp-name4))
2179 (copy-directory tmp-name1 tmp-name2)
2180 (should (file-directory-p tmp-name2))
2181 (should (file-exists-p tmp-name5))
2182 ;; Target directory does exist already.
2183 ;; This has been changed in Emacs 26.1.
2184 (when (tramp--test-emacs26-p)
2185 (should-error
2186 (copy-directory tmp-name1 tmp-name2)
2187 :type 'file-error))
2188 (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
2189 (should (file-directory-p tmp-name3))
2190 (should (file-exists-p tmp-name6)))
2192 ;; Cleanup.
2193 (ignore-errors
2194 (delete-directory tmp-name1 'recursive)
2195 (delete-directory tmp-name2 'recursive)))
2197 ;; Copy directory contents.
2198 (unwind-protect
2199 (progn
2200 ;; Copy empty directory.
2201 (make-directory tmp-name1)
2202 (write-region "foo" nil tmp-name4)
2203 (should (file-directory-p tmp-name1))
2204 (should (file-exists-p tmp-name4))
2205 (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
2206 (should (file-directory-p tmp-name2))
2207 (should (file-exists-p tmp-name5))
2208 ;; Target directory does exist already.
2209 (delete-file tmp-name5)
2210 (should-not (file-exists-p tmp-name5))
2211 (copy-directory
2212 tmp-name1 (file-name-as-directory tmp-name2)
2213 nil 'parents 'contents)
2214 (should (file-directory-p tmp-name2))
2215 (should (file-exists-p tmp-name5))
2216 (should-not (file-directory-p tmp-name3))
2217 (should-not (file-exists-p tmp-name6)))
2219 ;; Cleanup.
2220 (ignore-errors
2221 (delete-directory tmp-name1 'recursive)
2222 (delete-directory tmp-name2 'recursive))))))
2224 (ert-deftest tramp-test16-directory-files ()
2225 "Check `directory-files'."
2226 (skip-unless (tramp--test-enabled))
2228 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2229 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2230 (tmp-name2 (expand-file-name "bla" tmp-name1))
2231 (tmp-name3 (expand-file-name "foo" tmp-name1)))
2232 (unwind-protect
2233 (progn
2234 (make-directory tmp-name1)
2235 (write-region "foo" nil tmp-name2)
2236 (write-region "bla" nil tmp-name3)
2237 (should (file-directory-p tmp-name1))
2238 (should (file-exists-p tmp-name2))
2239 (should (file-exists-p tmp-name3))
2240 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
2241 (should (equal (directory-files tmp-name1 'full)
2242 `(,(concat tmp-name1 "/.")
2243 ,(concat tmp-name1 "/..")
2244 ,tmp-name2 ,tmp-name3)))
2245 (should (equal (directory-files
2246 tmp-name1 nil directory-files-no-dot-files-regexp)
2247 '("bla" "foo")))
2248 (should (equal (directory-files
2249 tmp-name1 'full directory-files-no-dot-files-regexp)
2250 `(,tmp-name2 ,tmp-name3))))
2252 ;; Cleanup.
2253 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2255 ;; This is not a file name handler test. But Tramp needed to apply an
2256 ;; advice for older Emacs versions, so we check that this has been fixed.
2257 (ert-deftest tramp-test16-file-expand-wildcards ()
2258 "Check `file-expand-wildcards'."
2259 (skip-unless (tramp--test-enabled))
2261 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2262 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2263 (tmp-name2 (expand-file-name "foo" tmp-name1))
2264 (tmp-name3 (expand-file-name "bar" tmp-name1))
2265 (tmp-name4 (expand-file-name "baz" tmp-name1))
2266 (default-directory tmp-name1))
2267 (unwind-protect
2268 (progn
2269 (make-directory tmp-name1)
2270 (write-region "foo" nil tmp-name2)
2271 (write-region "bar" nil tmp-name3)
2272 (write-region "baz" nil tmp-name4)
2273 (should (file-directory-p tmp-name1))
2274 (should (file-exists-p tmp-name2))
2275 (should (file-exists-p tmp-name3))
2276 (should (file-exists-p tmp-name4))
2278 ;; `sort' works destructive.
2279 (should
2280 (equal (file-expand-wildcards "*")
2281 (sort (copy-sequence '("foo" "bar" "baz")) 'string<)))
2282 (should
2283 (equal (file-expand-wildcards "ba?")
2284 (sort (copy-sequence '("bar" "baz")) 'string<)))
2285 (should
2286 (equal (file-expand-wildcards "ba[rz]")
2287 (sort (copy-sequence '("bar" "baz")) 'string<)))
2289 (should
2290 (equal
2291 (file-expand-wildcards "*" 'full)
2292 (sort
2293 (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
2294 (should
2295 (equal
2296 (file-expand-wildcards "ba?" 'full)
2297 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
2298 (should
2299 (equal
2300 (file-expand-wildcards "ba[rz]" 'full)
2301 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
2303 (should
2304 (equal
2305 (file-expand-wildcards (concat tmp-name1 "/" "*"))
2306 (sort
2307 (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
2308 (should
2309 (equal
2310 (file-expand-wildcards (concat tmp-name1 "/" "ba?"))
2311 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
2312 (should
2313 (equal
2314 (file-expand-wildcards (concat tmp-name1 "/" "ba[rz]"))
2315 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))))
2317 ;; Cleanup.
2318 (ignore-errors
2319 (delete-directory tmp-name1 'recursive))))))
2321 (ert-deftest tramp-test17-insert-directory ()
2322 "Check `insert-directory'."
2323 (skip-unless (tramp--test-enabled))
2325 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2326 (let* ((tmp-name1
2327 (expand-file-name (tramp--test-make-temp-name nil quoted)))
2328 (tmp-name2 (expand-file-name "foo" tmp-name1))
2329 ;; We test for the summary line. Keyword "total" could be localized.
2330 (process-environment
2331 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
2332 (unwind-protect
2333 (progn
2334 (make-directory tmp-name1)
2335 (write-region "foo" nil tmp-name2)
2336 (should (file-directory-p tmp-name1))
2337 (should (file-exists-p tmp-name2))
2338 (with-temp-buffer
2339 (insert-directory tmp-name1 nil)
2340 (goto-char (point-min))
2341 (should (looking-at-p (regexp-quote tmp-name1))))
2342 ;; This has been fixed in Emacs 26.1. See Bug#29423.
2343 (when (tramp--test-emacs26-p)
2344 (with-temp-buffer
2345 (insert-directory (file-name-as-directory tmp-name1) nil)
2346 (goto-char (point-min))
2347 (should
2348 (looking-at-p
2349 (regexp-quote (file-name-as-directory tmp-name1))))))
2350 (with-temp-buffer
2351 (insert-directory tmp-name1 "-al")
2352 (goto-char (point-min))
2353 (should
2354 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
2355 (with-temp-buffer
2356 (insert-directory (file-name-as-directory tmp-name1) "-al")
2357 (goto-char (point-min))
2358 (should
2359 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
2360 (with-temp-buffer
2361 (insert-directory
2362 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
2363 (goto-char (point-min))
2364 (should
2365 (looking-at-p
2366 (concat
2367 ;; There might be a summary line.
2368 "\\(total.+[[:digit:]]+\n\\)?"
2369 ;; We don't know in which order ".", ".." and "foo" appear.
2370 (format
2371 "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
2372 (regexp-opt (directory-files tmp-name1))
2373 (length (directory-files tmp-name1))))))))
2375 ;; Cleanup.
2376 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2378 (ert-deftest tramp-test17-dired-with-wildcards ()
2379 "Check `dired' with wildcards."
2380 (skip-unless (tramp--test-enabled))
2381 (skip-unless (tramp--test-sh-p))
2382 (skip-unless (not (tramp--test-rsync-p)))
2383 ;; Since Emacs 26.1.
2384 (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
2386 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2387 (let* ((tmp-name1
2388 (expand-file-name (tramp--test-make-temp-name nil quoted)))
2389 (tmp-name2
2390 (expand-file-name (tramp--test-make-temp-name nil quoted)))
2391 (tmp-name3 (expand-file-name "foo" tmp-name1))
2392 (tmp-name4 (expand-file-name "bar" tmp-name2))
2393 (tramp-test-temporary-file-directory
2394 (funcall
2395 (if quoted 'tramp-compat-file-name-quote 'identity)
2396 tramp-test-temporary-file-directory))
2397 buffer)
2398 (unwind-protect
2399 (progn
2400 (make-directory tmp-name1)
2401 (write-region "foo" nil tmp-name3)
2402 (should (file-directory-p tmp-name1))
2403 (should (file-exists-p tmp-name3))
2404 (make-directory tmp-name2)
2405 (write-region "foo" nil tmp-name4)
2406 (should (file-directory-p tmp-name2))
2407 (should (file-exists-p tmp-name4))
2409 ;; Check for expanded directory names.
2410 (with-current-buffer
2411 (setq buffer
2412 (dired-noselect
2413 (expand-file-name
2414 "tramp-test*" tramp-test-temporary-file-directory)))
2415 (goto-char (point-min))
2416 (should
2417 (re-search-forward
2418 (regexp-quote
2419 (file-relative-name
2420 tmp-name1 tramp-test-temporary-file-directory))))
2421 (goto-char (point-min))
2422 (should
2423 (re-search-forward
2424 (regexp-quote
2425 (file-relative-name
2426 tmp-name2 tramp-test-temporary-file-directory)))))
2427 (kill-buffer buffer)
2429 ;; Check for expanded directory and file names.
2430 (with-current-buffer
2431 (setq buffer
2432 (dired-noselect
2433 (expand-file-name
2434 "tramp-test*/*" tramp-test-temporary-file-directory)))
2435 (goto-char (point-min))
2436 (should
2437 (re-search-forward
2438 (regexp-quote
2439 (file-relative-name
2440 tmp-name3 tramp-test-temporary-file-directory))))
2441 (goto-char (point-min))
2442 (should
2443 (re-search-forward
2444 (regexp-quote
2445 (file-relative-name
2446 tmp-name4
2447 tramp-test-temporary-file-directory)))))
2448 (kill-buffer buffer)
2450 ;; Check for special characters.
2451 (setq tmp-name3 (expand-file-name "*?" tmp-name1))
2452 (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
2453 (write-region "foo" nil tmp-name3)
2454 (should (file-exists-p tmp-name3))
2455 (write-region "foo" nil tmp-name4)
2456 (should (file-exists-p tmp-name4))
2458 (with-current-buffer
2459 (setq buffer
2460 (dired-noselect
2461 (expand-file-name
2462 "tramp-test*/*" tramp-test-temporary-file-directory)))
2463 (goto-char (point-min))
2464 (should
2465 (re-search-forward
2466 (regexp-quote
2467 (file-relative-name
2468 tmp-name3 tramp-test-temporary-file-directory))))
2469 (goto-char (point-min))
2470 (should
2471 (re-search-forward
2472 (regexp-quote
2473 (file-relative-name
2474 tmp-name4
2475 tramp-test-temporary-file-directory)))))
2476 (kill-buffer buffer))
2478 ;; Cleanup.
2479 (ignore-errors (kill-buffer buffer))
2480 (ignore-errors (delete-directory tmp-name1 'recursive))
2481 (ignore-errors (delete-directory tmp-name2 'recursive))))))
2483 ;; Method "smb" supports `make-symbolic-link' only if the remote host
2484 ;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
2485 ;; support symbolic links at all.
2486 (defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
2487 "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
2488 (declare (indent defun) (debug t))
2489 `(condition-case err
2490 (progn ,@body)
2491 ((error quit debug)
2492 (unless (and (eq (car err) 'file-error)
2493 (string-equal (error-message-string err)
2494 "make-symbolic-link not supported"))
2495 (signal (car err) (cdr err))))))
2497 (ert-deftest tramp-test18-file-attributes ()
2498 "Check `file-attributes'.
2499 This tests also `file-readable-p', `file-regular-p' and
2500 `file-ownership-preserved-p'."
2501 (skip-unless (tramp--test-enabled))
2503 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2504 ;; We must use `file-truename' for the temporary directory,
2505 ;; because it could be located on a symlinked directory. This
2506 ;; would let the test fail.
2507 (let* ((tramp-test-temporary-file-directory
2508 (file-truename tramp-test-temporary-file-directory))
2509 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2510 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2511 ;; File name with "//".
2512 (tmp-name3
2513 (format
2514 "%s%s"
2515 (file-remote-p tmp-name1)
2516 (replace-regexp-in-string
2517 "/" "//" (file-remote-p tmp-name1 'localname))))
2518 attr)
2519 (unwind-protect
2520 (progn
2521 ;; `file-ownership-preserved-p' should return t for
2522 ;; non-existing files. It is implemented only in tramp-sh.el.
2523 (when (tramp--test-sh-p)
2524 (should (file-ownership-preserved-p tmp-name1 'group)))
2525 (write-region "foo" nil tmp-name1)
2526 (should (file-exists-p tmp-name1))
2527 (should (file-readable-p tmp-name1))
2528 (should (file-regular-p tmp-name1))
2529 (when (tramp--test-sh-p)
2530 (should (file-ownership-preserved-p tmp-name1 'group)))
2532 ;; We do not test inodes and device numbers.
2533 (setq attr (file-attributes tmp-name1))
2534 (should (consp attr))
2535 (should (null (car attr)))
2536 (should (numberp (nth 1 attr))) ;; Link.
2537 (should (numberp (nth 2 attr))) ;; Uid.
2538 (should (numberp (nth 3 attr))) ;; Gid.
2539 ;; Last access time.
2540 (should (stringp (current-time-string (nth 4 attr))))
2541 ;; Last modification time.
2542 (should (stringp (current-time-string (nth 5 attr))))
2543 ;; Last status change time.
2544 (should (stringp (current-time-string (nth 6 attr))))
2545 (should (numberp (nth 7 attr))) ;; Size.
2546 (should (stringp (nth 8 attr))) ;; Modes.
2548 (setq attr (file-attributes tmp-name1 'string))
2549 (should (stringp (nth 2 attr))) ;; Uid.
2550 (should (stringp (nth 3 attr))) ;; Gid.
2552 (tramp--test-ignore-make-symbolic-link-error
2553 (when (tramp--test-sh-p)
2554 (should (file-ownership-preserved-p tmp-name2 'group)))
2555 (make-symbolic-link tmp-name1 tmp-name2)
2556 (should (file-exists-p tmp-name2))
2557 (should (file-symlink-p tmp-name2))
2558 (when (tramp--test-sh-p)
2559 (should (file-ownership-preserved-p tmp-name2 'group)))
2560 (setq attr (file-attributes tmp-name2))
2561 (should
2562 (string-equal
2563 (funcall
2564 (if quoted 'tramp-compat-file-name-quote 'identity)
2565 (car attr))
2566 (file-remote-p (file-truename tmp-name1) 'localname)))
2567 (delete-file tmp-name2))
2569 ;; Check, that "//" in symlinks are handled properly.
2570 (with-temp-buffer
2571 (let ((default-directory tramp-test-temporary-file-directory))
2572 (shell-command
2573 (format
2574 "ln -s %s %s"
2575 (tramp-file-name-localname
2576 (tramp-dissect-file-name tmp-name3))
2577 (tramp-file-name-localname
2578 (tramp-dissect-file-name tmp-name2)))
2579 t)))
2580 (when (file-symlink-p tmp-name2)
2581 (setq attr (file-attributes tmp-name2))
2582 (should
2583 (string-equal
2584 (car attr)
2585 (tramp-file-name-localname
2586 (tramp-dissect-file-name tmp-name3))))
2587 (delete-file tmp-name2))
2589 (when (tramp--test-sh-p)
2590 (should (file-ownership-preserved-p tmp-name1 'group)))
2591 (delete-file tmp-name1)
2592 (make-directory tmp-name1)
2593 (should (file-exists-p tmp-name1))
2594 (should (file-readable-p tmp-name1))
2595 (should-not (file-regular-p tmp-name1))
2596 (when (tramp--test-sh-p)
2597 (should (file-ownership-preserved-p tmp-name1 'group)))
2598 (setq attr (file-attributes tmp-name1))
2599 (should (eq (car attr) t)))
2601 ;; Cleanup.
2602 (ignore-errors (delete-directory tmp-name1))
2603 (ignore-errors (delete-file tmp-name1))
2604 (ignore-errors (delete-file tmp-name2))))))
2606 (ert-deftest tramp-test19-directory-files-and-attributes ()
2607 "Check `directory-files-and-attributes'."
2608 (skip-unless (tramp--test-enabled))
2610 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2611 ;; `directory-files-and-attributes' contains also values for
2612 ;; "../". Ensure that this doesn't change during tests, for
2613 ;; example due to handling temporary files.
2614 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2615 (tmp-name2 (expand-file-name "bla" tmp-name1))
2616 attr)
2617 (unwind-protect
2618 (progn
2619 (make-directory tmp-name1)
2620 (should (file-directory-p tmp-name1))
2621 (make-directory tmp-name2)
2622 (should (file-directory-p tmp-name2))
2623 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
2624 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
2625 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
2626 (setq attr (directory-files-and-attributes tmp-name2))
2627 (should (consp attr))
2628 ;; Dumb remote shells without perl(1) or stat(1) are not
2629 ;; able to return the date correctly. They say "don't know".
2630 (dolist (elt attr)
2631 (unless
2632 (equal
2633 (nth
2634 5 (file-attributes (expand-file-name (car elt) tmp-name2)))
2635 '(0 0))
2636 (should
2637 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
2638 (cdr elt)))))
2639 (setq attr (directory-files-and-attributes tmp-name2 'full))
2640 (dolist (elt attr)
2641 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
2642 (should
2643 (equal (file-attributes (car elt)) (cdr elt)))))
2644 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
2645 (should (equal (mapcar 'car attr) '("bar" "boz"))))
2647 ;; Cleanup.
2648 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2650 (ert-deftest tramp-test20-file-modes ()
2651 "Check `file-modes'.
2652 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2653 (skip-unless (tramp--test-enabled))
2654 (skip-unless (tramp--test-sh-p))
2656 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2657 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2658 (unwind-protect
2659 (progn
2660 (write-region "foo" nil tmp-name)
2661 (should (file-exists-p tmp-name))
2662 (set-file-modes tmp-name #o777)
2663 (should (= (file-modes tmp-name) #o777))
2664 (should (file-executable-p tmp-name))
2665 (should (file-writable-p tmp-name))
2666 (set-file-modes tmp-name #o444)
2667 (should (= (file-modes tmp-name) #o444))
2668 (should-not (file-executable-p tmp-name))
2669 ;; A file is always writable for user "root".
2670 (unless (zerop (nth 2 (file-attributes tmp-name)))
2671 (should-not (file-writable-p tmp-name))))
2673 ;; Cleanup.
2674 (ignore-errors (delete-file tmp-name))))))
2676 (ert-deftest tramp-test21-file-links ()
2677 "Check `file-symlink-p'.
2678 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2679 (skip-unless (tramp--test-enabled))
2680 ;; The semantics has changed heavily in Emacs 26.1. We cannot test
2681 ;; older Emacsen, therefore.
2682 (skip-unless (tramp--test-emacs26-p))
2684 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2685 ;; We must use `file-truename' for the temporary directory,
2686 ;; because it could be located on a symlinked directory. This
2687 ;; would let the test fail.
2688 (let* ((tramp-test-temporary-file-directory
2689 (file-truename tramp-test-temporary-file-directory))
2690 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2691 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2692 (tmp-name3 (tramp--test-make-temp-name 'local quoted))
2693 (tmp-name4 (tramp--test-make-temp-name nil quoted))
2694 (tmp-name5
2695 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))
2696 ;; Check `make-symbolic-link'.
2697 (unwind-protect
2698 (tramp--test-ignore-make-symbolic-link-error
2699 (write-region "foo" nil tmp-name1)
2700 (should (file-exists-p tmp-name1))
2701 (make-symbolic-link tmp-name1 tmp-name2)
2702 (should
2703 (string-equal
2704 (funcall
2705 (if quoted 'tramp-compat-file-name-unquote 'identity)
2706 (file-remote-p tmp-name1 'localname))
2707 (file-symlink-p tmp-name2)))
2708 (should-error
2709 (make-symbolic-link tmp-name1 tmp-name2)
2710 :type 'file-already-exists)
2711 ;; A number means interactive case.
2712 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
2713 (should-error
2714 (make-symbolic-link tmp-name1 tmp-name2 0)
2715 :type 'file-already-exists))
2716 (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
2717 (make-symbolic-link tmp-name1 tmp-name2 0)
2718 (should
2719 (string-equal
2720 (funcall
2721 (if quoted 'tramp-compat-file-name-unquote 'identity)
2722 (file-remote-p tmp-name1 'localname))
2723 (file-symlink-p tmp-name2))))
2724 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
2725 (should
2726 (string-equal
2727 (funcall
2728 (if quoted 'tramp-compat-file-name-unquote 'identity)
2729 (file-remote-p tmp-name1 'localname))
2730 (file-symlink-p tmp-name2)))
2731 ;; If we use the local part of `tmp-name1', it shall still work.
2732 (make-symbolic-link
2733 (file-remote-p tmp-name1 'localname)
2734 tmp-name2 'ok-if-already-exists)
2735 (should
2736 (string-equal
2737 (funcall
2738 (if quoted 'tramp-compat-file-name-unquote 'identity)
2739 (file-remote-p tmp-name1 'localname))
2740 (file-symlink-p tmp-name2)))
2741 ;; `tmp-name3' is a local file name. Therefore, the link
2742 ;; target remains unchanged, even if quoted.
2743 ;; `make-symbolic-link' might not be permitted on w32 systems.
2744 (unless (tramp--test-windows-nt)
2745 (make-symbolic-link tmp-name1 tmp-name3)
2746 (should
2747 (string-equal tmp-name1 (file-symlink-p tmp-name3))))
2748 ;; Check directory as newname.
2749 (make-directory tmp-name4)
2750 (should-error
2751 (make-symbolic-link tmp-name1 tmp-name4)
2752 :type 'file-already-exists)
2753 (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4))
2754 (should
2755 (string-equal
2756 (funcall
2757 (if quoted 'tramp-compat-file-name-unquote 'identity)
2758 (file-remote-p tmp-name1 'localname))
2759 (file-symlink-p tmp-name5)))
2760 ;; `smbclient' does not show symlinks in directories, so
2761 ;; we cannot delete a non-empty directory. We delete the
2762 ;; file explicitly.
2763 (delete-file tmp-name5))
2765 ;; Cleanup.
2766 (ignore-errors
2767 (delete-file tmp-name1)
2768 (delete-file tmp-name2)
2769 (delete-file tmp-name3)
2770 (delete-directory tmp-name4 'recursive)))
2772 ;; Check `add-name-to-file'.
2773 (unwind-protect
2774 (unless (tramp-smb-file-name-p tramp-test-temporary-file-directory)
2775 (write-region "foo" nil tmp-name1)
2776 (should (file-exists-p tmp-name1))
2777 (add-name-to-file tmp-name1 tmp-name2)
2778 (should (file-regular-p tmp-name2))
2779 (should-error
2780 (add-name-to-file tmp-name1 tmp-name2)
2781 :type 'file-already-exists)
2782 ;; A number means interactive case.
2783 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
2784 (should-error
2785 (add-name-to-file tmp-name1 tmp-name2 0)
2786 :type 'file-already-exists))
2787 (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
2788 (add-name-to-file tmp-name1 tmp-name2 0)
2789 (should (file-regular-p tmp-name2)))
2790 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
2791 (should-not (file-symlink-p tmp-name2))
2792 (should (file-regular-p tmp-name2))
2793 ;; `tmp-name3' is a local file name.
2794 (should-error
2795 (add-name-to-file tmp-name1 tmp-name3)
2796 :type 'file-error)
2797 ;; Check directory as newname.
2798 (make-directory tmp-name4)
2799 (should-error
2800 (add-name-to-file tmp-name1 tmp-name4)
2801 :type 'file-already-exists)
2802 (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4))
2803 (should
2804 (file-regular-p
2805 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4))))
2807 ;; Cleanup.
2808 (ignore-errors
2809 (delete-file tmp-name1)
2810 (delete-file tmp-name2)
2811 (delete-directory tmp-name4 'recursive)))
2813 ;; Check `file-truename'.
2814 (unwind-protect
2815 (tramp--test-ignore-make-symbolic-link-error
2816 (write-region "foo" nil tmp-name1)
2817 (should (file-exists-p tmp-name1))
2818 (should (string-equal tmp-name1 (file-truename tmp-name1)))
2819 (make-symbolic-link tmp-name1 tmp-name2)
2820 (should (file-symlink-p tmp-name2))
2821 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
2822 (should
2823 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
2824 (should (file-equal-p tmp-name1 tmp-name2))
2825 ;; Check relative symlink file name.
2826 (delete-file tmp-name2)
2827 (let ((default-directory tramp-test-temporary-file-directory))
2828 (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
2829 (should (file-symlink-p tmp-name2))
2830 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
2831 (should
2832 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
2833 (should (file-equal-p tmp-name1 tmp-name2))
2834 ;; Symbolic links could look like a remote file name.
2835 ;; They must be quoted then.
2836 (delete-file tmp-name2)
2837 (make-symbolic-link
2838 (funcall
2839 (if quoted 'tramp-compat-file-name-unquote 'identity)
2840 "/penguin:motd:")
2841 tmp-name2)
2842 (should (file-symlink-p tmp-name2))
2843 (should
2844 (string-equal
2845 (file-truename tmp-name2)
2846 (tramp-compat-file-name-quote
2847 (concat (file-remote-p tmp-name2) "/penguin:motd:"))))
2848 ;; `tmp-name3' is a local file name.
2849 ;; `make-symbolic-link' might not be permitted on w32 systems.
2850 (unless (tramp--test-windows-nt)
2851 (make-symbolic-link tmp-name1 tmp-name3)
2852 (should (file-symlink-p tmp-name3))
2853 (should-not (string-equal tmp-name3 (file-truename tmp-name3)))
2854 ;; `file-truename' returns a quoted file name for `tmp-name3'.
2855 ;; We must unquote it.
2856 (should
2857 (string-equal
2858 (file-truename tmp-name1)
2859 (tramp-compat-file-name-unquote (file-truename tmp-name3))))))
2861 ;; Cleanup.
2862 (ignore-errors
2863 (delete-file tmp-name1)
2864 (delete-file tmp-name2)
2865 (delete-file tmp-name3)))
2867 ;; Symbolic links could be nested.
2868 (unwind-protect
2869 (tramp--test-ignore-make-symbolic-link-error
2870 (make-directory tmp-name1)
2871 (should (file-directory-p tmp-name1))
2872 (let* ((tramp-test-temporary-file-directory
2873 (file-truename tmp-name1))
2874 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2875 (tmp-name3 tmp-name2)
2876 (number-nesting 15))
2877 (dotimes (_ number-nesting)
2878 (make-symbolic-link
2879 tmp-name3
2880 (setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
2881 (should
2882 (string-equal
2883 (file-truename tmp-name2)
2884 (file-truename tmp-name3)))
2885 (should-error
2886 (with-temp-buffer (insert-file-contents tmp-name2))
2887 :type tramp-file-missing)
2888 (should-error
2889 (with-temp-buffer (insert-file-contents tmp-name3))
2890 :type tramp-file-missing)
2891 ;; `directory-files' does not show symlinks to
2892 ;; non-existing targets in the "smb" case. So we remove
2893 ;; the symlinks manually.
2894 (while (stringp (setq tmp-name2 (file-symlink-p tmp-name3)))
2895 (delete-file tmp-name3)
2896 (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
2898 ;; Cleanup.
2899 (ignore-errors (delete-directory tmp-name1 'recursive)))
2901 ;; Detect cyclic symbolic links.
2902 (unwind-protect
2903 (tramp--test-ignore-make-symbolic-link-error
2904 (make-symbolic-link tmp-name2 tmp-name1)
2905 (should (file-symlink-p tmp-name1))
2906 (make-symbolic-link tmp-name1 tmp-name2)
2907 (should (file-symlink-p tmp-name2))
2908 (should-error (file-truename tmp-name1) :type 'file-error))
2910 ;; Cleanup.
2911 (ignore-errors
2912 (delete-file tmp-name1)
2913 (delete-file tmp-name2)))
2915 ;; `file-truename' shall preserve trailing link of directories.
2916 (unless (file-symlink-p tramp-test-temporary-file-directory)
2917 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
2918 (dir2 (file-name-as-directory dir1)))
2919 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
2920 (should
2921 (string-equal (file-truename dir2) (expand-file-name dir2))))))))
2923 (ert-deftest tramp-test22-file-times ()
2924 "Check `set-file-times' and `file-newer-than-file-p'."
2925 (skip-unless (tramp--test-enabled))
2926 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2928 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2929 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2930 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2931 (tmp-name3 (tramp--test-make-temp-name nil quoted)))
2932 (unwind-protect
2933 (progn
2934 (write-region "foo" nil tmp-name1)
2935 (should (file-exists-p tmp-name1))
2936 (should (consp (nth 5 (file-attributes tmp-name1))))
2937 ;; '(0 0) means don't know, and will be replaced by
2938 ;; `current-time'. Therefore, we use '(0 1). We skip the
2939 ;; test, if the remote handler is not able to set the
2940 ;; correct time.
2941 (skip-unless (set-file-times tmp-name1 '(0 1)))
2942 ;; Dumb remote shells without perl(1) or stat(1) are not
2943 ;; able to return the date correctly. They say "don't know".
2944 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
2945 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
2946 (write-region "bla" nil tmp-name2)
2947 (should (file-exists-p tmp-name2))
2948 (should (file-newer-than-file-p tmp-name2 tmp-name1))
2949 ;; `tmp-name3' does not exist.
2950 (should (file-newer-than-file-p tmp-name2 tmp-name3))
2951 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
2953 ;; Cleanup.
2954 (ignore-errors
2955 (delete-file tmp-name1)
2956 (delete-file tmp-name2))))))
2958 (ert-deftest tramp-test23-visited-file-modtime ()
2959 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
2960 (skip-unless (tramp--test-enabled))
2962 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2963 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2964 (unwind-protect
2965 (progn
2966 (write-region "foo" nil tmp-name)
2967 (should (file-exists-p tmp-name))
2968 (with-temp-buffer
2969 (insert-file-contents tmp-name)
2970 (should (verify-visited-file-modtime))
2971 (set-visited-file-modtime '(0 1))
2972 (should (verify-visited-file-modtime))
2973 (should (equal (visited-file-modtime) '(0 1 0 0)))))
2975 ;; Cleanup.
2976 (ignore-errors (delete-file tmp-name))))))
2978 ;; This test is inspired by Bug#29149.
2979 (ert-deftest tramp-test24-file-acl ()
2980 "Check that `file-acl' and `set-file-acl' work proper."
2981 (skip-unless (tramp--test-enabled))
2982 (skip-unless (file-acl tramp-test-temporary-file-directory))
2984 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
2985 (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p))
2986 '(nil t) '(nil)))
2987 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2988 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2989 (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
2990 ;; Both files are remote.
2991 (unwind-protect
2992 (progn
2993 ;; Two files with same ACLs.
2994 (write-region "foo" nil tmp-name1)
2995 (should (file-exists-p tmp-name1))
2996 (should (file-acl tmp-name1))
2997 (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
2998 (should (file-acl tmp-name2))
2999 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
3000 ;; Different permissions mean different ACLs.
3001 (when (not (tramp--test-windows-nt-or-smb-p))
3002 (set-file-modes tmp-name1 #o777)
3003 (set-file-modes tmp-name2 #o444)
3004 (should-not
3005 (string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
3006 ;; Copy ACL. Not all remote handlers support it, so we test.
3007 (when (set-file-acl tmp-name2 (file-acl tmp-name1))
3008 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
3009 ;; An invalid ACL does not harm.
3010 (should-not (set-file-acl tmp-name2 "foo")))
3012 ;; Cleanup.
3013 (ignore-errors (delete-file tmp-name1))
3014 (ignore-errors (delete-file tmp-name2)))
3016 ;; Remote and local file.
3017 (unwind-protect
3018 (when (and (file-acl temporary-file-directory)
3019 (not (tramp--test-windows-nt-or-smb-p)))
3020 ;; Two files with same ACLs.
3021 (write-region "foo" nil tmp-name1)
3022 (should (file-exists-p tmp-name1))
3023 (should (file-acl tmp-name1))
3024 (copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions)
3025 (should (file-acl tmp-name3))
3026 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
3027 ;; Different permissions mean different ACLs.
3028 (set-file-modes tmp-name1 #o777)
3029 (set-file-modes tmp-name3 #o444)
3030 (should-not
3031 (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
3032 ;; Copy ACL. Since we don't know whether Emacs is built
3033 ;; with local ACL support, we must check it.
3034 (when (set-file-acl tmp-name3 (file-acl tmp-name1))
3035 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
3037 ;; Two files with same ACLs.
3038 (delete-file tmp-name1)
3039 (copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions)
3040 (should (file-acl tmp-name1))
3041 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
3042 ;; Different permissions mean different ACLs.
3043 (set-file-modes tmp-name1 #o777)
3044 (set-file-modes tmp-name3 #o444)
3045 (should-not
3046 (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
3047 ;; Copy ACL.
3048 (set-file-acl tmp-name1 (file-acl tmp-name3))
3049 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
3051 ;; Cleanup.
3052 (ignore-errors (delete-file tmp-name1))
3053 (ignore-errors (delete-file tmp-name3))))))
3055 (ert-deftest tramp-test25-file-selinux ()
3056 "Check `file-selinux-context' and `set-file-selinux-context'."
3057 (skip-unless (tramp--test-enabled))
3058 (skip-unless
3059 (not (equal (file-selinux-context tramp-test-temporary-file-directory)
3060 '(nil nil nil nil))))
3062 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
3063 (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p))
3064 '(nil t) '(nil)))
3065 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3066 (tmp-name2 (tramp--test-make-temp-name nil quoted))
3067 (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
3068 ;; Both files are remote.
3069 (unwind-protect
3070 (progn
3071 ;; Two files with same SELinux context.
3072 (write-region "foo" nil tmp-name1)
3073 (should (file-exists-p tmp-name1))
3074 (should (file-selinux-context tmp-name1))
3075 (copy-file tmp-name1 tmp-name2)
3076 (should (file-selinux-context tmp-name2))
3077 (should
3078 (equal
3079 (file-selinux-context tmp-name1)
3080 (file-selinux-context tmp-name2)))
3081 ;; Check different SELinux context. We cannot support
3082 ;; different ranges in this test; let's assume the most
3083 ;; likely one.
3084 (let ((context (file-selinux-context tmp-name1)))
3085 (when (and (string-equal (nth 3 context) "s0")
3086 (setcar (nthcdr 3 context) "s0:c0")
3087 (set-file-selinux-context tmp-name1 context))
3088 (should-not
3089 (equal
3090 (file-selinux-context tmp-name1)
3091 (file-selinux-context tmp-name2)))))
3092 ;; Copy SELinux context.
3093 (should
3094 (set-file-selinux-context
3095 tmp-name2 (file-selinux-context tmp-name1)))
3096 (should
3097 (equal
3098 (file-selinux-context tmp-name1)
3099 (file-selinux-context tmp-name2)))
3100 ;; An invalid SELinux context does not harm.
3101 (should-not (set-file-selinux-context tmp-name2 "foo")))
3103 ;; Cleanup.
3104 (ignore-errors (delete-file tmp-name1))
3105 (ignore-errors (delete-file tmp-name2)))
3107 ;; Remote and local file.
3108 (unwind-protect
3109 (when (and (not
3110 (or (equal (file-selinux-context temporary-file-directory)
3111 '(nil nil nil nil))
3112 (tramp--test-windows-nt-or-smb-p)))
3113 ;; Both users shall use the same SELinux context.
3114 (string-equal
3115 (let ((default-directory temporary-file-directory))
3116 (shell-command-to-string "id -Z"))
3117 (let ((default-directory
3118 tramp-test-temporary-file-directory))
3119 (shell-command-to-string "id -Z"))))
3121 ;; Two files with same SELinux context.
3122 (write-region "foo" nil tmp-name1)
3123 (should (file-exists-p tmp-name1))
3124 (should (file-selinux-context tmp-name1))
3125 (copy-file tmp-name1 tmp-name3)
3126 (should (file-selinux-context tmp-name3))
3127 ;; We cannot expect that copying over file system
3128 ;; boundaries keeps SELinux context. So we copy it
3129 ;; explicitly.
3130 (should
3131 (set-file-selinux-context
3132 tmp-name3 (file-selinux-context tmp-name1)))
3133 (should
3134 (equal
3135 (file-selinux-context tmp-name1)
3136 (file-selinux-context tmp-name3)))
3137 ;; Check different SELinux context. We cannot support
3138 ;; different ranges in this test; let's assume the most
3139 ;; likely one.
3140 (let ((context (file-selinux-context tmp-name1)))
3141 (when (and (string-equal (nth 3 context) "s0")
3142 (setcar (nthcdr 3 context) "s0:c0")
3143 (set-file-selinux-context tmp-name1 context))
3144 (should-not
3145 (equal
3146 (file-selinux-context tmp-name1)
3147 (file-selinux-context tmp-name3)))))
3148 ;; Copy SELinux context.
3149 (should
3150 (set-file-selinux-context
3151 tmp-name3 (file-selinux-context tmp-name1)))
3152 (should
3153 (equal
3154 (file-selinux-context tmp-name1)
3155 (file-selinux-context tmp-name3)))
3157 ;; Two files with same SELinux context.
3158 (delete-file tmp-name1)
3159 (copy-file tmp-name3 tmp-name1)
3160 (should (file-selinux-context tmp-name1))
3161 ;; We cannot expect that copying over file system
3162 ;; boundaries keeps SELinux context. So we copy it
3163 ;; explicitly.
3164 (should
3165 (set-file-selinux-context
3166 tmp-name1 (file-selinux-context tmp-name3)))
3167 (should
3168 (equal
3169 (file-selinux-context tmp-name1)
3170 (file-selinux-context tmp-name3)))
3171 ;; Check different SELinux context. We cannot support
3172 ;; different ranges in this test; let's assume the most
3173 ;; likely one.
3174 (let ((context (file-selinux-context tmp-name3)))
3175 (when (and (string-equal (nth 3 context) "s0")
3176 (setcar (nthcdr 3 context) "s0:c0")
3177 (set-file-selinux-context tmp-name3 context))
3178 (should-not
3179 (equal
3180 (file-selinux-context tmp-name1)
3181 (file-selinux-context tmp-name3)))))
3182 ;; Copy SELinux context.
3183 (should
3184 (set-file-selinux-context
3185 tmp-name1 (file-selinux-context tmp-name3)))
3186 (should
3187 (equal
3188 (file-selinux-context tmp-name1)
3189 (file-selinux-context tmp-name3))))
3191 ;; Cleanup.
3192 (ignore-errors (delete-file tmp-name1))
3193 (ignore-errors (delete-file tmp-name3))))))
3195 (ert-deftest tramp-test26-file-name-completion ()
3196 "Check `file-name-completion' and `file-name-all-completions'."
3197 (skip-unless (tramp--test-enabled))
3199 ;; Method and host name in completion mode. This kind of completion
3200 ;; does not work on MS Windows.
3201 (when (not (memq system-type '(cygwin windows-nt)))
3202 (let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
3203 (host (file-remote-p tramp-test-temporary-file-directory 'host))
3204 (orig-syntax tramp-syntax))
3205 (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
3206 (setq host (match-string 1 host)))
3208 (unwind-protect
3209 (dolist
3210 (syntax
3211 (if tramp--test-expensive-test
3212 (tramp-syntax-values) `(,orig-syntax)))
3213 (tramp-change-syntax syntax)
3214 (let ;; This is needed for the `simplified' syntax.
3215 ((method-marker
3216 (if (zerop (length tramp-method-regexp))
3217 "" tramp-default-method-marker))
3218 ;; This is needed for the `separate' syntax.
3219 (prefix-format (substring tramp-prefix-format 1)))
3220 ;; Complete method name.
3221 (unless (or (zerop (length method))
3222 (zerop (length tramp-method-regexp)))
3223 (should
3224 (member
3225 (concat prefix-format method tramp-postfix-method-format)
3226 (file-name-all-completions
3227 (concat prefix-format (substring method 0 1)) "/"))))
3228 ;; Complete host name for default method. With gvfs
3229 ;; based methods, host name will be determined as
3230 ;; host.local, so we omit the test.
3231 (let ((tramp-default-method (or method tramp-default-method)))
3232 (unless (or (zerop (length host))
3233 (tramp--test-gvfs-p tramp-default-method))
3234 (should
3235 (member
3236 (concat
3237 prefix-format method-marker tramp-postfix-method-format
3238 host tramp-postfix-host-format)
3239 (file-name-all-completions
3240 (concat
3241 prefix-format method-marker tramp-postfix-method-format
3242 (substring host 0 1))
3243 "/")))))
3244 ;; Complete host name.
3245 (unless (or (zerop (length method))
3246 (zerop (length tramp-method-regexp))
3247 (zerop (length host))
3248 (tramp--test-gvfs-p method))
3249 (should
3250 (member
3251 (concat
3252 prefix-format method tramp-postfix-method-format
3253 host tramp-postfix-host-format)
3254 (file-name-all-completions
3255 (concat prefix-format method tramp-postfix-method-format)
3256 "/"))))))
3258 ;; Cleanup.
3259 (tramp-change-syntax orig-syntax))))
3261 (dolist (n-e '(nil t))
3262 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3263 (let ((non-essential n-e)
3264 (tmp-name (tramp--test-make-temp-name nil quoted)))
3266 (unwind-protect
3267 (progn
3268 ;; Local files.
3269 (make-directory tmp-name)
3270 (should (file-directory-p tmp-name))
3271 (write-region "foo" nil (expand-file-name "foo" tmp-name))
3272 (should (file-exists-p (expand-file-name "foo" tmp-name)))
3273 (write-region "bar" nil (expand-file-name "bold" tmp-name))
3274 (should (file-exists-p (expand-file-name "bold" tmp-name)))
3275 (make-directory (expand-file-name "boz" tmp-name))
3276 (should (file-directory-p (expand-file-name "boz" tmp-name)))
3277 (should (equal (file-name-completion "fo" tmp-name) "foo"))
3278 (should (equal (file-name-completion "foo" tmp-name) t))
3279 (should (equal (file-name-completion "b" tmp-name) "bo"))
3280 (should-not (file-name-completion "a" tmp-name))
3281 (should
3282 (equal
3283 (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
3284 (should
3285 (equal (file-name-all-completions "fo" tmp-name) '("foo")))
3286 (should
3287 (equal
3288 (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
3289 '("bold" "boz/")))
3290 (should-not (file-name-all-completions "a" tmp-name))
3291 ;; `completion-regexp-list' restricts the completion to
3292 ;; files which match all expressions in this list.
3293 (let ((completion-regexp-list
3294 `(,directory-files-no-dot-files-regexp "b")))
3295 (should
3296 (equal (file-name-completion "" tmp-name) "bo"))
3297 (should
3298 (equal
3299 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
3300 '("bold" "boz/"))))
3301 ;; `file-name-completion' ignores file names that end in
3302 ;; any string in `completion-ignored-extensions'.
3303 (let ((completion-ignored-extensions '(".ext")))
3304 (write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
3305 (should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
3306 (should (equal (file-name-completion "fo" tmp-name) "foo"))
3307 (should (equal (file-name-completion "foo" tmp-name) t))
3308 (should
3309 (equal (file-name-completion "foo." tmp-name) "foo.ext"))
3310 (should (equal (file-name-completion "foo.ext" tmp-name) t))
3311 ;; `file-name-all-completions' is not affected.
3312 (should
3313 (equal
3314 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
3315 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
3317 ;; Cleanup.
3318 (ignore-errors (delete-directory tmp-name 'recursive)))))))
3320 (ert-deftest tramp-test27-load ()
3321 "Check `load'."
3322 (skip-unless (tramp--test-enabled))
3324 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3325 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
3326 (unwind-protect
3327 (progn
3328 (load tmp-name 'noerror 'nomessage)
3329 (should-not (featurep 'tramp-test-load))
3330 (write-region "(provide 'tramp-test-load)" nil tmp-name)
3331 ;; `load' in lread.c does not pass `must-suffix'. Why?
3332 ;;(should-error
3333 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
3334 ;; :type 'file-error)
3335 (load tmp-name nil 'nomessage 'nosuffix)
3336 (should (featurep 'tramp-test-load)))
3338 ;; Cleanup.
3339 (ignore-errors
3340 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
3341 (delete-file tmp-name))))))
3343 (ert-deftest tramp-test28-process-file ()
3344 "Check `process-file'."
3345 :tags '(:expensive-test)
3346 (skip-unless (tramp--test-enabled))
3347 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3349 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3350 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
3351 (fnnd (file-name-nondirectory tmp-name))
3352 (default-directory tramp-test-temporary-file-directory)
3353 kill-buffer-query-functions)
3354 (unwind-protect
3355 (progn
3356 ;; We cannot use "/bin/true" and "/bin/false"; those paths
3357 ;; do not exist on hydra.
3358 (should (zerop (process-file "true")))
3359 (should-not (zerop (process-file "false")))
3360 (should-not (zerop (process-file "binary-does-not-exist")))
3361 (with-temp-buffer
3362 (write-region "foo" nil tmp-name)
3363 (should (file-exists-p tmp-name))
3364 (should (zerop (process-file "ls" nil t nil fnnd)))
3365 ;; `ls' could produce colorized output.
3366 (goto-char (point-min))
3367 (while
3368 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3369 (replace-match "" nil nil))
3370 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
3371 (should-not (get-buffer-window (current-buffer) t))
3373 ;; Second run. The output must be appended.
3374 (goto-char (point-max))
3375 (should (zerop (process-file "ls" nil t t fnnd)))
3376 ;; `ls' could produce colorized output.
3377 (goto-char (point-min))
3378 (while
3379 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3380 (replace-match "" nil nil))
3381 (should
3382 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
3383 ;; A non-nil DISPLAY must not raise the buffer.
3384 (should-not (get-buffer-window (current-buffer) t))))
3386 ;; Cleanup.
3387 (ignore-errors (delete-file tmp-name))))))
3389 (ert-deftest tramp-test29-start-file-process ()
3390 "Check `start-file-process'."
3391 :tags '(:expensive-test)
3392 (skip-unless (tramp--test-enabled))
3393 (skip-unless (tramp--test-sh-p))
3395 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3396 (let ((default-directory tramp-test-temporary-file-directory)
3397 (tmp-name (tramp--test-make-temp-name nil quoted))
3398 kill-buffer-query-functions proc)
3399 (unwind-protect
3400 (with-temp-buffer
3401 (setq proc (start-file-process "test1" (current-buffer) "cat"))
3402 (should (processp proc))
3403 (should (equal (process-status proc) 'run))
3404 (process-send-string proc "foo")
3405 (process-send-eof proc)
3406 ;; Read output.
3407 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3408 (while (< (- (point-max) (point-min)) (length "foo"))
3409 (accept-process-output proc 0.1)))
3410 (should (string-equal (buffer-string) "foo")))
3412 ;; Cleanup.
3413 (ignore-errors (delete-process proc)))
3415 (unwind-protect
3416 (with-temp-buffer
3417 (write-region "foo" nil tmp-name)
3418 (should (file-exists-p tmp-name))
3419 (setq proc
3420 (start-file-process
3421 "test2" (current-buffer)
3422 "cat" (file-name-nondirectory tmp-name)))
3423 (should (processp proc))
3424 ;; Read output.
3425 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3426 (while (< (- (point-max) (point-min)) (length "foo"))
3427 (accept-process-output proc 0.1)))
3428 (should (string-equal (buffer-string) "foo")))
3430 ;; Cleanup.
3431 (ignore-errors
3432 (delete-process proc)
3433 (delete-file tmp-name)))
3435 (unwind-protect
3436 (with-temp-buffer
3437 (setq proc (start-file-process "test3" (current-buffer) "cat"))
3438 (should (processp proc))
3439 (should (equal (process-status proc) 'run))
3440 (set-process-filter
3441 proc
3442 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
3443 (process-send-string proc "foo")
3444 (process-send-eof proc)
3445 ;; Read output.
3446 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3447 (while (< (- (point-max) (point-min)) (length "foo"))
3448 (accept-process-output proc 0.1)))
3449 (should (string-equal (buffer-string) "foo")))
3451 ;; Cleanup.
3452 (ignore-errors (delete-process proc))))))
3454 (ert-deftest tramp-test30-interrupt-process ()
3455 "Check `interrupt-process'."
3456 :tags '(:expensive-test)
3457 (skip-unless (tramp--test-enabled))
3458 (skip-unless (tramp--test-sh-p))
3459 ;; Since Emacs 26.1.
3460 (skip-unless (boundp 'interrupt-process-functions))
3462 (let ((default-directory tramp-test-temporary-file-directory)
3463 kill-buffer-query-functions proc)
3464 (unwind-protect
3465 (with-temp-buffer
3466 (setq proc (start-file-process "test" (current-buffer) "sleep" "10"))
3467 (should (processp proc))
3468 (should (process-live-p proc))
3469 (should (equal (process-status proc) 'run))
3470 (should (numberp (process-get proc 'remote-pid)))
3471 (should (interrupt-process proc))
3472 ;; Let the process accept the interrupt.
3473 (accept-process-output proc 1 nil 0)
3474 (should-not (process-live-p proc))
3475 ;; An interrupted process cannot be interrupted, again.
3476 (should-error (interrupt-process proc) :type 'error))
3478 ;; Cleanup.
3479 (ignore-errors (delete-process proc)))))
3481 (ert-deftest tramp-test31-shell-command ()
3482 "Check `shell-command'."
3483 :tags '(:expensive-test)
3484 (skip-unless (tramp--test-enabled))
3485 (skip-unless (tramp--test-sh-p))
3487 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3488 (let ((tmp-name (tramp--test-make-temp-name nil quoted))
3489 (default-directory tramp-test-temporary-file-directory)
3490 ;; Suppress nasty messages.
3491 (inhibit-message t)
3492 kill-buffer-query-functions)
3493 (unwind-protect
3494 (with-temp-buffer
3495 (write-region "foo" nil tmp-name)
3496 (should (file-exists-p tmp-name))
3497 (shell-command
3498 (format "ls %s" (file-name-nondirectory tmp-name))
3499 (current-buffer))
3500 ;; `ls' could produce colorized output.
3501 (goto-char (point-min))
3502 (while
3503 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3504 (replace-match "" nil nil))
3505 (should
3506 (string-equal
3507 (format "%s\n" (file-name-nondirectory tmp-name))
3508 (buffer-string))))
3510 ;; Cleanup.
3511 (ignore-errors (delete-file tmp-name)))
3513 (unwind-protect
3514 (with-temp-buffer
3515 (write-region "foo" nil tmp-name)
3516 (should (file-exists-p tmp-name))
3517 (async-shell-command
3518 (format "ls %s" (file-name-nondirectory tmp-name))
3519 (current-buffer))
3520 ;; Read output.
3521 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3522 (while (< (- (point-max) (point-min))
3523 (1+ (length (file-name-nondirectory tmp-name))))
3524 (accept-process-output
3525 (get-buffer-process (current-buffer)) 0.1)))
3526 ;; `ls' could produce colorized output.
3527 (goto-char (point-min))
3528 (while
3529 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3530 (replace-match "" nil nil))
3531 ;; There might be a nasty "Process *Async Shell* finished" message.
3532 (goto-char (point-min))
3533 (forward-line)
3534 (narrow-to-region (point-min) (point))
3535 (should
3536 (string-equal
3537 (format "%s\n" (file-name-nondirectory tmp-name))
3538 (buffer-string))))
3540 ;; Cleanup.
3541 (ignore-errors (delete-file tmp-name)))
3543 (unwind-protect
3544 (with-temp-buffer
3545 (write-region "foo" nil tmp-name)
3546 (should (file-exists-p tmp-name))
3547 (async-shell-command "read line; ls $line" (current-buffer))
3548 (process-send-string
3549 (get-buffer-process (current-buffer))
3550 (format "%s\n" (file-name-nondirectory tmp-name)))
3551 ;; Read output.
3552 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3553 (while (< (- (point-max) (point-min))
3554 (1+ (length (file-name-nondirectory tmp-name))))
3555 (accept-process-output
3556 (get-buffer-process (current-buffer)) 0.1)))
3557 ;; `ls' could produce colorized output.
3558 (goto-char (point-min))
3559 (while
3560 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3561 (replace-match "" nil nil))
3562 ;; There might be a nasty "Process *Async Shell* finished" message.
3563 (goto-char (point-min))
3564 (forward-line)
3565 (narrow-to-region (point-min) (point))
3566 (should
3567 (string-equal
3568 (format "%s\n" (file-name-nondirectory tmp-name))
3569 (buffer-string))))
3571 ;; Cleanup.
3572 (ignore-errors (delete-file tmp-name))))))
3574 (defun tramp--test-shell-command-to-string-asynchronously (command)
3575 "Like `shell-command-to-string', but for asynchronous processes."
3576 (with-temp-buffer
3577 (async-shell-command command (current-buffer))
3578 (with-timeout (10)
3579 (while (get-buffer-process (current-buffer))
3580 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3581 (accept-process-output nil 0.1)
3582 (buffer-substring-no-properties (point-min) (point-max))))
3584 ;; This test is inspired by Bug#23952.
3585 (ert-deftest tramp-test32-environment-variables ()
3586 "Check that remote processes set / unset environment variables properly."
3587 :tags '(:expensive-test)
3588 (skip-unless (tramp--test-enabled))
3589 (skip-unless (tramp--test-sh-p))
3591 (dolist (this-shell-command-to-string
3592 '(;; Synchronously.
3593 shell-command-to-string
3594 ;; Asynchronously.
3595 tramp--test-shell-command-to-string-asynchronously))
3597 (let ((default-directory tramp-test-temporary-file-directory)
3598 (shell-file-name "/bin/sh")
3599 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3600 kill-buffer-query-functions)
3602 (unwind-protect
3603 ;; Set a value.
3604 (let ((process-environment
3605 (cons (concat envvar "=foo") process-environment)))
3606 ;; Default value.
3607 (should
3608 (string-match
3609 "foo"
3610 (funcall
3611 this-shell-command-to-string
3612 (format "echo -n ${%s:?bla}" envvar))))))
3614 (unwind-protect
3615 ;; Set the empty value.
3616 (let ((process-environment
3617 (cons (concat envvar "=") process-environment)))
3618 ;; Value is null.
3619 (should
3620 (string-match
3621 "bla"
3622 (funcall
3623 this-shell-command-to-string
3624 (format "echo -n ${%s:?bla}" envvar))))
3625 ;; Variable is set.
3626 (should
3627 (string-match
3628 (regexp-quote envvar)
3629 (funcall this-shell-command-to-string "set")))))
3631 ;; We force a reconnect, in order to have a clean environment.
3632 (tramp-cleanup-connection
3633 (tramp-dissect-file-name tramp-test-temporary-file-directory)
3634 'keep-debug 'keep-password)
3635 (unwind-protect
3636 ;; Unset the variable.
3637 (let ((tramp-remote-process-environment
3638 (cons (concat envvar "=foo")
3639 tramp-remote-process-environment)))
3640 ;; Set the initial value, we want to unset below.
3641 (should
3642 (string-match
3643 "foo"
3644 (funcall
3645 this-shell-command-to-string
3646 (format "echo -n ${%s:?bla}" envvar))))
3647 (let ((process-environment
3648 (cons envvar process-environment)))
3649 ;; Variable is unset.
3650 (should
3651 (string-match
3652 "bla"
3653 (funcall
3654 this-shell-command-to-string
3655 (format "echo -n ${%s:?bla}" envvar))))
3656 ;; Variable is unset.
3657 (should-not
3658 (string-match
3659 (regexp-quote envvar)
3660 (funcall this-shell-command-to-string "set")))))))))
3662 ;; This test is inspired by Bug#27009.
3663 (ert-deftest tramp-test32-environment-variables-and-port-numbers ()
3664 "Check that two connections with separate ports are different."
3665 (skip-unless (tramp--test-enabled))
3666 ;; We test it only for the mock-up connection; otherwise there might
3667 ;; be problems with the used ports.
3668 (skip-unless (and (eq tramp-syntax 'default)
3669 (tramp--test-mock-p)))
3671 ;; We force a reconnect, in order to have a clean environment.
3672 (dolist (dir `(,tramp-test-temporary-file-directory
3673 "/mock:localhost#11111:" "/mock:localhost#22222:"))
3674 (tramp-cleanup-connection
3675 (tramp-dissect-file-name dir) 'keep-debug 'keep-password))
3677 (unwind-protect
3678 (dolist (port '(11111 22222))
3679 (let* ((default-directory
3680 (format "/mock:localhost#%d:%s" port temporary-file-directory))
3681 (shell-file-name "/bin/sh")
3682 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3683 ;; We cannot use `process-environment', because this
3684 ;; would be applied in `process-file'.
3685 (tramp-remote-process-environment
3686 (cons
3687 (format "%s=%d" envvar port)
3688 tramp-remote-process-environment)))
3689 (should
3690 (string-match
3691 (number-to-string port)
3692 (shell-command-to-string (format "echo -n $%s" envvar))))))
3694 ;; Cleanup.
3695 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3696 (tramp-cleanup-connection (tramp-dissect-file-name dir)))))
3698 ;; The functions were introduced in Emacs 26.1.
3699 (ert-deftest tramp-test33-explicit-shell-file-name ()
3700 "Check that connection-local `explicit-shell-file-name' is set."
3701 :tags '(:expensive-test)
3702 (skip-unless (tramp--test-enabled))
3703 (skip-unless (tramp--test-sh-p))
3704 ;; Since Emacs 26.1.
3705 (skip-unless (and (fboundp 'connection-local-set-profile-variables)
3706 (fboundp 'connection-local-set-profiles)))
3708 ;; `connection-local-set-profile-variables' and
3709 ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't
3710 ;; want to see compiler warnings for older Emacsen.
3711 (let ((default-directory tramp-test-temporary-file-directory)
3712 explicit-shell-file-name kill-buffer-query-functions)
3713 (unwind-protect
3714 (progn
3715 ;; `shell-mode' would ruin our test, because it deletes all
3716 ;; buffer local variables.
3717 (put 'explicit-shell-file-name 'permanent-local t)
3718 ;; Declare connection-local variable `explicit-shell-file-name'.
3719 (with-no-warnings
3720 (connection-local-set-profile-variables
3721 'remote-sh
3722 '((explicit-shell-file-name . "/bin/sh")
3723 (explicit-sh-args . ("-i"))))
3724 (connection-local-set-profiles
3725 `(:application tramp
3726 :protocol ,(file-remote-p default-directory 'method)
3727 :user ,(file-remote-p default-directory 'user)
3728 :machine ,(file-remote-p default-directory 'host))
3729 'remote-sh))
3731 ;; Run interactive shell. Since the default directory is
3732 ;; remote, `explicit-shell-file-name' shall be set in order
3733 ;; to avoid a question.
3734 (with-current-buffer (get-buffer-create "*shell*")
3735 (ignore-errors (kill-process (current-buffer)))
3736 (should-not explicit-shell-file-name)
3737 (call-interactively 'shell)
3738 (should explicit-shell-file-name)))
3740 (put 'explicit-shell-file-name 'permanent-local nil)
3741 (kill-buffer "*shell*"))))
3743 (ert-deftest tramp-test34-vc-registered ()
3744 "Check `vc-registered'."
3745 :tags '(:expensive-test)
3746 (skip-unless (tramp--test-enabled))
3747 (skip-unless (tramp--test-sh-p))
3749 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3750 (let* ((default-directory tramp-test-temporary-file-directory)
3751 (tmp-name1 (tramp--test-make-temp-name nil quoted))
3752 (tmp-name2 (expand-file-name "foo" tmp-name1))
3753 (tramp-remote-process-environment tramp-remote-process-environment)
3754 (vc-handled-backends
3755 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3756 (cond
3757 ((tramp-find-executable
3758 v vc-git-program (tramp-get-remote-path v))
3759 '(Git))
3760 ((tramp-find-executable
3761 v vc-hg-program (tramp-get-remote-path v))
3762 '(Hg))
3763 ((tramp-find-executable
3764 v vc-bzr-program (tramp-get-remote-path v))
3765 (setq tramp-remote-process-environment
3766 (cons (format "BZR_HOME=%s"
3767 (file-remote-p tmp-name1 'localname))
3768 tramp-remote-process-environment))
3769 ;; We must force a reconnect, in order to activate $BZR_HOME.
3770 (tramp-cleanup-connection
3771 (tramp-dissect-file-name tramp-test-temporary-file-directory)
3772 'keep-debug 'keep-password)
3773 '(Bzr))
3774 (t nil))))
3775 ;; Suppress nasty messages.
3776 (inhibit-message t))
3777 (skip-unless vc-handled-backends)
3778 (unless quoted (tramp--test-message "%s" vc-handled-backends))
3780 (unwind-protect
3781 (progn
3782 (make-directory tmp-name1)
3783 (write-region "foo" nil tmp-name2)
3784 (should (file-directory-p tmp-name1))
3785 (should (file-exists-p tmp-name2))
3786 (should-not (vc-registered tmp-name1))
3787 (should-not (vc-registered tmp-name2))
3789 (let ((default-directory tmp-name1))
3790 ;; Create empty repository, and register the file.
3791 ;; Sometimes, creation of repository fails (bzr!); we
3792 ;; skip the test then.
3793 (condition-case nil
3794 (vc-create-repo (car vc-handled-backends))
3795 (error (skip-unless nil)))
3796 ;; The structure of VC-FILESET is not documented. Let's
3797 ;; hope it won't change.
3798 (condition-case nil
3799 (vc-register
3800 (list (car vc-handled-backends)
3801 (list (file-name-nondirectory tmp-name2))))
3802 ;; `vc-register' has changed its arguments in Emacs
3803 ;; 25.1. Let's skip it for older Emacsen.
3804 (error (skip-unless (tramp--test-emacs25-p))))
3805 ;; vc-git uses an own process sentinel, Tramp's sentinel
3806 ;; for flushing the cache isn't used.
3807 (dired-uncache (concat (file-remote-p default-directory) "/"))
3808 (should (vc-registered (file-name-nondirectory tmp-name2)))))
3810 ;; Cleanup.
3811 (ignore-errors (delete-directory tmp-name1 'recursive))))))
3813 (ert-deftest tramp-test35-make-auto-save-file-name ()
3814 "Check `make-auto-save-file-name'."
3815 (skip-unless (tramp--test-enabled))
3817 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3818 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3819 (tmp-name2 (tramp--test-make-temp-name nil quoted)))
3821 (unwind-protect
3822 (progn
3823 ;; Use default `auto-save-file-name-transforms' mechanism.
3824 (let (tramp-auto-save-directory)
3825 (with-temp-buffer
3826 (setq buffer-file-name tmp-name1)
3827 (should
3828 (string-equal
3829 (make-auto-save-file-name)
3830 ;; This is taken from original `make-auto-save-file-name'.
3831 ;; We call `convert-standard-filename', because on
3832 ;; MS Windows the (local) colons must be replaced by
3833 ;; exclamation marks.
3834 (convert-standard-filename
3835 (expand-file-name
3836 (format
3837 "#%s#"
3838 (subst-char-in-string
3839 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3840 temporary-file-directory))))))
3842 ;; No mapping.
3843 (let (tramp-auto-save-directory auto-save-file-name-transforms)
3844 (with-temp-buffer
3845 (setq buffer-file-name tmp-name1)
3846 (should
3847 (string-equal
3848 (make-auto-save-file-name)
3849 (funcall
3850 (if quoted 'tramp-compat-file-name-quote 'identity)
3851 (expand-file-name
3852 (format "#%s#" (file-name-nondirectory tmp-name1))
3853 tramp-test-temporary-file-directory))))))
3855 ;; Use default `tramp-auto-save-directory' mechanism.
3856 (let ((tramp-auto-save-directory tmp-name2))
3857 (with-temp-buffer
3858 (setq buffer-file-name tmp-name1)
3859 (should
3860 (string-equal
3861 (make-auto-save-file-name)
3862 ;; This is taken from Tramp.
3863 (expand-file-name
3864 (format
3865 "#%s#"
3866 (tramp-subst-strs-in-string
3867 '(("_" . "|")
3868 ("/" . "_a")
3869 (":" . "_b")
3870 ("|" . "__")
3871 ("[" . "_l")
3872 ("]" . "_r"))
3873 (tramp-compat-file-name-unquote tmp-name1)))
3874 tmp-name2)))
3875 (should (file-directory-p tmp-name2))))
3877 ;; Relative file names shall work, too.
3878 (let ((tramp-auto-save-directory "."))
3879 (with-temp-buffer
3880 (setq buffer-file-name tmp-name1
3881 default-directory tmp-name2)
3882 (should
3883 (string-equal
3884 (make-auto-save-file-name)
3885 ;; This is taken from Tramp.
3886 (expand-file-name
3887 (format
3888 "#%s#"
3889 (tramp-subst-strs-in-string
3890 '(("_" . "|")
3891 ("/" . "_a")
3892 (":" . "_b")
3893 ("|" . "__")
3894 ("[" . "_l")
3895 ("]" . "_r"))
3896 (tramp-compat-file-name-unquote tmp-name1)))
3897 tmp-name2)))
3898 (should (file-directory-p tmp-name2)))))
3900 ;; Cleanup.
3901 (ignore-errors (delete-file tmp-name1))
3902 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3904 (ert-deftest tramp-test36-find-backup-file-name ()
3905 "Check `find-backup-file-name'."
3906 (skip-unless (tramp--test-enabled))
3908 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3909 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3910 (tmp-name2 (tramp--test-make-temp-name nil quoted))
3911 ;; These settings are not used by Tramp, so we ignore them.
3912 version-control delete-old-versions
3913 (kept-old-versions (default-toplevel-value 'kept-old-versions))
3914 (kept-new-versions (default-toplevel-value 'kept-new-versions)))
3916 (unwind-protect
3917 ;; Use default `backup-directory-alist' mechanism.
3918 (let (backup-directory-alist tramp-backup-directory-alist)
3919 (should
3920 (equal
3921 (find-backup-file-name tmp-name1)
3922 (list
3923 (funcall
3924 (if quoted 'tramp-compat-file-name-quote 'identity)
3925 (expand-file-name
3926 (format "%s~" (file-name-nondirectory tmp-name1))
3927 tramp-test-temporary-file-directory)))))))
3929 (unwind-protect
3930 ;; Map `backup-directory-alist'.
3931 (let ((backup-directory-alist `(("." . ,tmp-name2)))
3932 tramp-backup-directory-alist)
3933 (should
3934 (equal
3935 (find-backup-file-name tmp-name1)
3936 (list
3937 (funcall
3938 (if quoted 'tramp-compat-file-name-quote 'identity)
3939 (expand-file-name
3940 (format
3941 "%s~"
3942 ;; This is taken from `make-backup-file-name-1'. We
3943 ;; call `convert-standard-filename', because on MS
3944 ;; Windows the (local) colons must be replaced by
3945 ;; exclamation marks.
3946 (subst-char-in-string
3947 ?/ ?!
3948 (replace-regexp-in-string
3949 "!" "!!" (convert-standard-filename tmp-name1))))
3950 tmp-name2)))))
3951 ;; The backup directory is created.
3952 (should (file-directory-p tmp-name2)))
3954 ;; Cleanup.
3955 (ignore-errors (delete-directory tmp-name2 'recursive)))
3957 (unwind-protect
3958 ;; Map `tramp-backup-directory-alist'.
3959 (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
3960 backup-directory-alist)
3961 (should
3962 (equal
3963 (find-backup-file-name tmp-name1)
3964 (list
3965 (funcall
3966 (if quoted 'tramp-compat-file-name-quote 'identity)
3967 (expand-file-name
3968 (format
3969 "%s~"
3970 ;; This is taken from `make-backup-file-name-1'. We
3971 ;; call `convert-standard-filename', because on MS
3972 ;; Windows the (local) colons must be replaced by
3973 ;; exclamation marks.
3974 (subst-char-in-string
3975 ?/ ?!
3976 (replace-regexp-in-string
3977 "!" "!!" (convert-standard-filename tmp-name1))))
3978 tmp-name2)))))
3979 ;; The backup directory is created.
3980 (should (file-directory-p tmp-name2)))
3982 ;; Cleanup.
3983 (ignore-errors (delete-directory tmp-name2 'recursive)))
3985 (unwind-protect
3986 ;; Map `tramp-backup-directory-alist' with local file name.
3987 (let ((tramp-backup-directory-alist
3988 `(("." . ,(file-remote-p tmp-name2 'localname))))
3989 backup-directory-alist)
3990 (should
3991 (equal
3992 (find-backup-file-name tmp-name1)
3993 (list
3994 (funcall
3995 (if quoted 'tramp-compat-file-name-quote 'identity)
3996 (expand-file-name
3997 (format
3998 "%s~"
3999 ;; This is taken from `make-backup-file-name-1'. We
4000 ;; call `convert-standard-filename', because on MS
4001 ;; Windows the (local) colons must be replaced by
4002 ;; exclamation marks.
4003 (subst-char-in-string
4004 ?/ ?!
4005 (replace-regexp-in-string
4006 "!" "!!" (convert-standard-filename tmp-name1))))
4007 tmp-name2)))))
4008 ;; The backup directory is created.
4009 (should (file-directory-p tmp-name2)))
4011 ;; Cleanup.
4012 (ignore-errors (delete-directory tmp-name2 'recursive))))))
4014 ;; The functions were introduced in Emacs 26.1.
4015 (ert-deftest tramp-test37-make-nearby-temp-file ()
4016 "Check `make-nearby-temp-file' and `temporary-file-directory'."
4017 (skip-unless (tramp--test-enabled))
4018 ;; Since Emacs 26.1.
4019 (skip-unless
4020 (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
4022 ;; `make-nearby-temp-file' and `temporary-file-directory' exists
4023 ;; since Emacs 26.1. We don't want to see compiler warnings for
4024 ;; older Emacsen.
4025 (let ((default-directory tramp-test-temporary-file-directory)
4026 tmp-file)
4027 ;; The remote host shall know a temporary file directory.
4028 (should (stringp (with-no-warnings (temporary-file-directory))))
4029 (should
4030 (string-equal
4031 (file-remote-p default-directory)
4032 (file-remote-p (with-no-warnings (temporary-file-directory)))))
4034 ;; The temporary file shall be located on the remote host.
4035 (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test")))
4036 (should (file-exists-p tmp-file))
4037 (should (file-regular-p tmp-file))
4038 (should
4039 (string-equal
4040 (file-remote-p default-directory)
4041 (file-remote-p tmp-file)))
4042 (delete-file tmp-file)
4043 (should-not (file-exists-p tmp-file))
4045 (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test" 'dir)))
4046 (should (file-exists-p tmp-file))
4047 (should (file-directory-p tmp-file))
4048 (delete-directory tmp-file)
4049 (should-not (file-exists-p tmp-file))))
4051 (defun tramp--test-emacs25-p ()
4052 "Check for Emacs version >= 25.1.
4053 Some semantics has been changed for there, w/o new functions or
4054 variables, so we check the Emacs version directly."
4055 (>= emacs-major-version 25))
4057 (defun tramp--test-emacs26-p ()
4058 "Check for Emacs version >= 26.1.
4059 Some semantics has been changed for there, w/o new functions or
4060 variables, so we check the Emacs version directly."
4061 (>= emacs-major-version 26))
4063 (defun tramp--test-emacs27-p ()
4064 "Check for Emacs version >= 27.1.
4065 Some semantics has been changed for there, w/o new functions or
4066 variables, so we check the Emacs version directly."
4067 (>= emacs-major-version 27))
4069 (defun tramp--test-adb-p ()
4070 "Check, whether the remote host runs Android.
4071 This requires restrictions of file name syntax."
4072 (tramp-adb-file-name-p tramp-test-temporary-file-directory))
4074 (defun tramp--test-docker-p ()
4075 "Check, whether the docker method is used.
4076 This does not support some special file names."
4077 (string-equal
4078 "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
4080 (defun tramp--test-ftp-p ()
4081 "Check, whether an FTP-like method is used.
4082 This does not support globbing characters in file names (yet)."
4083 ;; Globbing characters are ??, ?* and ?\[.
4084 (string-match
4085 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
4087 (defun tramp--test-gvfs-p (&optional method)
4088 "Check, whether the remote host runs a GVFS based method.
4089 This requires restrictions of file name syntax."
4090 (or (member method tramp-gvfs-methods)
4091 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)))
4093 (defun tramp--test-hpux-p ()
4094 "Check, whether the remote host runs HP-UX.
4095 Several special characters do not work properly there."
4096 ;; We must refill the cache. `file-truename' does it.
4097 (with-parsed-tramp-file-name
4098 (file-truename tramp-test-temporary-file-directory) nil
4099 (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
4101 (defun tramp--test-mock-p ()
4102 "Check, whether the mock method is used.
4103 This does not support external Emacs calls."
4104 (string-equal
4105 "mock" (file-remote-p tramp-test-temporary-file-directory 'method)))
4107 (defun tramp--test-rsync-p ()
4108 "Check, whether the rsync method is used.
4109 This does not support special file names."
4110 (string-equal
4111 "rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
4113 (defun tramp--test-sh-p ()
4114 "Check, whether the remote host runs a based method from tramp-sh.el."
4116 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
4117 'tramp-sh-file-name-handler))
4119 (defun tramp--test-windows-nt ()
4120 "Check, whether the locale host runs MS Windows."
4121 (eq system-type 'windows-nt))
4123 (defun tramp--test-windows-nt-and-batch ()
4124 "Check, whether the locale host runs MS Windows in batch mode.
4125 This does not support special characters."
4126 (and (eq system-type 'windows-nt) noninteractive))
4128 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
4129 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
4130 This does not support utf8 based file transfer."
4131 (and (eq system-type 'windows-nt)
4132 (string-match
4133 (regexp-opt '("pscp" "psftp"))
4134 (file-remote-p tramp-test-temporary-file-directory 'method))))
4136 (defun tramp--test-windows-nt-or-smb-p ()
4137 "Check, whether the locale or remote host runs MS Windows.
4138 This requires restrictions of file name syntax."
4139 (or (eq system-type 'windows-nt)
4140 (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
4142 (defun tramp--test-check-files (&rest files)
4143 "Run a simple but comprehensive test over every file in FILES."
4144 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
4145 (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p))
4146 '(nil t) '(nil)))
4147 ;; We must use `file-truename' for the temporary directory,
4148 ;; because it could be located on a symlinked directory. This
4149 ;; would let the test fail.
4150 (let* ((tramp-test-temporary-file-directory
4151 (file-truename tramp-test-temporary-file-directory))
4152 (tmp-name1 (tramp--test-make-temp-name nil quoted))
4153 (tmp-name2 (tramp--test-make-temp-name 'local quoted))
4154 (files (delq nil files))
4155 (process-environment process-environment))
4156 (unwind-protect
4157 (progn
4158 (make-directory tmp-name1)
4159 (make-directory tmp-name2)
4161 (dolist (elt files)
4162 (let* ((file1 (expand-file-name elt tmp-name1))
4163 (file2 (expand-file-name elt tmp-name2))
4164 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
4165 (write-region elt nil file1)
4166 (should (file-exists-p file1))
4168 ;; Check file contents.
4169 (with-temp-buffer
4170 (insert-file-contents file1)
4171 (should (string-equal (buffer-string) elt)))
4173 ;; Copy file both directions.
4174 (copy-file file1 (file-name-as-directory tmp-name2))
4175 (should (file-exists-p file2))
4176 (delete-file file1)
4177 (should-not (file-exists-p file1))
4178 (copy-file file2 (file-name-as-directory tmp-name1))
4179 (should (file-exists-p file1))
4181 (tramp--test-ignore-make-symbolic-link-error
4182 (make-symbolic-link file1 file3)
4183 (should (file-symlink-p file3))
4184 (should
4185 (string-equal
4186 (expand-file-name file1) (file-truename file3)))
4187 (should
4188 (string-equal
4189 (funcall
4190 (if quoted 'tramp-compat-file-name-quote 'identity)
4191 (car (file-attributes file3)))
4192 (file-remote-p (file-truename file1) 'localname)))
4193 ;; Check file contents.
4194 (with-temp-buffer
4195 (insert-file-contents file3)
4196 (should (string-equal (buffer-string) elt)))
4197 (delete-file file3))))
4199 ;; Check file names.
4200 (should (equal (directory-files
4201 tmp-name1 nil directory-files-no-dot-files-regexp)
4202 (sort (copy-sequence files) 'string-lessp)))
4203 (should (equal (directory-files
4204 tmp-name2 nil directory-files-no-dot-files-regexp)
4205 (sort (copy-sequence files) 'string-lessp)))
4207 ;; `substitute-in-file-name' could return different
4208 ;; values. For `adb', there could be strange file
4209 ;; permissions preventing overwriting a file. We don't
4210 ;; care in this testcase.
4211 (dolist (elt files)
4212 (let ((file1
4213 (substitute-in-file-name (expand-file-name elt tmp-name1)))
4214 (file2
4215 (substitute-in-file-name
4216 (expand-file-name elt tmp-name2))))
4217 (ignore-errors (write-region elt nil file1))
4218 (should (file-exists-p file1))
4219 (ignore-errors (write-region elt nil file2 nil 'nomessage))
4220 (should (file-exists-p file2))))
4222 (should (equal (directory-files
4223 tmp-name1 nil directory-files-no-dot-files-regexp)
4224 (directory-files
4225 tmp-name2 nil directory-files-no-dot-files-regexp)))
4227 ;; Check directory creation. We use a subdirectory "foo"
4228 ;; in order to avoid conflicts with previous file name tests.
4229 (dolist (elt files)
4230 (let* ((elt1 (concat elt "foo"))
4231 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
4232 (file2 (expand-file-name elt file1))
4233 (file3 (expand-file-name elt1 file1)))
4234 (make-directory file1 'parents)
4235 (should (file-directory-p file1))
4236 (write-region elt nil file2)
4237 (should (file-exists-p file2))
4238 (should
4239 (equal
4240 (directory-files
4241 file1 nil directory-files-no-dot-files-regexp)
4242 `(,elt)))
4243 (should
4244 (equal
4245 (caar (directory-files-and-attributes
4246 file1 nil directory-files-no-dot-files-regexp))
4247 elt))
4249 ;; Check symlink in `directory-files-and-attributes'.
4250 ;; It does not work in the "smb" case, only relative
4251 ;; symlinks to existing files are shown there.
4252 (tramp--test-ignore-make-symbolic-link-error
4253 (unless
4254 (tramp-smb-file-name-p tramp-test-temporary-file-directory)
4255 (make-symbolic-link file2 file3)
4256 (should (file-symlink-p file3))
4257 (should
4258 (string-equal
4259 (caar (directory-files-and-attributes
4260 file1 nil (regexp-quote elt1)))
4261 elt1))
4262 (should
4263 (string-equal
4264 (funcall
4265 (if quoted 'tramp-compat-file-name-quote 'identity)
4266 (cadr (car (directory-files-and-attributes
4267 file1 nil (regexp-quote elt1)))))
4268 (file-remote-p (file-truename file2) 'localname)))
4269 (delete-file file3)
4270 (should-not (file-exists-p file3))))
4272 (delete-file file2)
4273 (should-not (file-exists-p file2))
4274 (delete-directory file1)
4275 (should-not (file-exists-p file1))))
4277 ;; Check, that environment variables are set correctly.
4278 (when (and tramp--test-expensive-test (tramp--test-sh-p))
4279 (dolist (elt files)
4280 (let ((envvar (concat "VAR_" (upcase (md5 elt))))
4281 (default-directory tramp-test-temporary-file-directory)
4282 (process-environment process-environment))
4283 (setenv envvar elt)
4284 ;; The value of PS1 could confuse Tramp's detection
4285 ;; of process output. So we unset it temporarily.
4286 (setenv "PS1")
4287 (with-temp-buffer
4288 (should (zerop (process-file "env" nil t nil)))
4289 (goto-char (point-min))
4290 (should
4291 (re-search-forward
4292 (format
4293 "^%s=%s$"
4294 (regexp-quote envvar)
4295 (regexp-quote (getenv envvar))))))))))
4297 ;; Cleanup.
4298 (ignore-errors (delete-directory tmp-name1 'recursive))
4299 (ignore-errors (delete-directory tmp-name2 'recursive))))))
4301 (defun tramp--test-special-characters ()
4302 "Perform the test in `tramp-test38-special-characters*'."
4303 ;; Newlines, slashes and backslashes in file names are not
4304 ;; supported. So we don't test. And we don't test the tab
4305 ;; character on Windows or Cygwin, because the backslash is
4306 ;; interpreted as a path separator, preventing "\t" from being
4307 ;; expanded to <TAB>.
4308 (tramp--test-check-files
4309 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4310 "foo bar baz"
4311 (if (or (tramp--test-adb-p)
4312 (tramp--test-docker-p)
4313 (eq system-type 'cygwin))
4314 " foo bar baz "
4315 " foo\tbar baz\t"))
4316 "$foo$bar$$baz$"
4317 "-foo-bar-baz-"
4318 "%foo%bar%baz%"
4319 "&foo&bar&baz&"
4320 (unless (or (tramp--test-ftp-p)
4321 (tramp--test-gvfs-p)
4322 (tramp--test-windows-nt-or-smb-p))
4323 "?foo?bar?baz?")
4324 (unless (or (tramp--test-ftp-p)
4325 (tramp--test-gvfs-p)
4326 (tramp--test-windows-nt-or-smb-p))
4327 "*foo*bar*baz*")
4328 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4329 "'foo'bar'baz'"
4330 "'foo\"bar'baz\"")
4331 "#foo~bar#baz~"
4332 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4333 "!foo!bar!baz!"
4334 "!foo|bar!baz|")
4335 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4336 ";foo;bar;baz;"
4337 ":foo;bar:baz;")
4338 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
4339 "<foo>bar<baz>")
4340 "(foo)bar(baz)"
4341 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
4342 "{foo}bar{baz}"))
4344 ;; These tests are inspired by Bug#17238.
4345 (ert-deftest tramp-test38-special-characters ()
4346 "Check special characters in file names."
4347 (skip-unless (tramp--test-enabled))
4348 (skip-unless (not (tramp--test-rsync-p)))
4349 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4351 (tramp--test-special-characters))
4353 (ert-deftest tramp-test38-special-characters-with-stat ()
4354 "Check special characters in file names.
4355 Use the `stat' command."
4356 :tags '(:expensive-test)
4357 (skip-unless (tramp--test-enabled))
4358 (skip-unless (tramp--test-sh-p))
4359 (skip-unless (not (tramp--test-rsync-p)))
4360 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4361 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4362 (skip-unless (tramp-get-remote-stat v)))
4364 (let ((tramp-connection-properties
4365 (append
4366 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4367 "perl" nil))
4368 tramp-connection-properties)))
4369 (tramp--test-special-characters)))
4371 (ert-deftest tramp-test38-special-characters-with-perl ()
4372 "Check special characters in file names.
4373 Use the `perl' command."
4374 :tags '(:expensive-test)
4375 (skip-unless (tramp--test-enabled))
4376 (skip-unless (tramp--test-sh-p))
4377 (skip-unless (not (tramp--test-rsync-p)))
4378 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4379 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4380 (skip-unless (tramp-get-remote-perl v)))
4382 (let ((tramp-connection-properties
4383 (append
4384 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4385 "stat" nil)
4386 ;; See `tramp-sh-handle-file-truename'.
4387 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4388 "readlink" nil))
4389 tramp-connection-properties)))
4390 (tramp--test-special-characters)))
4392 (ert-deftest tramp-test38-special-characters-with-ls ()
4393 "Check special characters in file names.
4394 Use the `ls' command."
4395 :tags '(:expensive-test)
4396 (skip-unless (tramp--test-enabled))
4397 (skip-unless (tramp--test-sh-p))
4398 (skip-unless (not (tramp--test-rsync-p)))
4399 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4400 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4402 (let ((tramp-connection-properties
4403 (append
4404 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4405 "perl" nil)
4406 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4407 "stat" nil)
4408 ;; See `tramp-sh-handle-file-truename'.
4409 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4410 "readlink" nil))
4411 tramp-connection-properties)))
4412 (tramp--test-special-characters)))
4414 (defun tramp--test-utf8 ()
4415 "Perform the test in `tramp-test39-utf8*'."
4416 (let* ((utf8 (if (and (eq system-type 'darwin)
4417 (memq 'utf-8-hfs (coding-system-list)))
4418 'utf-8-hfs 'utf-8))
4419 (coding-system-for-read utf8)
4420 (coding-system-for-write utf8)
4421 (file-name-coding-system
4422 (coding-system-change-eol-conversion utf8 'unix)))
4423 (tramp--test-check-files
4424 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
4425 (unless (tramp--test-hpux-p)
4426 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
4427 "银河系漫游指南系列"
4428 "Автостопом по гала́ктике")))
4430 (ert-deftest tramp-test39-utf8 ()
4431 "Check UTF8 encoding in file names and file contents."
4432 (skip-unless (tramp--test-enabled))
4433 (skip-unless (not (tramp--test-docker-p)))
4434 (skip-unless (not (tramp--test-rsync-p)))
4435 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4436 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4438 (tramp--test-utf8))
4440 (ert-deftest tramp-test39-utf8-with-stat ()
4441 "Check UTF8 encoding in file names and file contents.
4442 Use the `stat' command."
4443 :tags '(:expensive-test)
4444 (skip-unless (tramp--test-enabled))
4445 (skip-unless (tramp--test-sh-p))
4446 (skip-unless (not (tramp--test-docker-p)))
4447 (skip-unless (not (tramp--test-rsync-p)))
4448 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4449 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4450 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4451 (skip-unless (tramp-get-remote-stat v)))
4453 (let ((tramp-connection-properties
4454 (append
4455 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4456 "perl" nil))
4457 tramp-connection-properties)))
4458 (tramp--test-utf8)))
4460 (ert-deftest tramp-test39-utf8-with-perl ()
4461 "Check UTF8 encoding in file names and file contents.
4462 Use the `perl' command."
4463 :tags '(:expensive-test)
4464 (skip-unless (tramp--test-enabled))
4465 (skip-unless (tramp--test-sh-p))
4466 (skip-unless (not (tramp--test-docker-p)))
4467 (skip-unless (not (tramp--test-rsync-p)))
4468 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4469 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4470 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4471 (skip-unless (tramp-get-remote-perl v)))
4473 (let ((tramp-connection-properties
4474 (append
4475 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4476 "stat" nil)
4477 ;; See `tramp-sh-handle-file-truename'.
4478 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4479 "readlink" nil))
4480 tramp-connection-properties)))
4481 (tramp--test-utf8)))
4483 (ert-deftest tramp-test39-utf8-with-ls ()
4484 "Check UTF8 encoding in file names and file contents.
4485 Use the `ls' command."
4486 :tags '(:expensive-test)
4487 (skip-unless (tramp--test-enabled))
4488 (skip-unless (tramp--test-sh-p))
4489 (skip-unless (not (tramp--test-docker-p)))
4490 (skip-unless (not (tramp--test-rsync-p)))
4491 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4492 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4494 (let ((tramp-connection-properties
4495 (append
4496 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4497 "perl" nil)
4498 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4499 "stat" nil)
4500 ;; See `tramp-sh-handle-file-truename'.
4501 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4502 "readlink" nil))
4503 tramp-connection-properties)))
4504 (tramp--test-utf8)))
4506 (ert-deftest tramp-test40-file-system-info ()
4507 "Check that `file-system-info' returns proper values."
4508 (skip-unless (tramp--test-enabled))
4509 ;; Since Emacs 27.1.
4510 (skip-unless (fboundp 'file-system-info))
4512 ;; `file-system-info' exists since Emacs 27. We don't want to see
4513 ;; compiler warnings for older Emacsen.
4514 (let ((fsi (with-no-warnings
4515 (file-system-info tramp-test-temporary-file-directory))))
4516 (skip-unless fsi)
4517 (should (and (consp fsi)
4518 (= (length fsi) 3)
4519 (numberp (nth 0 fsi))
4520 (numberp (nth 1 fsi))
4521 (numberp (nth 2 fsi))))))
4523 (defun tramp--test-timeout-handler ()
4524 (interactive)
4525 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
4527 ;; This test is inspired by Bug#16928.
4528 (ert-deftest tramp-test41-asynchronous-requests ()
4529 "Check parallel asynchronous requests.
4530 Such requests could arrive from timers, process filters and
4531 process sentinels. They shall not disturb each other."
4532 :tags '(:expensive-test)
4533 (skip-unless (tramp--test-enabled))
4534 (skip-unless (tramp--test-sh-p))
4536 ;; This test could be blocked on hydra. So we set a timeout of 300
4537 ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
4538 (with-timeout (300 (tramp--test-timeout-handler))
4539 (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler)
4540 (let* (;; For the watchdog.
4541 (default-directory (expand-file-name temporary-file-directory))
4542 (watchdog
4543 (start-process
4544 "*watchdog*" nil shell-file-name shell-command-switch
4545 (format "sleep 300; kill -USR1 %d" (emacs-pid))))
4546 (tmp-name (tramp--test-make-temp-name))
4547 (default-directory tmp-name)
4548 ;; Do not cache Tramp properties.
4549 (remote-file-name-inhibit-cache t)
4550 (process-file-side-effects t)
4551 ;; Suppress nasty messages.
4552 (inhibit-message t)
4553 ;; Do not run delayed timers.
4554 (timer-max-repeats 0)
4555 ;; Number of asynchronous processes for test. Tests on
4556 ;; some machines handle less parallel processes.
4557 (number-proc
4559 (ignore-errors
4560 (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES")))
4561 10))
4562 ;; On hydra, timings are bad.
4563 (timer-repeat
4564 (cond
4565 ((getenv "EMACS_HYDRA_CI") 10)
4566 (t 1)))
4567 ;; We must distinguish due to performance reasons.
4568 (timer-operation
4569 (cond
4570 ((tramp--test-mock-p) 'vc-registered)
4571 (t 'file-attributes)))
4572 timer buffers kill-buffer-query-functions)
4574 (unwind-protect
4575 (progn
4576 (make-directory tmp-name)
4578 ;; Setup a timer in order to raise an ordinary command
4579 ;; again and again. `vc-registered' is well suited,
4580 ;; because there are many checks.
4581 (setq
4582 timer
4583 (run-at-time
4584 0 timer-repeat
4585 (lambda ()
4586 (when buffers
4587 (let ((time (float-time))
4588 (default-directory tmp-name)
4589 (file
4590 (buffer-name (nth (random (length buffers)) buffers))))
4591 (funcall timer-operation file)
4592 ;; Adjust timer if it takes too much time.
4593 (when (> (- (float-time) time) timer-repeat)
4594 (setq timer-repeat (* 1.5 timer-repeat))
4595 (setf (timer--repeat-delay timer) timer-repeat)))))))
4597 ;; Create temporary buffers. The number of buffers
4598 ;; corresponds to the number of processes; it could be
4599 ;; increased in order to make pressure on Tramp.
4600 (dotimes (_ number-proc)
4601 (setq buffers (cons (generate-new-buffer "foo") buffers)))
4603 ;; Open asynchronous processes. Set process filter and sentinel.
4604 (dolist (buf buffers)
4605 ;; Activate timer.
4606 (sit-for 0.01 'nodisp)
4607 (let ((proc
4608 (start-file-process-shell-command
4609 (buffer-name buf) buf
4610 (concat
4611 "(read line && echo $line >$line);"
4612 "(read line && cat $line);"
4613 "(read line && rm $line)")))
4614 (file (expand-file-name (buffer-name buf))))
4615 ;; Remember the file name. Add counter.
4616 (process-put proc 'foo file)
4617 (process-put proc 'bar 0)
4618 ;; Add process filter.
4619 (set-process-filter
4620 proc
4621 (lambda (proc string)
4622 (with-current-buffer (process-buffer proc)
4623 (insert string))
4624 (unless (zerop (length string))
4625 (dired-uncache (process-get proc 'foo))
4626 (should (file-attributes (process-get proc 'foo))))))
4627 ;; Add process sentinel.
4628 (set-process-sentinel
4629 proc
4630 (lambda (proc _state)
4631 (dired-uncache (process-get proc 'foo))
4632 (should-not (file-attributes (process-get proc 'foo)))))))
4634 ;; Send a string. Use a random order of the buffers. Mix
4635 ;; with regular operation.
4636 (let ((buffers (copy-sequence buffers)))
4637 (while buffers
4638 ;; Activate timer.
4639 (sit-for 0.01 'nodisp)
4640 (let* ((buf (nth (random (length buffers)) buffers))
4641 (proc (get-buffer-process buf))
4642 (file (process-get proc 'foo))
4643 (count (process-get proc 'bar)))
4644 ;; Regular operation prior process action.
4645 (dired-uncache file)
4646 (if (= count 0)
4647 (should-not (file-attributes file))
4648 (should (file-attributes file)))
4649 ;; Send string to process.
4650 (process-send-string proc (format "%s\n" (buffer-name buf)))
4651 (accept-process-output proc 0.1 nil 0)
4652 ;; Give the watchdog a chance.
4653 (read-event nil nil 0.01)
4654 ;; Regular operation post process action.
4655 (dired-uncache file)
4656 (if (= count 2)
4657 (should-not (file-attributes file))
4658 (should (file-attributes file)))
4659 (process-put proc 'bar (1+ count))
4660 (unless (process-live-p proc)
4661 (setq buffers (delq buf buffers))))))
4663 ;; Checks. All process output shall exists in the
4664 ;; respective buffers. All created files shall be
4665 ;; deleted.
4666 (dolist (buf buffers)
4667 (with-current-buffer buf
4668 (should (string-equal (format "%s\n" buf) (buffer-string)))))
4669 (should-not
4670 (directory-files
4671 tmp-name nil directory-files-no-dot-files-regexp)))
4673 ;; Cleanup.
4674 (define-key special-event-map [sigusr1] 'ignore)
4675 (ignore-errors (quit-process watchdog))
4676 (dolist (buf buffers)
4677 (ignore-errors (delete-process (get-buffer-process buf)))
4678 (ignore-errors (kill-buffer buf)))
4679 (ignore-errors (cancel-timer timer))
4680 (ignore-errors (delete-directory tmp-name 'recursive))))))
4682 ;; This test is inspired by Bug#29163.
4683 (ert-deftest tramp-test42-auto-load ()
4684 "Check that Tramp autoloads properly."
4685 (let ((default-directory (expand-file-name temporary-file-directory))
4686 (code
4687 (format
4688 "(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t))"
4689 tramp-test-temporary-file-directory)))
4690 (should
4691 (string-match
4692 "Tramp loaded: t[\n\r]+"
4693 (shell-command-to-string
4694 (format
4695 "%s -batch -Q -L %s --eval %s"
4696 (shell-quote-argument
4697 (expand-file-name invocation-name invocation-directory))
4698 (mapconcat 'shell-quote-argument load-path " -L ")
4699 (shell-quote-argument code)))))))
4701 (ert-deftest tramp-test42-delay-load ()
4702 "Check that Tramp is loaded lazily, only when needed."
4703 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
4704 ;; cannot test older Emacsen, therefore.
4705 (skip-unless (tramp--test-emacs26-p))
4707 ;; Tramp is neither loaded at Emacs startup, nor when completing a
4708 ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
4709 ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
4710 (let ((default-directory (expand-file-name temporary-file-directory))
4711 (code
4712 "(progn \
4713 (setq tramp-mode %s) \
4714 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
4715 (file-name-all-completions \"/foo\" \"/\") \
4716 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
4717 (file-name-all-completions \"/foo:\" \"/\") \
4718 (message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
4719 ;; Tramp doesn't load when `tramp-mode' is nil.
4720 (dolist (tm '(t nil))
4721 (should
4722 (string-match
4723 (format
4724 "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
4726 (shell-command-to-string
4727 (format
4728 "%s -batch -Q -L %s --eval %s"
4729 (shell-quote-argument
4730 (expand-file-name invocation-name invocation-directory))
4731 (mapconcat 'shell-quote-argument load-path " -L ")
4732 (shell-quote-argument (format code tm)))))))))
4734 (ert-deftest tramp-test42-recursive-load ()
4735 "Check that Tramp does not fail due to recursive load."
4736 (skip-unless (tramp--test-enabled))
4738 (let ((default-directory (expand-file-name temporary-file-directory)))
4739 (dolist (code
4740 (list
4741 (format
4742 "(expand-file-name %S)" tramp-test-temporary-file-directory)
4743 (format
4744 "(let ((default-directory %S)) (expand-file-name %S))"
4745 tramp-test-temporary-file-directory
4746 temporary-file-directory)))
4747 (should-not
4748 (string-match
4749 "Recursive load"
4750 (shell-command-to-string
4751 (format
4752 "%s -batch -Q -L %s --eval %s"
4753 (shell-quote-argument
4754 (expand-file-name invocation-name invocation-directory))
4755 (mapconcat 'shell-quote-argument load-path " -L ")
4756 (shell-quote-argument code))))))))
4758 (ert-deftest tramp-test42-remote-load-path ()
4759 "Check that Tramp autoloads its packages with remote `load-path'."
4760 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
4761 ;; cannot test older Emacsen, therefore.
4762 (skip-unless (tramp--test-emacs26-p))
4764 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
4765 ;; It shall still work, when a remote file name is in the
4766 ;; `load-path'.
4767 (let ((default-directory (expand-file-name temporary-file-directory))
4768 (code
4769 "(let ((force-load-messages t) \
4770 (load-path (cons \"/foo:bar:\" load-path))) \
4771 (tramp-cleanup-all-connections))"))
4772 (should
4773 (string-match
4774 (format
4775 "Loading %s"
4776 (expand-file-name
4777 "tramp-cmds" (file-name-directory (locate-library "tramp"))))
4778 (shell-command-to-string
4779 (format
4780 "%s -batch -Q -L %s -l tramp-sh --eval %s"
4781 (shell-quote-argument
4782 (expand-file-name invocation-name invocation-directory))
4783 (mapconcat 'shell-quote-argument load-path " -L ")
4784 (shell-quote-argument code)))))))
4786 (ert-deftest tramp-test43-unload ()
4787 "Check that Tramp and its subpackages unload completely.
4788 Since it unloads Tramp, it shall be the last test to run."
4789 :tags '(:expensive-test)
4790 (skip-unless noninteractive)
4791 ;; The autoloaded Tramp objects are different since Emacs 26.1. We
4792 ;; cannot test older Emacsen, therefore.
4793 (skip-unless (tramp--test-emacs26-p))
4795 (when (featurep 'tramp)
4796 (unload-feature 'tramp 'force)
4797 ;; No Tramp feature must be left.
4798 (should-not (featurep 'tramp))
4799 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
4800 ;; `file-name-handler-alist' must be clean.
4801 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
4802 ;; There shouldn't be left a bound symbol, except buffer-local
4803 ;; variables, and autoload functions. We do not regard our test
4804 ;; symbols, and the Tramp unload hooks.
4805 (mapatoms
4806 (lambda (x)
4807 (and (or (and (boundp x) (null (local-variable-if-set-p x)))
4808 (and (functionp x) (null (autoloadp (symbol-function x)))))
4809 (string-match "^tramp" (symbol-name x))
4810 (not (string-match "^tramp--?test" (symbol-name x)))
4811 (not (string-match "unload-hook$" (symbol-name x)))
4812 (ert-fail (format "`%s' still bound" x)))))
4813 ;; The defstruct `tramp-file-name' and all its internal functions
4814 ;; shall be purged.
4815 (should-not (cl--find-class 'tramp-file-name))
4816 (mapatoms
4817 (lambda (x)
4818 (and (functionp x)
4819 (string-match "tramp-file-name" (symbol-name x))
4820 (ert-fail (format "Structure function `%s' still exists" x)))))
4821 ;; There shouldn't be left a hook function containing a Tramp
4822 ;; function. We do not regard the Tramp unload hooks.
4823 (mapatoms
4824 (lambda (x)
4825 (and (boundp x)
4826 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
4827 (not (string-match "unload-hook$" (symbol-name x)))
4828 (consp (symbol-value x))
4829 (ignore-errors (all-completions "tramp" (symbol-value x)))
4830 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
4832 (defun tramp-test-all (&optional interactive)
4833 "Run all tests for \\[tramp]."
4834 (interactive "p")
4835 (funcall
4836 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
4838 ;; TODO:
4840 ;; * dired-compress-file
4841 ;; * dired-uncache
4842 ;; * file-equal-p (partly done in `tramp-test21-file-links')
4843 ;; * file-in-directory-p
4844 ;; * file-name-case-insensitive-p
4846 ;; * Work on skipped tests. Make a comment, when it is impossible.
4847 ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
4848 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4849 ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
4850 ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably.
4851 ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'.
4853 (provide 'tramp-tests)
4854 ;;; tramp-tests.el ends here