Extend tramp-tests according to bug#27986
[emacs.git] / test / lisp / net / tramp-tests.el
blobd5fec30384b49e27daf135e57a1f980764e7c591
1 ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `http://www.gnu.org/licenses/'.
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 ;; A whole test run can be performed calling the command `tramp-test-all'.
38 ;;; Code:
40 (require 'dired)
41 (require 'ert)
42 (require 'seq)
43 (require 'tramp)
44 (require 'vc)
45 (require 'vc-bzr)
46 (require 'vc-git)
47 (require 'vc-hg)
49 (declare-function tramp-find-executable "tramp-sh")
50 (declare-function tramp-get-remote-path "tramp-sh")
51 (declare-function tramp-get-remote-stat "tramp-sh")
52 (declare-function tramp-get-remote-perl "tramp-sh")
53 (defvar auto-save-file-name-transforms)
54 (defvar tramp-copy-size-limit)
55 (defvar tramp-persistency-file-name)
56 (defvar tramp-remote-process-environment)
57 ;; Suppress nasty messages.
58 (fset 'shell-command-sentinel 'ignore)
60 ;; There is no default value on w32 systems, which could work out of the box.
61 (defconst tramp-test-temporary-file-directory
62 (cond
63 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
64 ((eq system-type 'windows-nt) null-device)
65 (t (add-to-list
66 'tramp-methods
67 '("mock"
68 (tramp-login-program "sh")
69 (tramp-login-args (("-i")))
70 (tramp-remote-shell "/bin/sh")
71 (tramp-remote-shell-args ("-c"))
72 (tramp-connection-timeout 10)))
73 (add-to-list
74 'tramp-default-host-alist
75 `("\\`mock\\'" nil ,(system-name)))
76 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
77 ;; batch mode only, therefore.
78 (unless (and (null noninteractive) (file-directory-p "~/"))
79 (setenv "HOME" temporary-file-directory))
80 (format "/mock::%s" temporary-file-directory)))
81 "Temporary directory for Tramp tests.")
83 (setq password-cache-expiry nil
84 tramp-verbose 0
85 tramp-cache-read-persistent-data t ;; For auth-sources.
86 tramp-copy-size-limit nil
87 tramp-message-show-message nil
88 tramp-persistency-file-name nil)
90 ;; This should happen on hydra only.
91 (when (getenv "EMACS_HYDRA_CI")
92 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
94 (defvar tramp--test-expensive-test
95 (null
96 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
97 "Whether expensive tests are run.")
99 (defvar tramp--test-enabled-checked nil
100 "Cached result of `tramp--test-enabled'.
101 If the function did run, the value is a cons cell, the `cdr'
102 being the result.")
104 (defun tramp--test-enabled ()
105 "Whether remote file access is enabled."
106 (unless (consp tramp--test-enabled-checked)
107 (setq
108 tramp--test-enabled-checked
109 (cons
110 t (ignore-errors
111 (and
112 (file-remote-p tramp-test-temporary-file-directory)
113 (file-directory-p tramp-test-temporary-file-directory)
114 (file-writable-p tramp-test-temporary-file-directory))))))
116 (when (cdr tramp--test-enabled-checked)
117 ;; Cleanup connection.
118 (ignore-errors
119 (tramp-cleanup-connection
120 (tramp-dissect-file-name tramp-test-temporary-file-directory)
121 nil 'keep-password)))
123 ;; Return result.
124 (cdr tramp--test-enabled-checked))
126 (defun tramp--test-make-temp-name (&optional local quoted)
127 "Return a temporary file name for test.
128 If LOCAL is non-nil, a local file name is returned.
129 If QUOTED is non-nil, the local part of the file name is quoted.
130 The temporary file is not created."
131 (funcall
132 (if quoted 'tramp-compat-file-name-quote 'identity)
133 (expand-file-name
134 (make-temp-name "tramp-test")
135 (if local temporary-file-directory tramp-test-temporary-file-directory))))
137 ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
138 (defvar tramp--test-instrument-test-case-p nil
139 "Whether `tramp--test-instrument-test-case' run.
140 This shall used dynamically bound only.")
142 (defmacro tramp--test-instrument-test-case (verbose &rest body)
143 "Run BODY with `tramp-verbose' equal VERBOSE.
144 Print the the content of the Tramp debug buffer, if BODY does not
145 eval properly in `should' or `should-not'. `should-error' is not
146 handled properly. BODY shall not contain a timeout."
147 (declare (indent 1) (debug (natnump body)))
148 `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
149 (tramp-message-show-message t)
150 (tramp-debug-on-error t)
151 (debug-ignored-errors
152 (cons "^make-symbolic-link not supported$" debug-ignored-errors))
153 inhibit-message)
154 (unwind-protect
155 (let ((tramp--test-instrument-test-case-p t)) ,@body)
156 ;; Unwind forms.
157 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
158 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
159 (with-current-buffer (tramp-get-connection-buffer v)
160 (message "%s" (buffer-string)))
161 (with-current-buffer (tramp-get-debug-buffer v)
162 (message "%s" (buffer-string))))))))
164 (defsubst tramp--test-message (fmt-string &rest arguments)
165 "Emit a message into ERT *Messages*."
166 (tramp--test-instrument-test-case 0
167 (apply
168 'tramp-message
169 (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
170 fmt-string arguments)))
172 (defsubst tramp--test-backtrace ()
173 "Dump a backtrace into ERT *Messages*."
174 (tramp--test-instrument-test-case 10
175 (tramp-backtrace
176 (tramp-dissect-file-name tramp-test-temporary-file-directory))))
178 (ert-deftest tramp-test00-availability ()
179 "Test availability of Tramp functions."
180 :expected-result (if (tramp--test-enabled) :passed :failed)
181 (tramp--test-message
182 "Remote directory: `%s'" tramp-test-temporary-file-directory)
183 (should (ignore-errors
184 (and
185 (file-remote-p tramp-test-temporary-file-directory)
186 (file-directory-p tramp-test-temporary-file-directory)
187 (file-writable-p tramp-test-temporary-file-directory)))))
189 (ert-deftest tramp-test01-file-name-syntax ()
190 "Check remote file name syntax."
191 ;; Simple cases.
192 (should (tramp-tramp-file-p "/method::"))
193 (should (tramp-tramp-file-p "/method:host:"))
194 (should (tramp-tramp-file-p "/method:user@:"))
195 (should (tramp-tramp-file-p "/method:user@host:"))
196 (should (tramp-tramp-file-p "/method:user@email@host:"))
198 ;; Using a port.
199 (should (tramp-tramp-file-p "/method:host#1234:"))
200 (should (tramp-tramp-file-p "/method:user@host#1234:"))
202 ;; Using an IPv4 address.
203 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
204 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
206 ;; Using an IPv6 address.
207 (should (tramp-tramp-file-p "/method:[::1]:"))
208 (should (tramp-tramp-file-p "/method:user@[::1]:"))
210 ;; Local file name part.
211 (should (tramp-tramp-file-p "/method:::"))
212 (should (tramp-tramp-file-p "/method::/:"))
213 (should (tramp-tramp-file-p "/method::/path/to/file"))
214 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
215 (should (tramp-tramp-file-p "/method::file"))
216 (should (tramp-tramp-file-p "/method::/:file"))
218 ;; Multihop.
219 (should (tramp-tramp-file-p "/method1:|method2::"))
220 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
221 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
222 (should (tramp-tramp-file-p
223 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
225 ;; No strings.
226 (should-not (tramp-tramp-file-p nil))
227 (should-not (tramp-tramp-file-p 'symbol))
228 ;; Ange-ftp syntax.
229 (should-not (tramp-tramp-file-p "/host:"))
230 (should-not (tramp-tramp-file-p "/user@host:"))
231 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
232 (should-not (tramp-tramp-file-p "/[]:"))
233 (should-not (tramp-tramp-file-p "/[::1]:"))
234 (should-not (tramp-tramp-file-p "/host:/:"))
235 (should-not (tramp-tramp-file-p "/host1|host2:"))
236 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
237 ;; Quote with "/:" suppresses file name handlers.
238 (should-not (tramp-tramp-file-p "/::"))
239 (should-not (tramp-tramp-file-p "/:@:"))
240 (should-not (tramp-tramp-file-p "/:[]:"))
241 ;; Methods shall be at least two characters on MS Windows, except
242 ;; the default method.
243 (let ((system-type 'windows-nt))
244 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
245 (should-not (tramp-tramp-file-p "/c::/path/to/file"))
246 (should (tramp-tramp-file-p "/-::/path/to/file")))
247 (let ((system-type 'gnu/linux))
248 (should (tramp-tramp-file-p "/-:h:/path/to/file"))
249 (should (tramp-tramp-file-p "/m::/path/to/file"))))
251 (ert-deftest tramp-test01-file-name-syntax-simplified ()
252 "Check simplified file name syntax."
253 :tags '(:expensive-test)
254 (let ((syntax tramp-syntax))
255 (unwind-protect
256 (progn
257 (tramp-change-syntax 'simplified)
258 ;; Simple cases.
259 (should (tramp-tramp-file-p "/host:"))
260 (should (tramp-tramp-file-p "/user@:"))
261 (should (tramp-tramp-file-p "/user@host:"))
262 (should (tramp-tramp-file-p "/user@email@host:"))
264 ;; Using a port.
265 (should (tramp-tramp-file-p "/host#1234:"))
266 (should (tramp-tramp-file-p "/user@host#1234:"))
268 ;; Using an IPv4 address.
269 (should (tramp-tramp-file-p "/1.2.3.4:"))
270 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
272 ;; Using an IPv6 address.
273 (should (tramp-tramp-file-p "/[::1]:"))
274 (should (tramp-tramp-file-p "/user@[::1]:"))
276 ;; Local file name part.
277 (should (tramp-tramp-file-p "/host::"))
278 (should (tramp-tramp-file-p "/host:/:"))
279 (should (tramp-tramp-file-p "/host:/path/to/file"))
280 (should (tramp-tramp-file-p "/host:/:/path/to/file"))
281 (should (tramp-tramp-file-p "/host:file"))
282 (should (tramp-tramp-file-p "/host:/:file"))
284 ;; Multihop.
285 (should (tramp-tramp-file-p "/host1|host2:"))
286 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
287 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
289 ;; No strings.
290 (should-not (tramp-tramp-file-p nil))
291 (should-not (tramp-tramp-file-p 'symbol))
292 ;; Quote with "/:" suppresses file name handlers.
293 (should-not (tramp-tramp-file-p "/::"))
294 (should-not (tramp-tramp-file-p "/:@:"))
295 (should-not (tramp-tramp-file-p "/:[]:")))
297 ;; Exit.
298 (tramp-change-syntax syntax))))
300 (ert-deftest tramp-test01-file-name-syntax-separate ()
301 "Check separate file name syntax."
302 :tags '(:expensive-test)
303 (let ((syntax tramp-syntax))
304 (unwind-protect
305 (progn
306 (tramp-change-syntax 'separate)
307 ;; Simple cases.
308 (should (tramp-tramp-file-p "/[method/]"))
309 (should (tramp-tramp-file-p "/[method/host]"))
310 (should (tramp-tramp-file-p "/[method/user@]"))
311 (should (tramp-tramp-file-p "/[method/user@host]"))
312 (should (tramp-tramp-file-p "/[method/user@email@host]"))
314 ;; Using a port.
315 (should (tramp-tramp-file-p "/[method/host#1234]"))
316 (should (tramp-tramp-file-p "/[method/user@host#1234]"))
318 ;; Using an IPv4 address.
319 (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
320 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
322 ;; Using an IPv6 address.
323 (should (tramp-tramp-file-p "/[method/::1]"))
324 (should (tramp-tramp-file-p "/[method/user@::1]"))
326 ;; Local file name part.
327 (should (tramp-tramp-file-p "/[method/]"))
328 (should (tramp-tramp-file-p "/[method/]/:"))
329 (should (tramp-tramp-file-p "/[method/]/path/to/file"))
330 (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
331 (should (tramp-tramp-file-p "/[method/]file"))
332 (should (tramp-tramp-file-p "/[method/]/:file"))
334 ;; Multihop.
335 (should (tramp-tramp-file-p "/[method1/|method2/]"))
336 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
337 (should
338 (tramp-tramp-file-p
339 "/[method1/user1@host1|method2/user2@host2]"))
340 (should
341 (tramp-tramp-file-p
342 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
344 ;; No strings.
345 (should-not (tramp-tramp-file-p nil))
346 (should-not (tramp-tramp-file-p 'symbol))
347 ;; Ange-ftp syntax.
348 (should-not (tramp-tramp-file-p "/host:"))
349 (should-not (tramp-tramp-file-p "/user@host:"))
350 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
351 (should-not (tramp-tramp-file-p "/host:/:"))
352 (should-not (tramp-tramp-file-p "/host1|host2:"))
353 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
354 ;; Quote with "/:" suppresses file name handlers.
355 (should-not (tramp-tramp-file-p "/:[]")))
357 ;; Exit.
358 (tramp-change-syntax syntax))))
360 (ert-deftest tramp-test02-file-name-dissect ()
361 "Check remote file name components."
362 (let ((tramp-default-method "default-method")
363 (tramp-default-user "default-user")
364 (tramp-default-host "default-host"))
365 ;; Expand `tramp-default-user' and `tramp-default-host'.
366 (should (string-equal
367 (file-remote-p "/method::")
368 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
369 (should (string-equal (file-remote-p "/method::" 'method) "method"))
370 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
371 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
372 (should (string-equal (file-remote-p "/method::" 'localname) ""))
373 (should (string-equal (file-remote-p "/method::" 'hop) nil))
375 ;; Expand `tramp-default-method' and `tramp-default-user'.
376 (should (string-equal
377 (file-remote-p "/-:host:")
378 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
379 (should (string-equal (file-remote-p "/-:host:" 'method) "default-method"))
380 (should (string-equal (file-remote-p "/-:host:" 'user) "default-user"))
381 (should (string-equal (file-remote-p "/-:host:" 'host) "host"))
382 (should (string-equal (file-remote-p "/-:host:" 'localname) ""))
383 (should (string-equal (file-remote-p "/-:host:" 'hop) nil))
385 ;; Expand `tramp-default-method' and `tramp-default-host'.
386 (should (string-equal
387 (file-remote-p "/-:user@:")
388 (format "/%s:%s@%s:" "default-method" "user" "default-host")))
389 (should (string-equal (file-remote-p "/-:user@:" 'method) "default-method"))
390 (should (string-equal (file-remote-p "/-:user@:" 'user) "user"))
391 (should (string-equal (file-remote-p "/-:user@:" 'host) "default-host"))
392 (should (string-equal (file-remote-p "/-:user@:" 'localname) ""))
393 (should (string-equal (file-remote-p "/-:user@:" 'hop) nil))
395 ;; Expand `tramp-default-method'.
396 (should (string-equal
397 (file-remote-p "/-:user@host:")
398 (format "/%s:%s@%s:" "default-method" "user" "host")))
399 (should (string-equal
400 (file-remote-p "/-:user@host:" 'method) "default-method"))
401 (should (string-equal (file-remote-p "/-:user@host:" 'user) "user"))
402 (should (string-equal (file-remote-p "/-:user@host:" 'host) "host"))
403 (should (string-equal (file-remote-p "/-:user@host:" 'localname) ""))
404 (should (string-equal (file-remote-p "/-:user@host:" 'hop) nil))
406 ;; Expand `tramp-default-user'.
407 (should (string-equal
408 (file-remote-p "/method:host:")
409 (format "/%s:%s@%s:" "method" "default-user" "host")))
410 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
411 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
412 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
413 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
414 (should (string-equal (file-remote-p "/method:host:" 'hop) nil))
416 ;; Expand `tramp-default-host'.
417 (should (string-equal
418 (file-remote-p "/method:user@:")
419 (format "/%s:%s@%s:" "method" "user" "default-host")))
420 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
421 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
422 (should (string-equal (file-remote-p "/method:user@:" 'host)
423 "default-host"))
424 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
425 (should (string-equal (file-remote-p "/method:user@:" 'hop) nil))
427 ;; No expansion.
428 (should (string-equal
429 (file-remote-p "/method:user@host:")
430 (format "/%s:%s@%s:" "method" "user" "host")))
431 (should (string-equal
432 (file-remote-p "/method:user@host:" 'method) "method"))
433 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
434 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
435 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
436 (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil))
438 ;; No expansion.
439 (should (string-equal
440 (file-remote-p "/method:user@email@host:")
441 (format "/%s:%s@%s:" "method" "user@email" "host")))
442 (should (string-equal
443 (file-remote-p "/method:user@email@host:" 'method) "method"))
444 (should (string-equal
445 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
446 (should (string-equal
447 (file-remote-p "/method:user@email@host:" 'host) "host"))
448 (should (string-equal
449 (file-remote-p "/method:user@email@host:" 'localname) ""))
450 (should (string-equal
451 (file-remote-p "/method:user@email@host:" 'hop) nil))
453 ;; Expand `tramp-default-method' and `tramp-default-user'.
454 (should (string-equal
455 (file-remote-p "/-:host#1234:")
456 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
457 (should (string-equal
458 (file-remote-p "/-:host#1234:" 'method) "default-method"))
459 (should (string-equal (file-remote-p "/-:host#1234:" 'user) "default-user"))
460 (should (string-equal (file-remote-p "/-:host#1234:" 'host) "host#1234"))
461 (should (string-equal (file-remote-p "/-:host#1234:" 'localname) ""))
462 (should (string-equal (file-remote-p "/-:host#1234:" 'hop) nil))
464 ;; Expand `tramp-default-method'.
465 (should (string-equal
466 (file-remote-p "/-:user@host#1234:")
467 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
468 (should (string-equal
469 (file-remote-p "/-:user@host#1234:" 'method) "default-method"))
470 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
471 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
472 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
473 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
475 ;; Expand `tramp-default-user'.
476 (should (string-equal
477 (file-remote-p "/method:host#1234:")
478 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
479 (should (string-equal
480 (file-remote-p "/method:host#1234:" 'method) "method"))
481 (should (string-equal
482 (file-remote-p "/method:host#1234:" 'user) "default-user"))
483 (should (string-equal
484 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
485 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
486 (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil))
488 ;; No expansion.
489 (should (string-equal
490 (file-remote-p "/method:user@host#1234:")
491 (format "/%s:%s@%s:" "method" "user" "host#1234")))
492 (should (string-equal
493 (file-remote-p "/method:user@host#1234:" 'method) "method"))
494 (should (string-equal
495 (file-remote-p "/method:user@host#1234:" 'user) "user"))
496 (should (string-equal
497 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
498 (should (string-equal
499 (file-remote-p "/method:user@host#1234:" 'localname) ""))
500 (should (string-equal
501 (file-remote-p "/method:user@host#1234:" 'hop) nil))
503 ;; Expand `tramp-default-method' and `tramp-default-user'.
504 (should (string-equal
505 (file-remote-p "/-:1.2.3.4:")
506 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
507 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
508 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
509 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
510 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
511 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop) nil))
513 ;; Expand `tramp-default-method'.
514 (should (string-equal
515 (file-remote-p "/-:user@1.2.3.4:")
516 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
517 (should (string-equal
518 (file-remote-p "/-:user@1.2.3.4:" 'method) "default-method"))
519 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user) "user"))
520 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host) "1.2.3.4"))
521 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname) ""))
522 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop) nil))
524 ;; Expand `tramp-default-user'.
525 (should (string-equal
526 (file-remote-p "/method:1.2.3.4:")
527 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
528 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
529 (should (string-equal
530 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
531 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
532 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
533 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil))
535 ;; No expansion.
536 (should (string-equal
537 (file-remote-p "/method:user@1.2.3.4:")
538 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
539 (should (string-equal
540 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
541 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
542 (should (string-equal
543 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
544 (should (string-equal
545 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
546 (should (string-equal
547 (file-remote-p "/method:user@1.2.3.4:" 'hop) nil))
549 ;; Expand `tramp-default-method', `tramp-default-user' and
550 ;; `tramp-default-host'.
551 (should (string-equal
552 (file-remote-p "/-:[]:")
553 (format
554 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
555 (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
556 (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
557 (should (string-equal (file-remote-p "/-:[]:" 'host) "default-host"))
558 (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
559 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil))
561 ;; Expand `tramp-default-method' and `tramp-default-user'.
562 (let ((tramp-default-host "::1"))
563 (should (string-equal
564 (file-remote-p "/-:[]:")
565 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
566 (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
567 (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
568 (should (string-equal (file-remote-p "/-:[]:" 'host) "::1"))
569 (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
570 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil)))
572 ;; Expand `tramp-default-method' and `tramp-default-user'.
573 (should (string-equal
574 (file-remote-p "/-:[::1]:")
575 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
576 (should (string-equal (file-remote-p "/-:[::1]:" 'method) "default-method"))
577 (should (string-equal (file-remote-p "/-:[::1]:" 'user) "default-user"))
578 (should (string-equal (file-remote-p "/-:[::1]:" 'host) "::1"))
579 (should (string-equal (file-remote-p "/-:[::1]:" 'localname) ""))
580 (should (string-equal (file-remote-p "/-:[::1]:" 'hop) nil))
582 ;; Expand `tramp-default-method'.
583 (should (string-equal
584 (file-remote-p "/-:user@[::1]:")
585 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
586 (should (string-equal
587 (file-remote-p "/-:user@[::1]:" 'method) "default-method"))
588 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user) "user"))
589 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host) "::1"))
590 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname) ""))
591 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop) nil))
593 ;; Expand `tramp-default-user'.
594 (should (string-equal
595 (file-remote-p "/method:[::1]:")
596 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
597 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
598 (should (string-equal
599 (file-remote-p "/method:[::1]:" 'user) "default-user"))
600 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
601 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
602 (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
604 ;; No expansion.
605 (should (string-equal
606 (file-remote-p "/method:user@[::1]:")
607 (format "/%s:%s@%s:" "method" "user" "[::1]")))
608 (should (string-equal
609 (file-remote-p "/method:user@[::1]:" 'method) "method"))
610 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
611 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
612 (should (string-equal
613 (file-remote-p "/method:user@[::1]:" 'localname) ""))
614 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
616 ;; Local file name part.
617 (should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
618 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
619 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
620 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
621 (should (string-equal
622 (file-remote-p "/method::/path/to/file" 'localname)
623 "/path/to/file"))
625 ;; Multihop.
626 (should
627 (string-equal
628 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
629 (format "/%s:%s@%s|%s:%s@%s:"
630 "method1" "user1" "host1" "method2" "user2" "host2")))
631 (should
632 (string-equal
633 (file-remote-p
634 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
635 "method2"))
636 (should
637 (string-equal
638 (file-remote-p
639 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
640 "user2"))
641 (should
642 (string-equal
643 (file-remote-p
644 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
645 "host2"))
646 (should
647 (string-equal
648 (file-remote-p
649 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
650 "/path/to/file"))
651 (should
652 (string-equal
653 (file-remote-p
654 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
655 (format "%s:%s@%s|"
656 "method1" "user1" "host1")))
658 (should
659 (string-equal
660 (file-remote-p
661 (concat
662 "/method1:user1@host1"
663 "|method2:user2@host2"
664 "|method3:user3@host3:/path/to/file"))
665 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
666 "method1" "user1" "host1"
667 "method2" "user2" "host2"
668 "method3" "user3" "host3")))
669 (should
670 (string-equal
671 (file-remote-p
672 (concat
673 "/method1:user1@host1"
674 "|method2:user2@host2"
675 "|method3:user3@host3:/path/to/file")
676 'method)
677 "method3"))
678 (should
679 (string-equal
680 (file-remote-p
681 (concat
682 "/method1:user1@host1"
683 "|method2:user2@host2"
684 "|method3:user3@host3:/path/to/file")
685 'user)
686 "user3"))
687 (should
688 (string-equal
689 (file-remote-p
690 (concat
691 "/method1:user1@host1"
692 "|method2:user2@host2"
693 "|method3:user3@host3:/path/to/file")
694 'host)
695 "host3"))
696 (should
697 (string-equal
698 (file-remote-p
699 (concat
700 "/method1:user1@host1"
701 "|method2:user2@host2"
702 "|method3:user3@host3:/path/to/file")
703 'localname)
704 "/path/to/file"))
705 (should
706 (string-equal
707 (file-remote-p
708 (concat
709 "/method1:user1@host1"
710 "|method2:user2@host2"
711 "|method3:user3@host3:/path/to/file")
712 'hop)
713 (format "%s:%s@%s|%s:%s@%s|"
714 "method1" "user1" "host1" "method2" "user2" "host2")))))
716 (ert-deftest tramp-test02-file-name-dissect-simplified ()
717 "Check simplified file name components."
718 :tags '(:expensive-test)
719 (let ((tramp-default-method "default-method")
720 (tramp-default-user "default-user")
721 (tramp-default-host "default-host")
722 (syntax tramp-syntax))
723 (unwind-protect
724 (progn
725 (tramp-change-syntax 'simplified)
726 ;; Expand `tramp-default-method' and `tramp-default-user'.
727 (should (string-equal
728 (file-remote-p "/host:")
729 (format "/%s@%s:" "default-user" "host")))
730 (should (string-equal
731 (file-remote-p "/host:" 'method) "default-method"))
732 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
733 (should (string-equal (file-remote-p "/host:" 'host) "host"))
734 (should (string-equal (file-remote-p "/host:" 'localname) ""))
735 (should (string-equal (file-remote-p "/host:" 'hop) nil))
737 ;; Expand `tramp-default-method' and `tramp-default-host'.
738 (should (string-equal
739 (file-remote-p "/user@:")
740 (format "/%s@%s:" "user" "default-host")))
741 (should (string-equal
742 (file-remote-p "/user@:" 'method) "default-method"))
743 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
744 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
745 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
746 (should (string-equal (file-remote-p "/user@:" 'hop) nil))
748 ;; Expand `tramp-default-method'.
749 (should (string-equal
750 (file-remote-p "/user@host:")
751 (format "/%s@%s:" "user" "host")))
752 (should (string-equal
753 (file-remote-p "/user@host:" 'method) "default-method"))
754 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
755 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
756 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
757 (should (string-equal (file-remote-p "/user@host:" 'hop) nil))
759 ;; No expansion.
760 (should (string-equal
761 (file-remote-p "/user@email@host:")
762 (format "/%s@%s:" "user@email" "host")))
763 (should (string-equal
764 (file-remote-p
765 "/user@email@host:" 'method) "default-method"))
766 (should (string-equal
767 (file-remote-p "/user@email@host:" 'user) "user@email"))
768 (should (string-equal
769 (file-remote-p "/user@email@host:" 'host) "host"))
770 (should (string-equal
771 (file-remote-p "/user@email@host:" 'localname) ""))
772 (should (string-equal
773 (file-remote-p "/user@email@host:" 'hop) nil))
775 ;; Expand `tramp-default-method' and `tramp-default-user'.
776 (should (string-equal
777 (file-remote-p "/host#1234:")
778 (format "/%s@%s:" "default-user" "host#1234")))
779 (should (string-equal
780 (file-remote-p "/host#1234:" 'method) "default-method"))
781 (should (string-equal
782 (file-remote-p "/host#1234:" 'user) "default-user"))
783 (should (string-equal
784 (file-remote-p "/host#1234:" 'host) "host#1234"))
785 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
786 (should (string-equal (file-remote-p "/host#1234:" 'hop) nil))
788 ;; Expand `tramp-default-method'.
789 (should (string-equal
790 (file-remote-p "/user@host#1234:")
791 (format "/%s@%s:" "user" "host#1234")))
792 (should (string-equal
793 (file-remote-p "/user@host#1234:" 'method) "default-method"))
794 (should (string-equal
795 (file-remote-p "/user@host#1234:" 'user) "user"))
796 (should (string-equal
797 (file-remote-p "/user@host#1234:" 'host) "host#1234"))
798 (should (string-equal
799 (file-remote-p "/user@host#1234:" 'localname) ""))
800 (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil))
802 ;; Expand `tramp-default-method' and `tramp-default-user'.
803 (should (string-equal
804 (file-remote-p "/1.2.3.4:")
805 (format "/%s@%s:" "default-user" "1.2.3.4")))
806 (should (string-equal
807 (file-remote-p "/1.2.3.4:" 'method) "default-method"))
808 (should (string-equal
809 (file-remote-p "/1.2.3.4:" 'user) "default-user"))
810 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
811 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
812 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil))
814 ;; Expand `tramp-default-method'.
815 (should (string-equal
816 (file-remote-p "/user@1.2.3.4:")
817 (format "/%s@%s:" "user" "1.2.3.4")))
818 (should (string-equal
819 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
820 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
821 (should (string-equal
822 (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
823 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
824 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil))
826 ;; Expand `tramp-default-method', `tramp-default-user' and
827 ;; `tramp-default-host'.
828 (should (string-equal
829 (file-remote-p "/[]:")
830 (format
831 "/%s@%s:" "default-user" "default-host")))
832 (should (string-equal
833 (file-remote-p "/[]:" 'method) "default-method"))
834 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
835 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
836 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
837 (should (string-equal (file-remote-p "/[]:" 'hop) nil))
839 ;; Expand `tramp-default-method' and `tramp-default-user'.
840 (let ((tramp-default-host "::1"))
841 (should (string-equal
842 (file-remote-p "/[]:")
843 (format "/%s@%s:" "default-user" "[::1]")))
844 (should (string-equal
845 (file-remote-p "/[]:" 'method) "default-method"))
846 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
847 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
848 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
849 (should (string-equal (file-remote-p "/[]:" 'hop) nil)))
851 ;; Expand `tramp-default-method' and `tramp-default-user'.
852 (should (string-equal
853 (file-remote-p "/[::1]:")
854 (format "/%s@%s:" "default-user" "[::1]")))
855 (should (string-equal
856 (file-remote-p "/[::1]:" 'method) "default-method"))
857 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
858 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
859 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
860 (should (string-equal (file-remote-p "/[::1]:" 'hop) nil))
862 ;; Expand `tramp-default-method'.
863 (should (string-equal
864 (file-remote-p "/user@[::1]:")
865 (format "/%s@%s:" "user" "[::1]")))
866 (should (string-equal
867 (file-remote-p "/user@[::1]:" 'method) "default-method"))
868 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
869 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
870 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
871 (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
873 ;; Local file name part.
874 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
875 (should (string-equal (file-remote-p "/host::" 'localname) ":"))
876 (should (string-equal (file-remote-p "/host: " 'localname) " "))
877 (should (string-equal (file-remote-p "/host:file" 'localname) "file"))
878 (should (string-equal
879 (file-remote-p "/host:/path/to/file" 'localname)
880 "/path/to/file"))
882 ;; Multihop.
883 (should
884 (string-equal
885 (file-remote-p "/user1@host1|user2@host2:/path/to/file")
886 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
887 (should
888 (string-equal
889 (file-remote-p
890 "/user1@host1|user2@host2:/path/to/file" 'method)
891 "default-method"))
892 (should
893 (string-equal
894 (file-remote-p
895 "/user1@host1|user2@host2:/path/to/file" 'user)
896 "user2"))
897 (should
898 (string-equal
899 (file-remote-p
900 "/user1@host1|user2@host2:/path/to/file" 'host)
901 "host2"))
902 (should
903 (string-equal
904 (file-remote-p
905 "/user1@host1|user2@host2:/path/to/file" 'localname)
906 "/path/to/file"))
907 (should
908 (string-equal
909 (file-remote-p
910 "/user1@host1|user2@host2:/path/to/file" 'hop)
911 (format "%s@%s|" "user1" "host1")))
913 (should
914 (string-equal
915 (file-remote-p
916 (concat
917 "/user1@host1"
918 "|user2@host2"
919 "|user3@host3:/path/to/file"))
920 (format "/%s@%s|%s@%s|%s@%s:"
921 "user1" "host1"
922 "user2" "host2"
923 "user3" "host3")))
924 (should
925 (string-equal
926 (file-remote-p
927 (concat
928 "/user1@host1"
929 "|user2@host2"
930 "|user3@host3:/path/to/file")
931 'method)
932 "default-method"))
933 (should
934 (string-equal
935 (file-remote-p
936 (concat
937 "/user1@host1"
938 "|user2@host2"
939 "|user3@host3:/path/to/file")
940 'user)
941 "user3"))
942 (should
943 (string-equal
944 (file-remote-p
945 (concat
946 "/user1@host1"
947 "|user2@host2"
948 "|user3@host3:/path/to/file")
949 'host)
950 "host3"))
951 (should
952 (string-equal
953 (file-remote-p
954 (concat
955 "/user1@host1"
956 "|user2@host2"
957 "|user3@host3:/path/to/file")
958 'localname)
959 "/path/to/file"))
960 (should
961 (string-equal
962 (file-remote-p
963 (concat
964 "/user1@host1"
965 "|user2@host2"
966 "|user3@host3:/path/to/file")
967 'hop)
968 (format "%s@%s|%s@%s|"
969 "user1" "host1" "user2" "host2"))))
971 ;; Exit.
972 (tramp-change-syntax syntax))))
974 (ert-deftest tramp-test02-file-name-dissect-separate ()
975 "Check separate file name components."
976 :tags '(:expensive-test)
977 (let ((tramp-default-method "default-method")
978 (tramp-default-user "default-user")
979 (tramp-default-host "default-host")
980 (syntax tramp-syntax))
981 (unwind-protect
982 (progn
983 (tramp-change-syntax 'separate)
984 ;; Expand `tramp-default-user' and `tramp-default-host'.
985 (should (string-equal
986 (file-remote-p "/[method/]")
987 (format
988 "/[%s/%s@%s]" "method" "default-user" "default-host")))
989 (should (string-equal (file-remote-p "/[method/]" 'method) "method"))
990 (should (string-equal
991 (file-remote-p "/[method/]" 'user) "default-user"))
992 (should (string-equal
993 (file-remote-p "/[method/]" 'host) "default-host"))
994 (should (string-equal (file-remote-p "/[method/]" 'localname) ""))
995 (should (string-equal (file-remote-p "/[method/]" 'hop) nil))
997 ;; Expand `tramp-default-method' and `tramp-default-user'.
998 (should (string-equal
999 (file-remote-p "/[/host]")
1000 (format
1001 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1002 (should (string-equal
1003 (file-remote-p "/[/host]" 'method) "default-method"))
1004 (should (string-equal
1005 (file-remote-p "/[/host]" 'user) "default-user"))
1006 (should (string-equal (file-remote-p "/[/host]" 'host) "host"))
1007 (should (string-equal (file-remote-p "/[/host]" 'localname) ""))
1008 (should (string-equal (file-remote-p "/[/host]" 'hop) nil))
1010 ;; Expand `tramp-default-method' and `tramp-default-host'.
1011 (should (string-equal
1012 (file-remote-p "/[/user@]")
1013 (format
1014 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1015 (should (string-equal
1016 (file-remote-p "/[/user@]" 'method) "default-method"))
1017 (should (string-equal (file-remote-p "/[/user@]" 'user) "user"))
1018 (should (string-equal
1019 (file-remote-p "/[/user@]" 'host) "default-host"))
1020 (should (string-equal (file-remote-p "/[/user@]" 'localname) ""))
1021 (should (string-equal (file-remote-p "/[/user@]" 'hop) nil))
1023 ;; Expand `tramp-default-method'.
1024 (should (string-equal
1025 (file-remote-p "/[/user@host]")
1026 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1027 (should (string-equal
1028 (file-remote-p "/[/user@host]" 'method) "default-method"))
1029 (should (string-equal (file-remote-p "/[/user@host]" 'user) "user"))
1030 (should (string-equal (file-remote-p "/[/user@host]" 'host) "host"))
1031 (should (string-equal (file-remote-p "/[/user@host]" 'localname) ""))
1032 (should (string-equal (file-remote-p "/[/user@host]" 'hop) nil))
1034 ;; Expand `tramp-default-method' and `tramp-default-user'.
1035 (should (string-equal
1036 (file-remote-p "/[-/host]")
1037 (format
1038 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1039 (should (string-equal
1040 (file-remote-p "/[-/host]" 'method) "default-method"))
1041 (should (string-equal
1042 (file-remote-p "/[-/host]" 'user) "default-user"))
1043 (should (string-equal (file-remote-p "/[-/host]" 'host) "host"))
1044 (should (string-equal (file-remote-p "/[-/host]" 'localname) ""))
1045 (should (string-equal (file-remote-p "/[-/host]" 'hop) nil))
1047 ;; Expand `tramp-default-method' and `tramp-default-host'.
1048 (should (string-equal
1049 (file-remote-p "/[-/user@]")
1050 (format
1051 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1052 (should (string-equal
1053 (file-remote-p "/[-/user@]" 'method) "default-method"))
1054 (should (string-equal (file-remote-p "/[-/user@]" 'user) "user"))
1055 (should (string-equal
1056 (file-remote-p "/[-/user@]" 'host) "default-host"))
1057 (should (string-equal (file-remote-p "/[-/user@]" 'localname) ""))
1058 (should (string-equal (file-remote-p "/[-/user@]" 'hop) nil))
1060 ;; Expand `tramp-default-method'.
1061 (should (string-equal
1062 (file-remote-p "/[-/user@host]")
1063 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1064 (should (string-equal
1065 (file-remote-p "/[-/user@host]" 'method) "default-method"))
1066 (should (string-equal (file-remote-p "/[-/user@host]" 'user) "user"))
1067 (should (string-equal (file-remote-p "/[-/user@host]" 'host) "host"))
1068 (should (string-equal (file-remote-p "/[-/user@host]" 'localname) ""))
1069 (should (string-equal (file-remote-p "/[-/user@host]" 'hop) nil))
1071 ;; Expand `tramp-default-user'.
1072 (should (string-equal
1073 (file-remote-p "/[method/host]")
1074 (format "/[%s/%s@%s]" "method" "default-user" "host")))
1075 (should (string-equal
1076 (file-remote-p "/[method/host]" 'method) "method"))
1077 (should (string-equal
1078 (file-remote-p "/[method/host]" 'user) "default-user"))
1079 (should (string-equal (file-remote-p "/[method/host]" 'host) "host"))
1080 (should (string-equal (file-remote-p "/[method/host]" 'localname) ""))
1081 (should (string-equal (file-remote-p "/[method/host]" 'hop) nil))
1083 ;; Expand `tramp-default-host'.
1084 (should (string-equal
1085 (file-remote-p "/[method/user@]")
1086 (format "/[%s/%s@%s]" "method" "user" "default-host")))
1087 (should (string-equal
1088 (file-remote-p "/[method/user@]" 'method) "method"))
1089 (should (string-equal (file-remote-p "/[method/user@]" 'user) "user"))
1090 (should (string-equal
1091 (file-remote-p "/[method/user@]" 'host) "default-host"))
1092 (should (string-equal
1093 (file-remote-p "/[method/user@]" 'localname) ""))
1094 (should (string-equal (file-remote-p "/[method/user@]" 'hop) nil))
1096 ;; No expansion.
1097 (should (string-equal
1098 (file-remote-p "/[method/user@host]")
1099 (format "/[%s/%s@%s]" "method" "user" "host")))
1100 (should (string-equal
1101 (file-remote-p "/[method/user@host]" 'method) "method"))
1102 (should (string-equal
1103 (file-remote-p "/[method/user@host]" 'user) "user"))
1104 (should (string-equal
1105 (file-remote-p "/[method/user@host]" 'host) "host"))
1106 (should (string-equal
1107 (file-remote-p "/[method/user@host]" 'localname) ""))
1108 (should (string-equal
1109 (file-remote-p "/[method/user@host]" 'hop) nil))
1111 ;; No expansion.
1112 (should (string-equal
1113 (file-remote-p "/[method/user@email@host]")
1114 (format "/[%s/%s@%s]" "method" "user@email" "host")))
1115 (should (string-equal
1116 (file-remote-p
1117 "/[method/user@email@host]" 'method) "method"))
1118 (should (string-equal
1119 (file-remote-p
1120 "/[method/user@email@host]" 'user) "user@email"))
1121 (should (string-equal
1122 (file-remote-p "/[method/user@email@host]" 'host) "host"))
1123 (should (string-equal
1124 (file-remote-p "/[method/user@email@host]" 'localname) ""))
1125 (should (string-equal
1126 (file-remote-p "/[method/user@email@host]" 'hop) nil))
1128 ;; Expand `tramp-default-method' and `tramp-default-user'.
1129 (should (string-equal
1130 (file-remote-p "/[/host#1234]")
1131 (format
1132 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1133 (should (string-equal
1134 (file-remote-p "/[/host#1234]" 'method) "default-method"))
1135 (should (string-equal
1136 (file-remote-p "/[/host#1234]" 'user) "default-user"))
1137 (should (string-equal
1138 (file-remote-p "/[/host#1234]" 'host) "host#1234"))
1139 (should (string-equal (file-remote-p "/[/host#1234]" 'localname) ""))
1140 (should (string-equal (file-remote-p "/[/host#1234]" 'hop) nil))
1142 ;; Expand `tramp-default-method'.
1143 (should (string-equal
1144 (file-remote-p "/[/user@host#1234]")
1145 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1146 (should (string-equal
1147 (file-remote-p
1148 "/[/user@host#1234]" 'method) "default-method"))
1149 (should (string-equal
1150 (file-remote-p
1151 "/[/user@host#1234]" 'user) "user"))
1152 (should (string-equal
1153 (file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
1154 (should (string-equal
1155 (file-remote-p "/[/user@host#1234]" 'localname) ""))
1156 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop) nil))
1158 ;; Expand `tramp-default-method' and `tramp-default-user'.
1159 (should (string-equal
1160 (file-remote-p "/[-/host#1234]")
1161 (format
1162 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1163 (should (string-equal
1164 (file-remote-p "/[-/host#1234]" 'method) "default-method"))
1165 (should (string-equal
1166 (file-remote-p "/[-/host#1234]" 'user) "default-user"))
1167 (should (string-equal
1168 (file-remote-p "/[-/host#1234]" 'host) "host#1234"))
1169 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname) ""))
1170 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop) nil))
1172 ;; Expand `tramp-default-method'.
1173 (should (string-equal
1174 (file-remote-p "/[-/user@host#1234]")
1175 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1176 (should (string-equal
1177 (file-remote-p
1178 "/[-/user@host#1234]" 'method) "default-method"))
1179 (should (string-equal
1180 (file-remote-p
1181 "/[-/user@host#1234]" 'user) "user"))
1182 (should (string-equal
1183 (file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
1184 (should (string-equal
1185 (file-remote-p "/[-/user@host#1234]" 'localname) ""))
1186 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop) nil))
1188 ;; Expand `tramp-default-user'.
1189 (should (string-equal
1190 (file-remote-p "/[method/host#1234]")
1191 (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1192 (should (string-equal
1193 (file-remote-p "/[method/host#1234]" 'method) "method"))
1194 (should (string-equal
1195 (file-remote-p "/[method/host#1234]" 'user) "default-user"))
1196 (should (string-equal
1197 (file-remote-p "/[method/host#1234]" 'host) "host#1234"))
1198 (should (string-equal
1199 (file-remote-p "/[method/host#1234]" 'localname) ""))
1200 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop) nil))
1202 ;; No expansion.
1203 (should (string-equal
1204 (file-remote-p "/[method/user@host#1234]")
1205 (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1206 (should (string-equal
1207 (file-remote-p "/[method/user@host#1234]" 'method) "method"))
1208 (should (string-equal
1209 (file-remote-p "/[method/user@host#1234]" 'user) "user"))
1210 (should (string-equal
1211 (file-remote-p
1212 "/[method/user@host#1234]" 'host) "host#1234"))
1213 (should (string-equal
1214 (file-remote-p "/[method/user@host#1234]" 'localname) ""))
1215 (should (string-equal
1216 (file-remote-p "/[method/user@host#1234]" 'hop) nil))
1218 ;; Expand `tramp-default-method' and `tramp-default-user'.
1219 (should (string-equal
1220 (file-remote-p "/[/1.2.3.4]")
1221 (format
1222 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1223 (should (string-equal
1224 (file-remote-p "/[/1.2.3.4]" 'method) "default-method"))
1225 (should (string-equal
1226 (file-remote-p "/[/1.2.3.4]" 'user) "default-user"))
1227 (should (string-equal
1228 (file-remote-p "/[/1.2.3.4]" 'host) "1.2.3.4"))
1229 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname) ""))
1230 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop) nil))
1232 ;; Expand `tramp-default-method'.
1233 (should (string-equal
1234 (file-remote-p "/[/user@1.2.3.4]")
1235 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1236 (should (string-equal
1237 (file-remote-p
1238 "/[/user@1.2.3.4]" 'method) "default-method"))
1239 (should (string-equal
1240 (file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
1241 (should (string-equal
1242 (file-remote-p "/[/user@1.2.3.4]" 'host) "1.2.3.4"))
1243 (should (string-equal
1244 (file-remote-p "/[/user@1.2.3.4]" 'localname) ""))
1245 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop) nil))
1247 ;; Expand `tramp-default-method' and `tramp-default-user'.
1248 (should (string-equal
1249 (file-remote-p "/[-/1.2.3.4]")
1250 (format
1251 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1252 (should (string-equal
1253 (file-remote-p "/[-/1.2.3.4]" 'method) "default-method"))
1254 (should (string-equal
1255 (file-remote-p "/[-/1.2.3.4]" 'user) "default-user"))
1256 (should (string-equal
1257 (file-remote-p "/[-/1.2.3.4]" 'host) "1.2.3.4"))
1258 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname) ""))
1259 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop) nil))
1261 ;; Expand `tramp-default-method'.
1262 (should (string-equal
1263 (file-remote-p "/[-/user@1.2.3.4]")
1264 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1265 (should (string-equal
1266 (file-remote-p
1267 "/[-/user@1.2.3.4]" 'method) "default-method"))
1268 (should (string-equal
1269 (file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
1270 (should (string-equal
1271 (file-remote-p "/[-/user@1.2.3.4]" 'host) "1.2.3.4"))
1272 (should (string-equal
1273 (file-remote-p "/[-/user@1.2.3.4]" 'localname) ""))
1274 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop) nil))
1276 ;; Expand `tramp-default-user'.
1277 (should (string-equal
1278 (file-remote-p "/[method/1.2.3.4]")
1279 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1280 (should (string-equal
1281 (file-remote-p "/[method/1.2.3.4]" 'method) "method"))
1282 (should (string-equal
1283 (file-remote-p "/[method/1.2.3.4]" 'user) "default-user"))
1284 (should (string-equal
1285 (file-remote-p "/[method/1.2.3.4]" 'host) "1.2.3.4"))
1286 (should (string-equal
1287 (file-remote-p "/[method/1.2.3.4]" 'localname) ""))
1288 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop) nil))
1290 ;; No expansion.
1291 (should (string-equal
1292 (file-remote-p "/[method/user@1.2.3.4]")
1293 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1294 (should (string-equal
1295 (file-remote-p "/[method/user@1.2.3.4]" 'method) "method"))
1296 (should (string-equal
1297 (file-remote-p "/[method/user@1.2.3.4]" 'user) "user"))
1298 (should (string-equal
1299 (file-remote-p "/[method/user@1.2.3.4]" 'host) "1.2.3.4"))
1300 (should (string-equal
1301 (file-remote-p "/[method/user@1.2.3.4]" 'localname) ""))
1302 (should (string-equal
1303 (file-remote-p "/[method/user@1.2.3.4]" 'hop) nil))
1305 ;; Expand `tramp-default-method', `tramp-default-user' and
1306 ;; `tramp-default-host'.
1307 (should (string-equal
1308 (file-remote-p "/[/]")
1309 (format
1310 "/[%s/%s@%s]"
1311 "default-method" "default-user" "default-host")))
1312 (should (string-equal
1313 (file-remote-p "/[/]" 'method) "default-method"))
1314 (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1315 (should (string-equal (file-remote-p "/[/]" 'host) "default-host"))
1316 (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1317 (should (string-equal (file-remote-p "/[/]" 'hop) nil))
1319 ;; Expand `tramp-default-method' and `tramp-default-user'.
1320 (let ((tramp-default-host "::1"))
1321 (should (string-equal
1322 (file-remote-p "/[/]")
1323 (format
1324 "/[%s/%s@%s]"
1325 "default-method" "default-user" "::1")))
1326 (should (string-equal
1327 (file-remote-p "/[/]" 'method) "default-method"))
1328 (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1329 (should (string-equal (file-remote-p "/[/]" 'host) "::1"))
1330 (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1331 (should (string-equal (file-remote-p "/[/]" 'hop) nil)))
1333 ;; Expand `tramp-default-method' and `tramp-default-user'.
1334 (should (string-equal
1335 (file-remote-p "/[/::1]")
1336 (format
1337 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1338 (should (string-equal
1339 (file-remote-p "/[/::1]" 'method) "default-method"))
1340 (should (string-equal
1341 (file-remote-p "/[/::1]" 'user) "default-user"))
1342 (should (string-equal (file-remote-p "/[/::1]" 'host) "::1"))
1343 (should (string-equal (file-remote-p "/[/::1]" 'localname) ""))
1344 (should (string-equal (file-remote-p "/[/::1]" 'hop) nil))
1346 ;; Expand `tramp-default-method'.
1347 (should (string-equal
1348 (file-remote-p "/[/user@::1]")
1349 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1350 (should (string-equal
1351 (file-remote-p "/[/user@::1]" 'method) "default-method"))
1352 (should (string-equal (file-remote-p "/[/user@::1]" 'user) "user"))
1353 (should (string-equal (file-remote-p "/[/user@::1]" 'host) "::1"))
1354 (should (string-equal (file-remote-p "/[/user@::1]" 'localname) ""))
1355 (should (string-equal (file-remote-p "/[/user@::1]" 'hop) nil))
1357 ;; Expand `tramp-default-method', `tramp-default-user' and
1358 ;; `tramp-default-host'.
1359 (should (string-equal
1360 (file-remote-p "/[-/]")
1361 (format
1362 "/[%s/%s@%s]"
1363 "default-method" "default-user" "default-host")))
1364 (should (string-equal
1365 (file-remote-p "/[-/]" 'method) "default-method"))
1366 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1367 (should (string-equal (file-remote-p "/[-/]" 'host) "default-host"))
1368 (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1369 (should (string-equal (file-remote-p "/[-/]" 'hop) nil))
1371 ;; Expand `tramp-default-method' and `tramp-default-user'.
1372 (let ((tramp-default-host "::1"))
1373 (should (string-equal
1374 (file-remote-p "/[-/]")
1375 (format
1376 "/[%s/%s@%s]"
1377 "default-method" "default-user" "::1")))
1378 (should (string-equal
1379 (file-remote-p "/[-/]" 'method) "default-method"))
1380 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1381 (should (string-equal (file-remote-p "/[-/]" 'host) "::1"))
1382 (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1383 (should (string-equal (file-remote-p "/[-/]" 'hop) nil)))
1385 ;; Expand `tramp-default-method' and `tramp-default-user'.
1386 (should (string-equal
1387 (file-remote-p "/[-/::1]")
1388 (format
1389 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1390 (should (string-equal
1391 (file-remote-p "/[-/::1]" 'method) "default-method"))
1392 (should (string-equal
1393 (file-remote-p "/[-/::1]" 'user) "default-user"))
1394 (should (string-equal (file-remote-p "/[-/::1]" 'host) "::1"))
1395 (should (string-equal (file-remote-p "/[-/::1]" 'localname) ""))
1396 (should (string-equal (file-remote-p "/[-/::1]" 'hop) nil))
1398 ;; Expand `tramp-default-method'.
1399 (should (string-equal
1400 (file-remote-p "/[-/user@::1]")
1401 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1402 (should (string-equal
1403 (file-remote-p "/[-/user@::1]" 'method) "default-method"))
1404 (should (string-equal (file-remote-p "/[-/user@::1]" 'user) "user"))
1405 (should (string-equal (file-remote-p "/[-/user@::1]" 'host) "::1"))
1406 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname) ""))
1407 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop) nil))
1409 ;; Expand `tramp-default-user'.
1410 (should (string-equal
1411 (file-remote-p "/[method/::1]")
1412 (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1413 (should (string-equal
1414 (file-remote-p "/[method/::1]" 'method) "method"))
1415 (should (string-equal
1416 (file-remote-p "/[method/::1]" 'user) "default-user"))
1417 (should (string-equal (file-remote-p "/[method/::1]" 'host) "::1"))
1418 (should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
1419 (should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
1421 ;; No expansion.
1422 (should (string-equal
1423 (file-remote-p "/[method/user@::1]")
1424 (format "/[%s/%s@%s]" "method" "user" "::1")))
1425 (should (string-equal
1426 (file-remote-p "/[method/user@::1]" 'method) "method"))
1427 (should (string-equal
1428 (file-remote-p "/[method/user@::1]" 'user) "user"))
1429 (should (string-equal
1430 (file-remote-p "/[method/user@::1]" 'host) "::1"))
1431 (should (string-equal
1432 (file-remote-p "/[method/user@::1]" 'localname) ""))
1433 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
1435 ;; Local file name part.
1436 (should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
1437 (should (string-equal (file-remote-p "/[-/host]/:" 'localname) "/:"))
1438 (should (string-equal (file-remote-p "/[method/]:" 'localname) ":"))
1439 (should (string-equal (file-remote-p "/[method/] " 'localname) " "))
1440 (should (string-equal
1441 (file-remote-p "/[method/]file" 'localname) "file"))
1442 (should (string-equal
1443 (file-remote-p "/[method/]/path/to/file" 'localname)
1444 "/path/to/file"))
1446 ;; Multihop.
1447 (should
1448 (string-equal
1449 (file-remote-p
1450 "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1451 (format "/[%s/%s@%s|%s/%s@%s]"
1452 "method1" "user1" "host1" "method2" "user2" "host2")))
1453 (should
1454 (string-equal
1455 (file-remote-p
1456 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method)
1457 "method2"))
1458 (should
1459 (string-equal
1460 (file-remote-p
1461 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
1462 "user2"))
1463 (should
1464 (string-equal
1465 (file-remote-p
1466 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
1467 "host2"))
1468 (should
1469 (string-equal
1470 (file-remote-p
1471 "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1472 'localname)
1473 "/path/to/file"))
1474 (should
1475 (string-equal
1476 (file-remote-p
1477 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
1478 (format "%s/%s@%s|"
1479 "method1" "user1" "host1")))
1481 (should
1482 (string-equal
1483 (file-remote-p
1484 (concat
1485 "/[method1/user1@host1"
1486 "|method2/user2@host2"
1487 "|method3/user3@host3]/path/to/file"))
1488 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1489 "method1" "user1" "host1"
1490 "method2" "user2" "host2"
1491 "method3" "user3" "host3")))
1492 (should
1493 (string-equal
1494 (file-remote-p
1495 (concat
1496 "/[method1/user1@host1"
1497 "|method2/user2@host2"
1498 "|method3/user3@host3]/path/to/file")
1499 'method)
1500 "method3"))
1501 (should
1502 (string-equal
1503 (file-remote-p
1504 (concat
1505 "/[method1/user1@host1"
1506 "|method2/user2@host2"
1507 "|method3/user3@host3]/path/to/file")
1508 'user)
1509 "user3"))
1510 (should
1511 (string-equal
1512 (file-remote-p
1513 (concat
1514 "/[method1/user1@host1"
1515 "|method2/user2@host2"
1516 "|method3/user3@host3]/path/to/file")
1517 'host)
1518 "host3"))
1519 (should
1520 (string-equal
1521 (file-remote-p
1522 (concat
1523 "/[method1/user1@host1"
1524 "|method2/user2@host2"
1525 "|method3/user3@host3]/path/to/file")
1526 'localname)
1527 "/path/to/file"))
1528 (should
1529 (string-equal
1530 (file-remote-p
1531 (concat
1532 "/[method1/user1@host1"
1533 "|method2/user2@host2"
1534 "|method3/user3@host3]/path/to/file")
1535 'hop)
1536 (format "%s/%s@%s|%s/%s@%s|"
1537 "method1" "user1" "host1" "method2" "user2" "host2"))))
1539 ;; Exit.
1540 (tramp-change-syntax syntax))))
1542 (ert-deftest tramp-test03-file-name-defaults ()
1543 "Check default values for some methods."
1544 ;; Default values in tramp-adb.el.
1545 (should (string-equal (file-remote-p "/adb::" 'host) ""))
1546 ;; Default values in tramp-ftp.el.
1547 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
1548 (dolist (u '("ftp" "anonymous"))
1549 (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))
1550 ;; Default values in tramp-gvfs.el.
1551 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
1552 (symbol-value 'tramp-gvfs-enabled))
1553 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
1554 ;; Default values in tramp-sh.el.
1555 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1556 (should
1557 (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
1558 (dolist (m '("su" "sudo" "ksu"))
1559 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
1560 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1561 (should
1562 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
1563 ;; Default values in tramp-smb.el.
1564 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
1566 (ert-deftest tramp-test04-substitute-in-file-name ()
1567 "Check `substitute-in-file-name'."
1568 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
1569 (should
1570 (string-equal
1571 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1572 (should
1573 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1574 ;; Quoting local part.
1575 (should
1576 (string-equal
1577 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1578 (should
1579 (string-equal
1580 (substitute-in-file-name "/method:host:/:/path//foo")
1581 "/method:host:/:/path//foo"))
1582 (should
1583 (string-equal
1584 (substitute-in-file-name "/method:host:/:/path///foo")
1585 "/method:host:/:/path///foo"))
1587 (should
1588 (string-equal
1589 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
1590 (should
1591 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
1592 ;; Quoting local part.
1593 (should
1594 (string-equal
1595 (substitute-in-file-name "/method:host:/:/path/~/foo")
1596 "/method:host:/:/path/~/foo"))
1597 (should
1598 (string-equal
1599 (substitute-in-file-name "/method:host:/:/path//~/foo")
1600 "/method:host:/:/path//~/foo"))
1602 (let (process-environment)
1603 (should
1604 (string-equal
1605 (substitute-in-file-name "/method:host:/path/$FOO")
1606 "/method:host:/path/$FOO"))
1607 (setenv "FOO" "bla")
1608 (should
1609 (string-equal
1610 (substitute-in-file-name "/method:host:/path/$FOO")
1611 "/method:host:/path/bla"))
1612 (should
1613 (string-equal
1614 (substitute-in-file-name "/method:host:/path/$$FOO")
1615 "/method:host:/path/$FOO"))
1616 ;; Quoting local part.
1617 (should
1618 (string-equal
1619 (substitute-in-file-name "/method:host:/:/path/$FOO")
1620 "/method:host:/:/path/$FOO"))
1621 (setenv "FOO" "bla")
1622 (should
1623 (string-equal
1624 (substitute-in-file-name "/method:host:/:/path/$FOO")
1625 "/method:host:/:/path/$FOO"))
1626 (should
1627 (string-equal
1628 (substitute-in-file-name "/method:host:/:/path/$$FOO")
1629 "/method:host:/:/path/$$FOO"))))
1631 (ert-deftest tramp-test05-expand-file-name ()
1632 "Check `expand-file-name'."
1633 (should
1634 (string-equal
1635 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1636 (should
1637 (string-equal
1638 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1639 ;; Quoting local part.
1640 (should
1641 (string-equal
1642 (expand-file-name "/method:host:/:/path/./file")
1643 "/method:host:/:/path/file"))
1644 (should
1645 (string-equal
1646 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1647 (should
1648 (string-equal
1649 (expand-file-name "/method:host:/:/~/path/./file")
1650 "/method:host:/:/~/path/file")))
1652 ;; The following test is inspired by Bug#26911. It is rather a bug in
1653 ;; `expand-file-name', and it fails for all Emacs versions. Test
1654 ;; added for later, when it is fixed.
1655 (ert-deftest tramp-test05-expand-file-name-relative ()
1656 "Check `expand-file-name'."
1657 ;; Mark as failed until bug has been fixed.
1658 :expected-result :failed
1659 (skip-unless (tramp--test-enabled))
1660 ;; These are the methods the test doesn't fail.
1661 (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1662 (tramp-smb-file-name-p tramp-test-temporary-file-directory))
1663 (setf (ert-test-expected-result-type
1664 (ert-get-test 'tramp-test05-expand-file-name-relative))
1665 :passed))
1667 (should
1668 (string-equal
1669 (let ((default-directory
1670 (concat
1671 (file-remote-p tramp-test-temporary-file-directory) "/path")))
1672 (expand-file-name ".." "./"))
1673 (concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
1675 (ert-deftest tramp-test06-directory-file-name ()
1676 "Check `directory-file-name'.
1677 This checks also `file-name-as-directory', `file-name-directory',
1678 `file-name-nondirectory' and `unhandled-file-name-directory'."
1679 (should
1680 (string-equal
1681 (directory-file-name "/method:host:/path/to/file")
1682 "/method:host:/path/to/file"))
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 (file-name-as-directory "/method:host:/path/to/file")
1690 "/method:host:/path/to/file/"))
1691 (should
1692 (string-equal
1693 (file-name-as-directory "/method:host:/path/to/file/")
1694 "/method:host:/path/to/file/"))
1695 (should
1696 (string-equal
1697 (file-name-directory "/method:host:/path/to/file")
1698 "/method:host:/path/to/"))
1699 (should
1700 (string-equal
1701 (file-name-directory "/method:host:/path/to/file/")
1702 "/method:host:/path/to/file/"))
1703 (should
1704 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1705 (should
1706 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1707 (should-not
1708 (unhandled-file-name-directory "/method:host:/path/to/file"))
1710 ;; Bug#10085.
1711 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1712 (dolist (n-e '(nil t))
1713 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1714 ;; which ruins the tests.
1715 (let ((non-essential n-e)
1716 tramp-default-method)
1717 (dolist
1718 (file
1719 `(,(format
1720 "/%s::"
1721 (file-remote-p tramp-test-temporary-file-directory 'method))
1722 ,(format
1723 "/-:%s:"
1724 (file-remote-p tramp-test-temporary-file-directory 'host))))
1725 (should (string-equal (directory-file-name file) file))
1726 (should
1727 (string-equal
1728 (file-name-as-directory file)
1729 (if (tramp-completion-mode-p)
1730 file (concat file "./"))))
1731 (should (string-equal (file-name-directory file) file))
1732 (should (string-equal (file-name-nondirectory file) "")))))))
1734 (ert-deftest tramp-test07-file-exists-p ()
1735 "Check `file-exist-p', `write-region' and `delete-file'."
1736 (skip-unless (tramp--test-enabled))
1738 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1739 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1740 (should-not (file-exists-p tmp-name))
1741 (write-region "foo" nil tmp-name)
1742 (should (file-exists-p tmp-name))
1743 (delete-file tmp-name)
1744 (should-not (file-exists-p tmp-name)))))
1746 (ert-deftest tramp-test08-file-local-copy ()
1747 "Check `file-local-copy'."
1748 (skip-unless (tramp--test-enabled))
1750 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1751 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1752 tmp-name2)
1753 (unwind-protect
1754 (progn
1755 (write-region "foo" nil tmp-name1)
1756 (should (setq tmp-name2 (file-local-copy tmp-name1)))
1757 (with-temp-buffer
1758 (insert-file-contents tmp-name2)
1759 (should (string-equal (buffer-string) "foo")))
1760 ;; Check also that a file transfer with compression works.
1761 (let ((default-directory tramp-test-temporary-file-directory)
1762 (tramp-copy-size-limit 4)
1763 (tramp-inline-compress-start-size 2))
1764 (delete-file tmp-name2)
1765 (should (setq tmp-name2 (file-local-copy tmp-name1))))
1766 ;; Error case.
1767 (delete-file tmp-name1)
1768 (delete-file tmp-name2)
1769 (should-error
1770 (setq tmp-name2 (file-local-copy tmp-name1))
1771 :type tramp-file-missing))
1773 ;; Cleanup.
1774 (ignore-errors
1775 (delete-file tmp-name1)
1776 (delete-file tmp-name2))))))
1778 (ert-deftest tramp-test09-insert-file-contents ()
1779 "Check `insert-file-contents'."
1780 (skip-unless (tramp--test-enabled))
1782 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1783 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1784 (unwind-protect
1785 (with-temp-buffer
1786 (write-region "foo" nil tmp-name)
1787 (insert-file-contents tmp-name)
1788 (should (string-equal (buffer-string) "foo"))
1789 (insert-file-contents tmp-name)
1790 (should (string-equal (buffer-string) "foofoo"))
1791 ;; Insert partly.
1792 (insert-file-contents tmp-name nil 1 3)
1793 (should (string-equal (buffer-string) "oofoofoo"))
1794 ;; Replace.
1795 (insert-file-contents tmp-name nil nil nil 'replace)
1796 (should (string-equal (buffer-string) "foo"))
1797 ;; Error case.
1798 (delete-file tmp-name)
1799 (should-error
1800 (insert-file-contents tmp-name)
1801 :type tramp-file-missing))
1803 ;; Cleanup.
1804 (ignore-errors (delete-file tmp-name))))))
1806 (ert-deftest tramp-test10-write-region ()
1807 "Check `write-region'."
1808 (skip-unless (tramp--test-enabled))
1810 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1811 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1812 (unwind-protect
1813 (progn
1814 ;; Write buffer. Use absolute and relative file name.
1815 (with-temp-buffer
1816 (insert "foo")
1817 (write-region nil nil tmp-name))
1818 (with-temp-buffer
1819 (insert-file-contents tmp-name)
1820 (should (string-equal (buffer-string) "foo")))
1821 (delete-file tmp-name)
1822 (with-temp-buffer
1823 (insert "foo")
1824 (should-not (file-exists-p tmp-name))
1825 (let ((default-directory (file-name-directory tmp-name)))
1826 (should-not (file-exists-p (file-name-nondirectory tmp-name)))
1827 (write-region nil nil (file-name-nondirectory tmp-name))
1828 (should (file-exists-p (file-name-nondirectory tmp-name))))
1829 (should (file-exists-p tmp-name)))
1830 (with-temp-buffer
1831 (insert-file-contents tmp-name)
1832 (should (string-equal (buffer-string) "foo")))
1834 ;; Append.
1835 (with-temp-buffer
1836 (insert "bla")
1837 (write-region nil nil tmp-name 'append))
1838 (with-temp-buffer
1839 (insert-file-contents tmp-name)
1840 (should (string-equal (buffer-string) "foobla")))
1841 (with-temp-buffer
1842 (insert "baz")
1843 (write-region nil nil tmp-name 3))
1844 (with-temp-buffer
1845 (insert-file-contents tmp-name)
1846 (should (string-equal (buffer-string) "foobaz")))
1848 ;; Write string.
1849 (write-region "foo" nil tmp-name)
1850 (with-temp-buffer
1851 (insert-file-contents tmp-name)
1852 (should (string-equal (buffer-string) "foo")))
1854 ;; Write partly.
1855 (with-temp-buffer
1856 (insert "123456789")
1857 (write-region 3 5 tmp-name))
1858 (with-temp-buffer
1859 (insert-file-contents tmp-name)
1860 (should (string-equal (buffer-string) "34")))
1862 ;; Do not overwrite if excluded.
1863 (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)))
1864 (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1865 ;; `mustbenew' is passed to Tramp since Emacs 26.1. We
1866 ;; have no test for this, so we check function
1867 ;; `temporary-file-directory', which has been added to
1868 ;; Emacs 26.1 as well.
1869 (when (fboundp 'temporary-file-directory)
1870 (should-error
1871 (cl-letf (((symbol-function 'y-or-n-p) 'ignore))
1872 (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1873 :type 'file-already-exists)
1874 (should-error
1875 (write-region "foo" nil tmp-name nil nil nil 'excl)
1876 :type 'file-already-exists)))
1878 ;; Cleanup.
1879 (ignore-errors (delete-file tmp-name))))))
1881 (ert-deftest tramp-test11-copy-file ()
1882 "Check `copy-file'."
1883 (skip-unless (tramp--test-enabled))
1885 ;; TODO: The quoted case does not work.
1886 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1887 (let (quoted)
1888 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1889 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1890 (tmp-name3 (tramp--test-make-temp-name nil quoted))
1891 (tmp-name4 (tramp--test-make-temp-name 'local quoted))
1892 (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
1894 ;; Copy on remote side.
1895 (unwind-protect
1896 (progn
1897 (write-region "foo" nil tmp-name1)
1898 (copy-file tmp-name1 tmp-name2)
1899 (should (file-exists-p tmp-name2))
1900 (with-temp-buffer
1901 (insert-file-contents tmp-name2)
1902 (should (string-equal (buffer-string) "foo")))
1903 (should-error
1904 (copy-file tmp-name1 tmp-name2)
1905 :type 'file-already-exists)
1906 (copy-file tmp-name1 tmp-name2 'ok)
1907 (make-directory tmp-name3)
1908 (should-error
1909 (copy-file tmp-name1 tmp-name3)
1910 :type 'file-already-exists)
1911 (copy-file tmp-name1 (file-name-as-directory tmp-name3))
1912 (should
1913 (file-exists-p
1914 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
1916 ;; Cleanup.
1917 (ignore-errors (delete-file tmp-name1))
1918 (ignore-errors (delete-file tmp-name2))
1919 (ignore-errors (delete-directory tmp-name3 'recursive)))
1921 ;; Copy from remote side to local side.
1922 (unwind-protect
1923 (progn
1924 (write-region "foo" nil tmp-name1)
1925 (copy-file tmp-name1 tmp-name4)
1926 (should (file-exists-p tmp-name4))
1927 (with-temp-buffer
1928 (insert-file-contents tmp-name4)
1929 (should (string-equal (buffer-string) "foo")))
1930 (should-error
1931 (copy-file tmp-name1 tmp-name4)
1932 :type 'file-already-exists)
1933 (copy-file tmp-name1 tmp-name4 'ok)
1934 (make-directory tmp-name5)
1935 (should-error
1936 (copy-file tmp-name1 tmp-name5)
1937 :type 'file-already-exists)
1938 (copy-file tmp-name1 (file-name-as-directory tmp-name5))
1939 (should
1940 (file-exists-p
1941 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
1943 ;; Cleanup.
1944 (ignore-errors (delete-file tmp-name1))
1945 (ignore-errors (delete-file tmp-name4))
1946 (ignore-errors (delete-directory tmp-name5 'recursive)))
1948 ;; Copy from local side to remote side.
1949 (unwind-protect
1950 (progn
1951 (write-region "foo" nil tmp-name4 nil 'nomessage)
1952 (copy-file tmp-name4 tmp-name1)
1953 (should (file-exists-p tmp-name1))
1954 (with-temp-buffer
1955 (insert-file-contents tmp-name1)
1956 (should (string-equal (buffer-string) "foo")))
1957 (should-error
1958 (copy-file tmp-name4 tmp-name1)
1959 :type 'file-already-exists)
1960 (copy-file tmp-name4 tmp-name1 'ok)
1961 (make-directory tmp-name3)
1962 (should-error
1963 (copy-file tmp-name4 tmp-name3)
1964 :type 'file-already-exists)
1965 (copy-file tmp-name4 (file-name-as-directory tmp-name3))
1966 (should
1967 (file-exists-p
1968 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
1970 ;; Cleanup.
1971 (ignore-errors (delete-file tmp-name1))
1972 (ignore-errors (delete-file tmp-name4))
1973 (ignore-errors (delete-directory tmp-name3 'recursive))))))
1975 (ert-deftest tramp-test12-rename-file ()
1976 "Check `rename-file'."
1977 (skip-unless (tramp--test-enabled))
1979 ;; TODO: The quoted case does not work.
1980 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1981 (let (quoted)
1982 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1983 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1984 (tmp-name3 (tramp--test-make-temp-name nil quoted))
1985 (tmp-name4 (tramp--test-make-temp-name 'local quoted))
1986 (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
1988 ;; Rename on remote side.
1989 (unwind-protect
1990 (progn
1991 (write-region "foo" nil tmp-name1)
1992 (rename-file tmp-name1 tmp-name2)
1993 (should-not (file-exists-p tmp-name1))
1994 (should (file-exists-p tmp-name2))
1995 (with-temp-buffer
1996 (insert-file-contents tmp-name2)
1997 (should (string-equal (buffer-string) "foo")))
1998 (write-region "foo" nil tmp-name1)
1999 (should-error
2000 (rename-file tmp-name1 tmp-name2)
2001 :type 'file-already-exists)
2002 (rename-file tmp-name1 tmp-name2 'ok)
2003 (should-not (file-exists-p tmp-name1))
2004 (write-region "foo" nil tmp-name1)
2005 (make-directory tmp-name3)
2006 (should-error
2007 (rename-file tmp-name1 tmp-name3)
2008 :type 'file-already-exists)
2009 (rename-file tmp-name1 (file-name-as-directory tmp-name3))
2010 (should-not (file-exists-p tmp-name1))
2011 (should
2012 (file-exists-p
2013 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
2015 ;; Cleanup.
2016 (ignore-errors (delete-file tmp-name1))
2017 (ignore-errors (delete-file tmp-name2))
2018 (ignore-errors (delete-directory tmp-name3 'recursive)))
2020 ;; Rename from remote side to local side.
2021 (unwind-protect
2022 (progn
2023 (write-region "foo" nil tmp-name1)
2024 (rename-file tmp-name1 tmp-name4)
2025 (should-not (file-exists-p tmp-name1))
2026 (should (file-exists-p tmp-name4))
2027 (with-temp-buffer
2028 (insert-file-contents tmp-name4)
2029 (should (string-equal (buffer-string) "foo")))
2030 (write-region "foo" nil tmp-name1)
2031 (should-error
2032 (rename-file tmp-name1 tmp-name4)
2033 :type 'file-already-exists)
2034 (rename-file tmp-name1 tmp-name4 'ok)
2035 (should-not (file-exists-p tmp-name1))
2036 (write-region "foo" nil tmp-name1)
2037 (make-directory tmp-name5)
2038 (should-error
2039 (rename-file tmp-name1 tmp-name5)
2040 :type 'file-already-exists)
2041 (rename-file tmp-name1 (file-name-as-directory tmp-name5))
2042 (should-not (file-exists-p tmp-name1))
2043 (should
2044 (file-exists-p
2045 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
2047 ;; Cleanup.
2048 (ignore-errors (delete-file tmp-name1))
2049 (ignore-errors (delete-file tmp-name4))
2050 (ignore-errors (delete-directory tmp-name5 'recursive)))
2052 ;; Rename from local side to remote side.
2053 (unwind-protect
2054 (progn
2055 (write-region "foo" nil tmp-name4 nil 'nomessage)
2056 (rename-file tmp-name4 tmp-name1)
2057 (should-not (file-exists-p tmp-name4))
2058 (should (file-exists-p tmp-name1))
2059 (with-temp-buffer
2060 (insert-file-contents tmp-name1)
2061 (should (string-equal (buffer-string) "foo")))
2062 (write-region "foo" nil tmp-name4 nil 'nomessage)
2063 (should-error
2064 (rename-file tmp-name4 tmp-name1)
2065 :type 'file-already-exists)
2066 (rename-file tmp-name4 tmp-name1 'ok)
2067 (should-not (file-exists-p tmp-name4))
2068 (write-region "foo" nil tmp-name4 nil 'nomessage)
2069 (make-directory tmp-name3)
2070 (should-error
2071 (rename-file tmp-name4 tmp-name3)
2072 :type 'file-already-exists)
2073 (rename-file tmp-name4 (file-name-as-directory tmp-name3))
2074 (should-not (file-exists-p tmp-name4))
2075 (should
2076 (file-exists-p
2077 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
2079 ;; Cleanup.
2080 (ignore-errors (delete-file tmp-name1))
2081 (ignore-errors (delete-file tmp-name4))
2082 (ignore-errors (delete-directory tmp-name3 'recursive))))))
2084 (ert-deftest tramp-test13-make-directory ()
2085 "Check `make-directory'.
2086 This tests also `file-directory-p' and `file-accessible-directory-p'."
2087 (skip-unless (tramp--test-enabled))
2089 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2090 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2091 (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
2092 (unwind-protect
2093 (progn
2094 (make-directory tmp-name1)
2095 (should (file-directory-p tmp-name1))
2096 (should (file-accessible-directory-p tmp-name1))
2097 (should-error (make-directory tmp-name2) :type 'file-error)
2098 (make-directory tmp-name2 'parents)
2099 (should (file-directory-p tmp-name2))
2100 (should (file-accessible-directory-p tmp-name2)))
2102 ;; Cleanup.
2103 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2105 (ert-deftest tramp-test14-delete-directory ()
2106 "Check `delete-directory'."
2107 (skip-unless (tramp--test-enabled))
2109 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2110 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2111 ;; Delete empty directory.
2112 (make-directory tmp-name)
2113 (should (file-directory-p tmp-name))
2114 (delete-directory tmp-name)
2115 (should-not (file-directory-p tmp-name))
2116 ;; Delete non-empty directory.
2117 (make-directory tmp-name)
2118 (should (file-directory-p tmp-name))
2119 (write-region "foo" nil (expand-file-name "bla" tmp-name))
2120 (should (file-exists-p (expand-file-name "bla" tmp-name)))
2121 (should-error (delete-directory tmp-name) :type 'file-error)
2122 (delete-directory tmp-name 'recursive)
2123 (should-not (file-directory-p tmp-name)))))
2125 (ert-deftest tramp-test15-copy-directory ()
2126 "Check `copy-directory'."
2127 (skip-unless (tramp--test-enabled))
2129 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2130 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2131 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2132 (tmp-name3 (expand-file-name
2133 (file-name-nondirectory tmp-name1) tmp-name2))
2134 (tmp-name4 (expand-file-name "foo" tmp-name1))
2135 (tmp-name5 (expand-file-name "foo" tmp-name2))
2136 (tmp-name6 (expand-file-name "foo" tmp-name3)))
2138 ;; Copy complete directory.
2139 (unwind-protect
2140 (progn
2141 ;; Copy empty directory.
2142 (make-directory tmp-name1)
2143 (write-region "foo" nil tmp-name4)
2144 (should (file-directory-p tmp-name1))
2145 (should (file-exists-p tmp-name4))
2146 (copy-directory tmp-name1 tmp-name2)
2147 (should (file-directory-p tmp-name2))
2148 (should (file-exists-p tmp-name5))
2149 ;; Target directory does exist already.
2150 (should-error
2151 (copy-directory tmp-name1 tmp-name2)
2152 :type 'file-error)
2153 (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
2154 (should (file-directory-p tmp-name3))
2155 (should (file-exists-p tmp-name6)))
2157 ;; Cleanup.
2158 (ignore-errors
2159 (delete-directory tmp-name1 'recursive)
2160 (delete-directory tmp-name2 'recursive)))
2162 ;; Copy directory contents.
2163 (unwind-protect
2164 (progn
2165 ;; Copy empty directory.
2166 (make-directory tmp-name1)
2167 (write-region "foo" nil tmp-name4)
2168 (should (file-directory-p tmp-name1))
2169 (should (file-exists-p tmp-name4))
2170 (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
2171 (should (file-directory-p tmp-name2))
2172 (should (file-exists-p tmp-name5))
2173 ;; Target directory does exist already.
2174 (delete-file tmp-name5)
2175 (should-not (file-exists-p tmp-name5))
2176 (copy-directory
2177 tmp-name1 (file-name-as-directory tmp-name2)
2178 nil 'parents 'contents)
2179 (should (file-directory-p tmp-name2))
2180 (should (file-exists-p tmp-name5))
2181 (should-not (file-directory-p tmp-name3))
2182 (should-not (file-exists-p tmp-name6)))
2184 ;; Cleanup.
2185 (ignore-errors
2186 (delete-directory tmp-name1 'recursive)
2187 (delete-directory tmp-name2 'recursive))))))
2189 (ert-deftest tramp-test16-directory-files ()
2190 "Check `directory-files'."
2191 (skip-unless (tramp--test-enabled))
2193 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2194 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2195 (tmp-name2 (expand-file-name "bla" tmp-name1))
2196 (tmp-name3 (expand-file-name "foo" tmp-name1)))
2197 (unwind-protect
2198 (progn
2199 (make-directory tmp-name1)
2200 (write-region "foo" nil tmp-name2)
2201 (write-region "bla" nil tmp-name3)
2202 (should (file-directory-p tmp-name1))
2203 (should (file-exists-p tmp-name2))
2204 (should (file-exists-p tmp-name3))
2205 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
2206 (should (equal (directory-files tmp-name1 'full)
2207 `(,(concat tmp-name1 "/.")
2208 ,(concat tmp-name1 "/..")
2209 ,tmp-name2 ,tmp-name3)))
2210 (should (equal (directory-files
2211 tmp-name1 nil directory-files-no-dot-files-regexp)
2212 '("bla" "foo")))
2213 (should (equal (directory-files
2214 tmp-name1 'full directory-files-no-dot-files-regexp)
2215 `(,tmp-name2 ,tmp-name3))))
2217 ;; Cleanup.
2218 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2220 ;; This is not a file name handler test. But Tramp needed to apply an
2221 ;; advice for older Emacs versions, so we check that this has been fixed.
2222 (ert-deftest tramp-test16-file-expand-wildcards ()
2223 "Check `file-expand-wildcards'."
2224 (skip-unless (tramp--test-enabled))
2226 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2227 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2228 (tmp-name2 (expand-file-name "foo" tmp-name1))
2229 (tmp-name3 (expand-file-name "bar" tmp-name1))
2230 (tmp-name4 (expand-file-name "baz" tmp-name1))
2231 (default-directory tmp-name1))
2232 (unwind-protect
2233 (progn
2234 (make-directory tmp-name1)
2235 (write-region "foo" nil tmp-name2)
2236 (write-region "bar" nil tmp-name3)
2237 (write-region "baz" nil tmp-name4)
2238 (should (file-directory-p tmp-name1))
2239 (should (file-exists-p tmp-name2))
2240 (should (file-exists-p tmp-name3))
2241 (should (file-exists-p tmp-name4))
2243 ;; We cannot use `sort', it works destructive.
2244 (should (equal (file-expand-wildcards "*")
2245 (seq-sort 'string< '("foo" "bar" "baz"))))
2246 (should (equal (file-expand-wildcards "ba?")
2247 (seq-sort 'string< '("bar" "baz"))))
2248 (should (equal (file-expand-wildcards "ba[rz]")
2249 (seq-sort 'string< '("bar" "baz"))))
2251 (should (equal (file-expand-wildcards "*" 'full)
2252 (seq-sort
2253 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4))))
2254 (should (equal (file-expand-wildcards "ba?" 'full)
2255 (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))
2256 (should (equal (file-expand-wildcards "ba[rz]" 'full)
2257 (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))
2259 (should (equal (file-expand-wildcards (concat tmp-name1 "/" "*"))
2260 (seq-sort
2261 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4))))
2262 (should (equal (file-expand-wildcards (concat tmp-name1 "/" "ba?"))
2263 (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))
2264 (should (equal (file-expand-wildcards
2265 (concat tmp-name1 "/" "ba[rz]"))
2266 (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))))
2268 ;; Cleanup.
2269 (ignore-errors
2270 (delete-directory tmp-name1))))))
2272 (ert-deftest tramp-test17-insert-directory ()
2273 "Check `insert-directory'."
2274 (skip-unless (tramp--test-enabled))
2276 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2277 (let* ((tmp-name1
2278 (expand-file-name (tramp--test-make-temp-name nil quoted)))
2279 (tmp-name2 (expand-file-name "foo" tmp-name1))
2280 ;; We test for the summary line. Keyword "total" could be localized.
2281 (process-environment
2282 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
2283 (unwind-protect
2284 (progn
2285 (make-directory tmp-name1)
2286 (write-region "foo" nil tmp-name2)
2287 (should (file-directory-p tmp-name1))
2288 (should (file-exists-p tmp-name2))
2289 (with-temp-buffer
2290 (insert-directory tmp-name1 nil)
2291 (goto-char (point-min))
2292 (should (looking-at-p (regexp-quote tmp-name1))))
2293 (with-temp-buffer
2294 (insert-directory tmp-name1 "-al")
2295 (goto-char (point-min))
2296 (should
2297 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
2298 (with-temp-buffer
2299 (insert-directory (file-name-as-directory tmp-name1) "-al")
2300 (goto-char (point-min))
2301 (should
2302 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
2303 (with-temp-buffer
2304 (insert-directory
2305 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
2306 (goto-char (point-min))
2307 (should
2308 (looking-at-p
2309 (concat
2310 ;; There might be a summary line.
2311 "\\(total.+[[:digit:]]+\n\\)?"
2312 ;; We don't know in which order ".", ".." and "foo" appear.
2313 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
2315 ;; Cleanup.
2316 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2318 (ert-deftest tramp-test17-dired-with-wildcards ()
2319 "Check `dired' with wildcards."
2320 (skip-unless (tramp--test-enabled))
2321 (skip-unless (tramp--test-sh-p))
2322 ;; Since Emacs 26.1.
2323 (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
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
2329 (expand-file-name (tramp--test-make-temp-name nil quoted)))
2330 (tmp-name3 (expand-file-name "foo" tmp-name1))
2331 (tmp-name4 (expand-file-name "bar" tmp-name2))
2332 (tramp-test-temporary-file-directory
2333 (funcall
2334 (if quoted 'tramp-compat-file-name-quote 'identity)
2335 tramp-test-temporary-file-directory))
2336 buffer)
2337 (unwind-protect
2338 (progn
2339 (make-directory tmp-name1)
2340 (write-region "foo" nil tmp-name3)
2341 (should (file-directory-p tmp-name1))
2342 (should (file-exists-p tmp-name3))
2343 (make-directory tmp-name2)
2344 (write-region "foo" nil tmp-name4)
2345 (should (file-directory-p tmp-name2))
2346 (should (file-exists-p tmp-name4))
2348 ;; Check for expanded directory names.
2349 (with-current-buffer
2350 (setq buffer
2351 (dired-noselect
2352 (expand-file-name
2353 "tramp-test*" tramp-test-temporary-file-directory)))
2354 (goto-char (point-min))
2355 (should
2356 (re-search-forward
2357 (regexp-quote
2358 (file-relative-name
2359 tmp-name1 tramp-test-temporary-file-directory))))
2360 (goto-char (point-min))
2361 (should
2362 (re-search-forward
2363 (regexp-quote
2364 (file-relative-name
2365 tmp-name2 tramp-test-temporary-file-directory)))))
2366 (kill-buffer buffer)
2368 ;; Check for expanded directory and file names.
2369 (with-current-buffer
2370 (setq buffer
2371 (dired-noselect
2372 (expand-file-name
2373 "tramp-test*/*" tramp-test-temporary-file-directory)))
2374 (goto-char (point-min))
2375 (should
2376 (re-search-forward
2377 (regexp-quote
2378 (file-relative-name
2379 tmp-name3 tramp-test-temporary-file-directory))))
2380 (goto-char (point-min))
2381 (should
2382 (re-search-forward
2383 (regexp-quote
2384 (file-relative-name
2385 tmp-name4
2386 tramp-test-temporary-file-directory)))))
2387 (kill-buffer buffer)
2389 ;; Check for special characters.
2390 (setq tmp-name3 (expand-file-name "*?" tmp-name1))
2391 (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
2392 (write-region "foo" nil tmp-name3)
2393 (should (file-exists-p tmp-name3))
2394 (write-region "foo" nil tmp-name4)
2395 (should (file-exists-p tmp-name4))
2397 (with-current-buffer
2398 (setq buffer
2399 (dired-noselect
2400 (expand-file-name
2401 "tramp-test*/*" tramp-test-temporary-file-directory)))
2402 (goto-char (point-min))
2403 (should
2404 (re-search-forward
2405 (regexp-quote
2406 (file-relative-name
2407 tmp-name3 tramp-test-temporary-file-directory))))
2408 (goto-char (point-min))
2409 (should
2410 (re-search-forward
2411 (regexp-quote
2412 (file-relative-name
2413 tmp-name4
2414 tramp-test-temporary-file-directory)))))
2415 (kill-buffer buffer))
2417 ;; Cleanup.
2418 (ignore-errors (kill-buffer buffer))
2419 (ignore-errors (delete-directory tmp-name1 'recursive))
2420 (ignore-errors (delete-directory tmp-name2 'recursive))))))
2422 ;; Method "smb" supports `make-symbolic-link' only if the remote host
2423 ;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
2424 ;; support symbolic links at all.
2425 (defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
2426 "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
2427 (declare (indent defun) (debug t))
2428 `(condition-case err
2429 (progn ,@body)
2430 ((error quit debug)
2431 (unless (and (eq (car err) 'file-error)
2432 (string-equal (error-message-string err)
2433 "make-symbolic-link not supported"))
2434 (signal (car err) (cdr err))))))
2436 (ert-deftest tramp-test18-file-attributes ()
2437 "Check `file-attributes'.
2438 This tests also `file-readable-p', `file-regular-p' and
2439 `file-ownership-preserved-p'."
2440 (skip-unless (tramp--test-enabled))
2442 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2443 ;; We must use `file-truename' for the temporary directory,
2444 ;; because it could be located on a symlinked directory. This
2445 ;; would let the test fail.
2446 (let* ((tramp-test-temporary-file-directory
2447 (file-truename tramp-test-temporary-file-directory))
2448 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2449 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2450 ;; File name with "//".
2451 (tmp-name3
2452 (format
2453 "%s%s"
2454 (file-remote-p tmp-name1)
2455 (replace-regexp-in-string
2456 "/" "//" (file-remote-p tmp-name1 'localname))))
2457 attr)
2458 (unwind-protect
2459 (progn
2460 ;; `file-ownership-preserved-p' should return t for
2461 ;; non-existing files. It is implemented only in tramp-sh.el.
2462 (when (tramp--test-sh-p)
2463 (should (file-ownership-preserved-p tmp-name1 'group)))
2464 (write-region "foo" nil tmp-name1)
2465 (should (file-exists-p tmp-name1))
2466 (should (file-readable-p tmp-name1))
2467 (should (file-regular-p tmp-name1))
2468 (when (tramp--test-sh-p)
2469 (should (file-ownership-preserved-p tmp-name1 'group)))
2471 ;; We do not test inodes and device numbers.
2472 (setq attr (file-attributes tmp-name1))
2473 (should (consp attr))
2474 (should (null (car attr)))
2475 (should (numberp (nth 1 attr))) ;; Link.
2476 (should (numberp (nth 2 attr))) ;; Uid.
2477 (should (numberp (nth 3 attr))) ;; Gid.
2478 ;; Last access time.
2479 (should (stringp (current-time-string (nth 4 attr))))
2480 ;; Last modification time.
2481 (should (stringp (current-time-string (nth 5 attr))))
2482 ;; Last status change time.
2483 (should (stringp (current-time-string (nth 6 attr))))
2484 (should (numberp (nth 7 attr))) ;; Size.
2485 (should (stringp (nth 8 attr))) ;; Modes.
2487 (setq attr (file-attributes tmp-name1 'string))
2488 (should (stringp (nth 2 attr))) ;; Uid.
2489 (should (stringp (nth 3 attr))) ;; Gid.
2491 (tramp--test-ignore-make-symbolic-link-error
2492 (when (tramp--test-sh-p)
2493 (should (file-ownership-preserved-p tmp-name2 'group)))
2494 (make-symbolic-link tmp-name1 tmp-name2)
2495 (should (file-exists-p tmp-name2))
2496 (should (file-symlink-p tmp-name2))
2497 (when (tramp--test-sh-p)
2498 (should (file-ownership-preserved-p tmp-name2 'group)))
2499 (setq attr (file-attributes tmp-name2))
2500 (should
2501 (string-equal
2502 (funcall
2503 (if quoted 'tramp-compat-file-name-quote 'identity)
2504 (car attr))
2505 (file-remote-p (file-truename tmp-name1) 'localname)))
2506 (delete-file tmp-name2))
2508 ;; Check, that "//" in symlinks are handled properly.
2509 (with-temp-buffer
2510 (let ((default-directory tramp-test-temporary-file-directory))
2511 (shell-command
2512 (format
2513 "ln -s %s %s"
2514 (tramp-file-name-localname
2515 (tramp-dissect-file-name tmp-name3))
2516 (tramp-file-name-localname
2517 (tramp-dissect-file-name tmp-name2)))
2518 t)))
2519 (when (file-symlink-p tmp-name2)
2520 (setq attr (file-attributes tmp-name2))
2521 (should
2522 (string-equal
2523 (car attr)
2524 (tramp-file-name-localname
2525 (tramp-dissect-file-name tmp-name3))))
2526 (delete-file tmp-name2))
2528 (when (tramp--test-sh-p)
2529 (should (file-ownership-preserved-p tmp-name1 'group)))
2530 (delete-file tmp-name1)
2531 (make-directory tmp-name1)
2532 (should (file-exists-p tmp-name1))
2533 (should (file-readable-p tmp-name1))
2534 (should-not (file-regular-p tmp-name1))
2535 (when (tramp--test-sh-p)
2536 (should (file-ownership-preserved-p tmp-name1 'group)))
2537 (setq attr (file-attributes tmp-name1))
2538 (should (eq (car attr) t)))
2540 ;; Cleanup.
2541 (ignore-errors (delete-directory tmp-name1))
2542 (ignore-errors (delete-file tmp-name1))
2543 (ignore-errors (delete-file tmp-name2))))))
2545 (ert-deftest tramp-test19-directory-files-and-attributes ()
2546 "Check `directory-files-and-attributes'."
2547 (skip-unless (tramp--test-enabled))
2549 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2550 ;; `directory-files-and-attributes' contains also values for
2551 ;; "../". Ensure that this doesn't change during tests, for
2552 ;; example due to handling temporary files.
2553 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2554 (tmp-name2 (expand-file-name "bla" tmp-name1))
2555 attr)
2556 (unwind-protect
2557 (progn
2558 (make-directory tmp-name1)
2559 (should (file-directory-p tmp-name1))
2560 (make-directory tmp-name2)
2561 (should (file-directory-p tmp-name2))
2562 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
2563 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
2564 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
2565 (setq attr (directory-files-and-attributes tmp-name2))
2566 (should (consp attr))
2567 ;; Dumb remote shells without perl(1) or stat(1) are not
2568 ;; able to return the date correctly. They say "don't know".
2569 (dolist (elt attr)
2570 (unless
2571 (equal
2572 (nth
2573 5 (file-attributes (expand-file-name (car elt) tmp-name2)))
2574 '(0 0))
2575 (should
2576 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
2577 (cdr elt)))))
2578 (setq attr (directory-files-and-attributes tmp-name2 'full))
2579 (dolist (elt attr)
2580 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
2581 (should
2582 (equal (file-attributes (car elt)) (cdr elt)))))
2583 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
2584 (should (equal (mapcar 'car attr) '("bar" "boz"))))
2586 ;; Cleanup.
2587 (ignore-errors (delete-directory tmp-name1 'recursive))))))
2589 (ert-deftest tramp-test20-file-modes ()
2590 "Check `file-modes'.
2591 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2592 (skip-unless (tramp--test-enabled))
2593 (skip-unless (tramp--test-sh-p))
2595 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2596 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2597 (unwind-protect
2598 (progn
2599 (write-region "foo" nil tmp-name)
2600 (should (file-exists-p tmp-name))
2601 (set-file-modes tmp-name #o777)
2602 (should (= (file-modes tmp-name) #o777))
2603 (should (file-executable-p tmp-name))
2604 (should (file-writable-p tmp-name))
2605 (set-file-modes tmp-name #o444)
2606 (should (= (file-modes tmp-name) #o444))
2607 (should-not (file-executable-p tmp-name))
2608 ;; A file is always writable for user "root".
2609 (unless (zerop (nth 2 (file-attributes tmp-name)))
2610 (should-not (file-writable-p tmp-name))))
2612 ;; Cleanup.
2613 (ignore-errors (delete-file tmp-name))))))
2615 (ert-deftest tramp-test21-file-links ()
2616 "Check `file-symlink-p'.
2617 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2618 (skip-unless (tramp--test-enabled))
2620 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2621 ;; We must use `file-truename' for the temporary directory,
2622 ;; because it could be located on a symlinked directory. This
2623 ;; would let the test fail.
2624 (let* ((tramp-test-temporary-file-directory
2625 (file-truename tramp-test-temporary-file-directory))
2626 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2627 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2628 (tmp-name3 (tramp--test-make-temp-name 'local quoted))
2629 (tmp-name4 (tramp--test-make-temp-name nil quoted)))
2631 ;; Check `make-symbolic-link'.
2632 (unwind-protect
2633 (tramp--test-ignore-make-symbolic-link-error
2634 (write-region "foo" nil tmp-name1)
2635 (should (file-exists-p tmp-name1))
2636 (make-symbolic-link tmp-name1 tmp-name2)
2637 (should
2638 (string-equal
2639 (funcall
2640 (if quoted 'tramp-compat-file-name-unquote 'identity)
2641 (file-remote-p tmp-name1 'localname))
2642 (file-symlink-p tmp-name2)))
2643 (should-error
2644 (make-symbolic-link tmp-name1 tmp-name2)
2645 :type 'file-already-exists)
2646 ;; number means interactive case.
2647 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
2648 (should-error
2649 (make-symbolic-link tmp-name1 tmp-name2 0)
2650 :type 'file-already-exists))
2651 (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
2652 (make-symbolic-link tmp-name1 tmp-name2 0)
2653 (should
2654 (string-equal
2655 (funcall
2656 (if quoted 'tramp-compat-file-name-unquote 'identity)
2657 (file-remote-p tmp-name1 'localname))
2658 (file-symlink-p tmp-name2))))
2659 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
2660 (should
2661 (string-equal
2662 (funcall
2663 (if quoted 'tramp-compat-file-name-unquote 'identity)
2664 (file-remote-p tmp-name1 'localname))
2665 (file-symlink-p tmp-name2)))
2666 ;; If we use the local part of `tmp-name1', it shall still work.
2667 (make-symbolic-link
2668 (file-remote-p tmp-name1 'localname)
2669 tmp-name2 'ok-if-already-exists)
2670 (should
2671 (string-equal
2672 (funcall
2673 (if quoted 'tramp-compat-file-name-unquote 'identity)
2674 (file-remote-p tmp-name1 'localname))
2675 (file-symlink-p tmp-name2)))
2676 ;; `tmp-name3' is a local file name. Therefore, the link
2677 ;; target remains unchanged, even if quoted.
2678 (make-symbolic-link tmp-name1 tmp-name3)
2679 (should
2680 (string-equal tmp-name1 (file-symlink-p tmp-name3)))
2681 ;; Check directory as newname.
2682 (make-directory tmp-name4)
2683 (should-error
2684 (make-symbolic-link tmp-name1 tmp-name4)
2685 :type 'file-already-exists)
2686 (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4))
2687 (should
2688 (string-equal
2689 (funcall
2690 (if quoted 'tramp-compat-file-name-unquote 'identity)
2691 (file-remote-p tmp-name1 'localname))
2692 (file-symlink-p
2693 (expand-file-name
2694 (file-name-nondirectory tmp-name1) tmp-name4)))))
2696 ;; Cleanup.
2697 (ignore-errors
2698 (delete-file tmp-name1)
2699 (delete-file tmp-name2)
2700 (delete-file tmp-name3)
2701 (delete-directory tmp-name4 'recursive)))
2703 ;; Check `add-name-to-file'.
2704 (unwind-protect
2705 (progn
2706 (write-region "foo" nil tmp-name1)
2707 (should (file-exists-p tmp-name1))
2708 (add-name-to-file tmp-name1 tmp-name2)
2709 (should (file-regular-p tmp-name2))
2710 (should-error
2711 (add-name-to-file tmp-name1 tmp-name2)
2712 :type 'file-already-exists)
2713 ;; number means interactive case.
2714 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
2715 (should-error
2716 (add-name-to-file tmp-name1 tmp-name2 0)
2717 :type 'file-already-exists))
2718 (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
2719 (add-name-to-file tmp-name1 tmp-name2 0)
2720 (should (file-regular-p tmp-name2)))
2721 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
2722 (should-not (file-symlink-p tmp-name2))
2723 (should (file-regular-p tmp-name2))
2724 ;; `tmp-name3' is a local file name.
2725 (should-error
2726 (add-name-to-file tmp-name1 tmp-name3)
2727 :type 'file-error)
2728 ;; Check directory as newname.
2729 (make-directory tmp-name4)
2730 (should-error
2731 (add-name-to-file tmp-name1 tmp-name4)
2732 :type 'file-already-exists)
2733 (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4))
2734 (should
2735 (file-regular-p
2736 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4))))
2738 ;; Cleanup.
2739 (ignore-errors
2740 (delete-file tmp-name1)
2741 (delete-file tmp-name2)
2742 (delete-directory tmp-name4 'recursive)))
2744 ;; Check `file-truename'.
2745 (unwind-protect
2746 (tramp--test-ignore-make-symbolic-link-error
2747 (write-region "foo" nil tmp-name1)
2748 (should (file-exists-p tmp-name1))
2749 (should (string-equal tmp-name1 (file-truename tmp-name1)))
2750 (make-symbolic-link tmp-name1 tmp-name2)
2751 (should (file-symlink-p tmp-name2))
2752 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
2753 (should
2754 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
2755 (should (file-equal-p tmp-name1 tmp-name2))
2756 ;; Symbolic links could look like a remote file name.
2757 ;; They must be quoted then.
2758 (delete-file tmp-name2)
2759 (make-symbolic-link "/penguin:motd:" tmp-name2)
2760 (should (file-symlink-p tmp-name2))
2761 (should
2762 (string-equal
2763 (file-truename tmp-name2)
2764 (tramp-compat-file-name-quote
2765 (concat (file-remote-p tmp-name2) "/penguin:motd:"))))
2766 ;; `tmp-name3' is a local file name.
2767 (make-symbolic-link tmp-name1 tmp-name3)
2768 (should (file-symlink-p tmp-name3))
2769 (should-not (string-equal tmp-name3 (file-truename tmp-name3)))
2770 ;; `file-truename' returns a quoted file name for `tmp-name3'.
2771 ;; We must unquote it.
2772 (should
2773 (string-equal
2774 (file-truename tmp-name1)
2775 (tramp-compat-file-name-unquote (file-truename tmp-name3)))))
2777 ;; Cleanup.
2778 (ignore-errors
2779 (delete-file tmp-name1)
2780 (delete-file tmp-name2)
2781 (delete-file tmp-name3)))
2783 ;; Symbolic links could be nested.
2784 (unwind-protect
2785 (tramp--test-ignore-make-symbolic-link-error
2786 (make-directory tmp-name1)
2787 (should (file-directory-p tmp-name1))
2788 (let* ((tramp-test-temporary-file-directory
2789 (file-truename tmp-name1))
2790 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2791 (tmp-name3 tmp-name2)
2792 (number-nesting 15))
2793 (dotimes (_ number-nesting)
2794 (make-symbolic-link
2795 tmp-name3
2796 (setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
2797 (should
2798 (string-equal
2799 (file-truename tmp-name2)
2800 (file-truename tmp-name3)))
2801 (should-error
2802 (with-temp-buffer (insert-file-contents tmp-name2))
2803 :type tramp-file-missing)
2804 (should-error
2805 (with-temp-buffer (insert-file-contents tmp-name3))
2806 :type tramp-file-missing)
2807 ;; `directory-files' does not show symlinks to
2808 ;; non-existing targets in the "smb" case. So we remove
2809 ;; the symlinks manually.
2810 (while (stringp (setq tmp-name2 (file-symlink-p tmp-name3)))
2811 (delete-file tmp-name3)
2812 (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
2814 ;; Cleanup.
2815 (ignore-errors (delete-directory tmp-name1 'recursive)))
2817 ;; Detect cyclic symbolic links.
2818 (unwind-protect
2819 (tramp--test-ignore-make-symbolic-link-error
2820 (make-symbolic-link tmp-name2 tmp-name1)
2821 (should (file-symlink-p tmp-name1))
2822 (make-symbolic-link tmp-name1 tmp-name2)
2823 (should (file-symlink-p tmp-name2))
2824 (should-error (file-truename tmp-name1) :type 'file-error))
2826 ;; Cleanup.
2827 (ignore-errors
2828 (delete-file tmp-name1)
2829 (delete-file tmp-name2)))
2831 ;; `file-truename' shall preserve trailing link of directories.
2832 (unless (file-symlink-p tramp-test-temporary-file-directory)
2833 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
2834 (dir2 (file-name-as-directory dir1)))
2835 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
2836 (should
2837 (string-equal (file-truename dir2) (expand-file-name dir2))))))))
2839 (ert-deftest tramp-test22-file-times ()
2840 "Check `set-file-times' and `file-newer-than-file-p'."
2841 (skip-unless (tramp--test-enabled))
2842 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2844 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2845 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2846 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2847 (tmp-name3 (tramp--test-make-temp-name nil quoted)))
2848 (unwind-protect
2849 (progn
2850 (write-region "foo" nil tmp-name1)
2851 (should (file-exists-p tmp-name1))
2852 (should (consp (nth 5 (file-attributes tmp-name1))))
2853 ;; '(0 0) means don't know, and will be replaced by
2854 ;; `current-time'. Therefore, we use '(0 1). We skip the
2855 ;; test, if the remote handler is not able to set the
2856 ;; correct time.
2857 (skip-unless (set-file-times tmp-name1 '(0 1)))
2858 ;; Dumb remote shells without perl(1) or stat(1) are not
2859 ;; able to return the date correctly. They say "don't know".
2860 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
2861 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
2862 (write-region "bla" nil tmp-name2)
2863 (should (file-exists-p tmp-name2))
2864 (should (file-newer-than-file-p tmp-name2 tmp-name1))
2865 ;; `tmp-name3' does not exist.
2866 (should (file-newer-than-file-p tmp-name2 tmp-name3))
2867 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
2869 ;; Cleanup.
2870 (ignore-errors
2871 (delete-file tmp-name1)
2872 (delete-file tmp-name2))))))
2874 (ert-deftest tramp-test23-visited-file-modtime ()
2875 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
2876 (skip-unless (tramp--test-enabled))
2878 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2879 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2880 (unwind-protect
2881 (progn
2882 (write-region "foo" nil tmp-name)
2883 (should (file-exists-p tmp-name))
2884 (with-temp-buffer
2885 (insert-file-contents tmp-name)
2886 (should (verify-visited-file-modtime))
2887 (set-visited-file-modtime '(0 1))
2888 (should (verify-visited-file-modtime))
2889 (should (equal (visited-file-modtime) '(0 1 0 0)))))
2891 ;; Cleanup.
2892 (ignore-errors (delete-file tmp-name))))))
2894 (ert-deftest tramp-test24-file-name-completion ()
2895 "Check `file-name-completion' and `file-name-all-completions'."
2896 (skip-unless (tramp--test-enabled))
2898 ;; Method and host name in completion mode. This kind of completion
2899 ;; does not work on MS Windows.
2900 (when (not (memq system-type '(cygwin windows-nt)))
2901 (let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
2902 (host (file-remote-p tramp-test-temporary-file-directory 'host))
2903 (orig-syntax tramp-syntax))
2904 (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
2905 (setq host (match-string 1 host)))
2907 (unwind-protect
2908 (dolist
2909 (syntax
2910 (if tramp--test-expensive-test
2911 (tramp-syntax-values) `(,orig-syntax)))
2912 (tramp-change-syntax syntax)
2913 (let ;; This is needed for the `simplified' syntax.
2914 ((method-marker
2915 (if (zerop (length tramp-method-regexp))
2916 "" tramp-default-method-marker))
2917 ;; This is needed for the `separate' syntax.
2918 (prefix-format (substring tramp-prefix-format 1)))
2919 ;; Complete method name.
2920 (unless (or (zerop (length method))
2921 (zerop (length tramp-method-regexp)))
2922 (should
2923 (member
2924 (concat prefix-format method tramp-postfix-method-format)
2925 (file-name-all-completions
2926 (concat prefix-format (substring method 0 1)) "/"))))
2927 ;; Complete host name for default method. With gvfs
2928 ;; based methods, host name will be determined as
2929 ;; host.local, so we omit the test.
2930 (let ((tramp-default-method (or method tramp-default-method)))
2931 (unless (or (zerop (length host))
2932 (tramp--test-gvfs-p tramp-default-method))
2933 (should
2934 (member
2935 (concat
2936 prefix-format method-marker tramp-postfix-method-format
2937 host tramp-postfix-host-format)
2938 (file-name-all-completions
2939 (concat
2940 prefix-format method-marker tramp-postfix-method-format
2941 (substring host 0 1))
2942 "/")))))
2943 ;; Complete host name.
2944 (unless (or (zerop (length method))
2945 (zerop (length tramp-method-regexp))
2946 (zerop (length host))
2947 (tramp--test-gvfs-p method))
2948 (should
2949 (member
2950 (concat
2951 prefix-format method tramp-postfix-method-format
2952 host tramp-postfix-host-format)
2953 (file-name-all-completions
2954 (concat prefix-format method tramp-postfix-method-format)
2955 "/"))))))
2957 ;; Cleanup.
2958 (tramp-change-syntax orig-syntax))))
2960 (dolist (n-e '(nil t))
2961 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2962 (let ((non-essential n-e)
2963 (tmp-name (tramp--test-make-temp-name nil quoted)))
2965 (unwind-protect
2966 (progn
2967 ;; Local files.
2968 (make-directory tmp-name)
2969 (should (file-directory-p tmp-name))
2970 (write-region "foo" nil (expand-file-name "foo" tmp-name))
2971 (should (file-exists-p (expand-file-name "foo" tmp-name)))
2972 (write-region "bar" nil (expand-file-name "bold" tmp-name))
2973 (should (file-exists-p (expand-file-name "bold" tmp-name)))
2974 (make-directory (expand-file-name "boz" tmp-name))
2975 (should (file-directory-p (expand-file-name "boz" tmp-name)))
2976 (should (equal (file-name-completion "fo" tmp-name) "foo"))
2977 (should (equal (file-name-completion "foo" tmp-name) t))
2978 (should (equal (file-name-completion "b" tmp-name) "bo"))
2979 (should-not (file-name-completion "a" tmp-name))
2980 (should
2981 (equal
2982 (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
2983 (should
2984 (equal (file-name-all-completions "fo" tmp-name) '("foo")))
2985 (should
2986 (equal
2987 (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
2988 '("bold" "boz/")))
2989 (should-not (file-name-all-completions "a" tmp-name))
2990 ;; `completion-regexp-list' restricts the completion to
2991 ;; files which match all expressions in this list.
2992 (let ((completion-regexp-list
2993 `(,directory-files-no-dot-files-regexp "b")))
2994 (should
2995 (equal (file-name-completion "" tmp-name) "bo"))
2996 (should
2997 (equal
2998 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
2999 '("bold" "boz/"))))
3000 ;; `file-name-completion' ignores file names that end in
3001 ;; any string in `completion-ignored-extensions'.
3002 (let ((completion-ignored-extensions '(".ext")))
3003 (write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
3004 (should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
3005 (should (equal (file-name-completion "fo" tmp-name) "foo"))
3006 (should (equal (file-name-completion "foo" tmp-name) t))
3007 (should
3008 (equal (file-name-completion "foo." tmp-name) "foo.ext"))
3009 (should (equal (file-name-completion "foo.ext" tmp-name) t))
3010 ;; `file-name-all-completions' is not affected.
3011 (should
3012 (equal
3013 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
3014 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
3016 ;; Cleanup.
3017 (ignore-errors (delete-directory tmp-name 'recursive)))))))
3019 (ert-deftest tramp-test25-load ()
3020 "Check `load'."
3021 (skip-unless (tramp--test-enabled))
3023 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3024 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
3025 (unwind-protect
3026 (progn
3027 (load tmp-name 'noerror 'nomessage)
3028 (should-not (featurep 'tramp-test-load))
3029 (write-region "(provide 'tramp-test-load)" nil tmp-name)
3030 ;; `load' in lread.c does not pass `must-suffix'. Why?
3031 ;;(should-error
3032 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
3033 ;; :type 'file-error)
3034 (load tmp-name nil 'nomessage 'nosuffix)
3035 (should (featurep 'tramp-test-load)))
3037 ;; Cleanup.
3038 (ignore-errors
3039 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
3040 (delete-file tmp-name))))))
3042 (ert-deftest tramp-test26-process-file ()
3043 "Check `process-file'."
3044 :tags '(:expensive-test)
3045 (skip-unless (tramp--test-enabled))
3046 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3048 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3049 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
3050 (fnnd (file-name-nondirectory tmp-name))
3051 (default-directory tramp-test-temporary-file-directory)
3052 kill-buffer-query-functions)
3053 (unwind-protect
3054 (progn
3055 ;; We cannot use "/bin/true" and "/bin/false"; those paths
3056 ;; do not exist on hydra.
3057 (should (zerop (process-file "true")))
3058 (should-not (zerop (process-file "false")))
3059 (should-not (zerop (process-file "binary-does-not-exist")))
3060 (with-temp-buffer
3061 (write-region "foo" nil tmp-name)
3062 (should (file-exists-p tmp-name))
3063 (should (zerop (process-file "ls" nil t nil fnnd)))
3064 ;; `ls' could produce colorized output.
3065 (goto-char (point-min))
3066 (while
3067 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3068 (replace-match "" nil nil))
3069 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
3070 (should-not (get-buffer-window (current-buffer) t))
3072 ;; Second run. The output must be appended.
3073 (goto-char (point-max))
3074 (should (zerop (process-file "ls" nil t t fnnd)))
3075 ;; `ls' could produce colorized output.
3076 (goto-char (point-min))
3077 (while
3078 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3079 (replace-match "" nil nil))
3080 (should
3081 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
3082 ;; A non-nil DISPLAY must not raise the buffer.
3083 (should-not (get-buffer-window (current-buffer) t))))
3085 ;; Cleanup.
3086 (ignore-errors (delete-file tmp-name))))))
3088 (ert-deftest tramp-test27-start-file-process ()
3089 "Check `start-file-process'."
3090 :tags '(:expensive-test)
3091 (skip-unless (tramp--test-enabled))
3092 (skip-unless (tramp--test-sh-p))
3094 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3095 (let ((default-directory tramp-test-temporary-file-directory)
3096 (tmp-name (tramp--test-make-temp-name nil quoted))
3097 kill-buffer-query-functions proc)
3098 (unwind-protect
3099 (with-temp-buffer
3100 (setq proc (start-file-process "test1" (current-buffer) "cat"))
3101 (should (processp proc))
3102 (should (equal (process-status proc) 'run))
3103 (process-send-string proc "foo")
3104 (process-send-eof proc)
3105 ;; Read output.
3106 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3107 (while (< (- (point-max) (point-min)) (length "foo"))
3108 (accept-process-output proc 0.1)))
3109 (should (string-equal (buffer-string) "foo")))
3111 ;; Cleanup.
3112 (ignore-errors (delete-process proc)))
3114 (unwind-protect
3115 (with-temp-buffer
3116 (write-region "foo" nil tmp-name)
3117 (should (file-exists-p tmp-name))
3118 (setq proc
3119 (start-file-process
3120 "test2" (current-buffer)
3121 "cat" (file-name-nondirectory tmp-name)))
3122 (should (processp proc))
3123 ;; Read output.
3124 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3125 (while (< (- (point-max) (point-min)) (length "foo"))
3126 (accept-process-output proc 0.1)))
3127 (should (string-equal (buffer-string) "foo")))
3129 ;; Cleanup.
3130 (ignore-errors
3131 (delete-process proc)
3132 (delete-file tmp-name)))
3134 (unwind-protect
3135 (with-temp-buffer
3136 (setq proc (start-file-process "test3" (current-buffer) "cat"))
3137 (should (processp proc))
3138 (should (equal (process-status proc) 'run))
3139 (set-process-filter
3140 proc
3141 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
3142 (process-send-string proc "foo")
3143 (process-send-eof proc)
3144 ;; Read output.
3145 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3146 (while (< (- (point-max) (point-min)) (length "foo"))
3147 (accept-process-output proc 0.1)))
3148 (should (string-equal (buffer-string) "foo")))
3150 ;; Cleanup.
3151 (ignore-errors (delete-process proc))))))
3153 (ert-deftest tramp-test28-interrupt-process ()
3154 "Check `interrupt-process'."
3155 :tags '(:expensive-test)
3156 (skip-unless (tramp--test-enabled))
3157 (skip-unless (tramp--test-sh-p))
3158 ;; Since Emacs 26.1.
3159 (skip-unless (boundp 'interrupt-process-functions))
3161 (let ((default-directory tramp-test-temporary-file-directory)
3162 kill-buffer-query-functions proc)
3163 (unwind-protect
3164 (with-temp-buffer
3165 (setq proc (start-file-process "test" (current-buffer) "sleep" "10"))
3166 (should (processp proc))
3167 (should (process-live-p proc))
3168 (should (equal (process-status proc) 'run))
3169 (should (interrupt-process proc))
3170 ;; Let the process accept the interrupt.
3171 (accept-process-output proc 1 nil 0)
3172 (should-not (process-live-p proc))
3173 (should (equal (process-status proc) 'signal))
3174 ;; An interrupted process cannot be interrupted, again.
3175 ;; Does not work reliable.
3176 ;; (should-error (interrupt-process proc) :type 'error))
3179 ;; Cleanup.
3180 (ignore-errors (delete-process proc)))))
3182 (ert-deftest tramp-test29-shell-command ()
3183 "Check `shell-command'."
3184 :tags '(:expensive-test)
3185 (skip-unless (tramp--test-enabled))
3186 (skip-unless (tramp--test-sh-p))
3188 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3189 (let ((tmp-name (tramp--test-make-temp-name nil quoted))
3190 (default-directory tramp-test-temporary-file-directory)
3191 ;; Suppress nasty messages.
3192 (inhibit-message t)
3193 kill-buffer-query-functions)
3194 (unwind-protect
3195 (with-temp-buffer
3196 (write-region "foo" nil tmp-name)
3197 (should (file-exists-p tmp-name))
3198 (shell-command
3199 (format "ls %s" (file-name-nondirectory tmp-name))
3200 (current-buffer))
3201 ;; `ls' could produce colorized output.
3202 (goto-char (point-min))
3203 (while
3204 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3205 (replace-match "" nil nil))
3206 (should
3207 (string-equal
3208 (format "%s\n" (file-name-nondirectory tmp-name))
3209 (buffer-string))))
3211 ;; Cleanup.
3212 (ignore-errors (delete-file tmp-name)))
3214 (unwind-protect
3215 (with-temp-buffer
3216 (write-region "foo" nil tmp-name)
3217 (should (file-exists-p tmp-name))
3218 (async-shell-command
3219 (format "ls %s" (file-name-nondirectory tmp-name))
3220 (current-buffer))
3221 ;; Read output.
3222 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3223 (while (< (- (point-max) (point-min))
3224 (1+ (length (file-name-nondirectory tmp-name))))
3225 (accept-process-output
3226 (get-buffer-process (current-buffer)) 0.1)))
3227 ;; `ls' could produce colorized output.
3228 (goto-char (point-min))
3229 (while
3230 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3231 (replace-match "" nil nil))
3232 ;; There might be a nasty "Process *Async Shell* finished" message.
3233 (goto-char (point-min))
3234 (forward-line)
3235 (narrow-to-region (point-min) (point))
3236 (should
3237 (string-equal
3238 (format "%s\n" (file-name-nondirectory tmp-name))
3239 (buffer-string))))
3241 ;; Cleanup.
3242 (ignore-errors (delete-file tmp-name)))
3244 (unwind-protect
3245 (with-temp-buffer
3246 (write-region "foo" nil tmp-name)
3247 (should (file-exists-p tmp-name))
3248 (async-shell-command "read line; ls $line" (current-buffer))
3249 (process-send-string
3250 (get-buffer-process (current-buffer))
3251 (format "%s\n" (file-name-nondirectory tmp-name)))
3252 ;; Read output.
3253 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3254 (while (< (- (point-max) (point-min))
3255 (1+ (length (file-name-nondirectory tmp-name))))
3256 (accept-process-output
3257 (get-buffer-process (current-buffer)) 0.1)))
3258 ;; `ls' could produce colorized output.
3259 (goto-char (point-min))
3260 (while
3261 (re-search-forward tramp-display-escape-sequence-regexp nil t)
3262 (replace-match "" nil nil))
3263 ;; There might be a nasty "Process *Async Shell* finished" message.
3264 (goto-char (point-min))
3265 (forward-line)
3266 (narrow-to-region (point-min) (point))
3267 (should
3268 (string-equal
3269 (format "%s\n" (file-name-nondirectory tmp-name))
3270 (buffer-string))))
3272 ;; Cleanup.
3273 (ignore-errors (delete-file tmp-name))))))
3275 (defun tramp--test-shell-command-to-string-asynchronously (command)
3276 "Like `shell-command-to-string', but for asynchronous processes."
3277 (with-temp-buffer
3278 (async-shell-command command (current-buffer))
3279 (with-timeout (10)
3280 (while (get-buffer-process (current-buffer))
3281 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3282 (accept-process-output nil 0.1)
3283 (buffer-substring-no-properties (point-min) (point-max))))
3285 ;; This test is inspired by Bug#23952.
3286 (ert-deftest tramp-test30-environment-variables ()
3287 "Check that remote processes set / unset environment variables properly."
3288 :tags '(:expensive-test)
3289 (skip-unless (tramp--test-enabled))
3290 (skip-unless (tramp--test-sh-p))
3292 (dolist (this-shell-command-to-string
3293 '(;; Synchronously.
3294 shell-command-to-string
3295 ;; Asynchronously.
3296 tramp--test-shell-command-to-string-asynchronously))
3298 (let ((default-directory tramp-test-temporary-file-directory)
3299 (shell-file-name "/bin/sh")
3300 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3301 kill-buffer-query-functions)
3303 (unwind-protect
3304 ;; Set a value.
3305 (let ((process-environment
3306 (cons (concat envvar "=foo") process-environment)))
3307 ;; Default value.
3308 (should
3309 (string-match
3310 "foo"
3311 (funcall
3312 this-shell-command-to-string
3313 (format "echo -n ${%s:?bla}" envvar))))))
3315 (unwind-protect
3316 ;; Set the empty value.
3317 (let ((process-environment
3318 (cons (concat envvar "=") process-environment)))
3319 ;; Value is null.
3320 (should
3321 (string-match
3322 "bla"
3323 (funcall
3324 this-shell-command-to-string
3325 (format "echo -n ${%s:?bla}" envvar))))
3326 ;; Variable is set.
3327 (should
3328 (string-match
3329 (regexp-quote envvar)
3330 (funcall this-shell-command-to-string "set")))))
3332 ;; We force a reconnect, in order to have a clean environment.
3333 (tramp-cleanup-connection
3334 (tramp-dissect-file-name tramp-test-temporary-file-directory)
3335 'keep-debug 'keep-password)
3336 (unwind-protect
3337 ;; Unset the variable.
3338 (let ((tramp-remote-process-environment
3339 (cons (concat envvar "=foo")
3340 tramp-remote-process-environment)))
3341 ;; Set the initial value, we want to unset below.
3342 (should
3343 (string-match
3344 "foo"
3345 (funcall
3346 this-shell-command-to-string
3347 (format "echo -n ${%s:?bla}" envvar))))
3348 (let ((process-environment
3349 (cons envvar process-environment)))
3350 ;; Variable is unset.
3351 (should
3352 (string-match
3353 "bla"
3354 (funcall
3355 this-shell-command-to-string
3356 (format "echo -n ${%s:?bla}" envvar))))
3357 ;; Variable is unset.
3358 (should-not
3359 (string-match
3360 (regexp-quote envvar)
3361 (funcall this-shell-command-to-string "set")))))))))
3363 ;; This test is inspired by Bug#27009.
3364 (ert-deftest tramp-test30-environment-variables-and-port-numbers ()
3365 "Check that two connections with separate ports are different."
3366 (skip-unless (tramp--test-enabled))
3367 ;; We test it only for the mock-up connection; otherwise there might
3368 ;; be problems with the used ports.
3369 (skip-unless
3370 (and
3371 (eq tramp-syntax 'default)
3372 (string-equal
3373 "mock" (file-remote-p tramp-test-temporary-file-directory 'method))))
3375 ;; We force a reconnect, in order to have a clean environment.
3376 (dolist (dir `(,tramp-test-temporary-file-directory
3377 "/mock:localhost#11111:" "/mock:localhost#22222:"))
3378 (tramp-cleanup-connection
3379 (tramp-dissect-file-name dir) 'keep-debug 'keep-password))
3381 (unwind-protect
3382 (dolist (port '(11111 22222))
3383 (let* ((default-directory
3384 (format "/mock:localhost#%d:%s" port temporary-file-directory))
3385 (shell-file-name "/bin/sh")
3386 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3387 ;; We cannot use `process-environment', because this
3388 ;; would be applied in `process-file'.
3389 (tramp-remote-process-environment
3390 (cons
3391 (format "%s=%d" envvar port)
3392 tramp-remote-process-environment)))
3393 (should
3394 (string-equal
3395 (number-to-string port)
3396 (shell-command-to-string (format "echo -n $%s" envvar))))))
3398 ;; Cleanup.
3399 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3400 (tramp-cleanup-connection (tramp-dissect-file-name dir)))))
3402 ;; The functions were introduced in Emacs 26.1.
3403 (ert-deftest tramp-test31-explicit-shell-file-name ()
3404 "Check that connection-local `explicit-shell-file-name' is set."
3405 :tags '(:expensive-test)
3406 (skip-unless (tramp--test-enabled))
3407 (skip-unless (tramp--test-sh-p))
3408 ;; Since Emacs 26.1.
3409 (skip-unless (and (fboundp 'connection-local-set-profile-variables)
3410 (fboundp 'connection-local-set-profiles)))
3412 ;; `connection-local-set-profile-variables' and
3413 ;; `connection-local-set-profiles' exists since Emacs 26. We don't
3414 ;; want to see compiler warnings for older Emacsen.
3415 (let ((default-directory tramp-test-temporary-file-directory)
3416 explicit-shell-file-name kill-buffer-query-functions)
3417 (unwind-protect
3418 (progn
3419 ;; `shell-mode' would ruin our test, because it deletes all
3420 ;; buffer local variables.
3421 (put 'explicit-shell-file-name 'permanent-local t)
3422 ;; Declare connection-local variable `explicit-shell-file-name'.
3423 (with-no-warnings
3424 (connection-local-set-profile-variables
3425 'remote-sh
3426 '((explicit-shell-file-name . "/bin/sh")
3427 (explicit-sh-args . ("-i"))))
3428 (connection-local-set-profiles
3429 `(:application tramp
3430 :protocol ,(file-remote-p default-directory 'method)
3431 :user ,(file-remote-p default-directory 'user)
3432 :machine ,(file-remote-p default-directory 'host))
3433 'remote-sh))
3435 ;; Run interactive shell. Since the default directory is
3436 ;; remote, `explicit-shell-file-name' shall be set in order
3437 ;; to avoid a question.
3438 (with-current-buffer (get-buffer-create "*shell*")
3439 (ignore-errors (kill-process (current-buffer)))
3440 (should-not explicit-shell-file-name)
3441 (call-interactively 'shell)
3442 (should explicit-shell-file-name)))
3444 (put 'explicit-shell-file-name 'permanent-local nil)
3445 (kill-buffer "*shell*"))))
3447 (ert-deftest tramp-test32-vc-registered ()
3448 "Check `vc-registered'."
3449 :tags '(:expensive-test)
3450 (skip-unless (tramp--test-enabled))
3451 (skip-unless (tramp--test-sh-p))
3453 ;; TODO: This test fails.
3454 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3455 (let* ((default-directory tramp-test-temporary-file-directory)
3456 (tmp-name1 (tramp--test-make-temp-name nil quoted))
3457 (tmp-name2 (expand-file-name "foo" tmp-name1))
3458 (tramp-remote-process-environment tramp-remote-process-environment)
3459 (vc-handled-backends
3460 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3461 (cond
3462 ((tramp-find-executable
3463 v vc-git-program (tramp-get-remote-path v))
3464 '(Git))
3465 ((tramp-find-executable
3466 v vc-hg-program (tramp-get-remote-path v))
3467 '(Hg))
3468 ((tramp-find-executable
3469 v vc-bzr-program (tramp-get-remote-path v))
3470 (setq tramp-remote-process-environment
3471 (cons (format "BZR_HOME=%s"
3472 (file-remote-p tmp-name1 'localname))
3473 tramp-remote-process-environment))
3474 ;; We must force a reconnect, in order to activate $BZR_HOME.
3475 (tramp-cleanup-connection
3476 (tramp-dissect-file-name tramp-test-temporary-file-directory)
3477 'keep-debug 'keep-password)
3478 '(Bzr))
3479 (t nil))))
3480 ;; Suppress nasty messages.
3481 (inhibit-message t))
3482 (skip-unless vc-handled-backends)
3483 (unless quoted (tramp--test-message "%s" vc-handled-backends))
3485 (unwind-protect
3486 (progn
3487 (make-directory tmp-name1)
3488 (write-region "foo" nil tmp-name2)
3489 (should (file-directory-p tmp-name1))
3490 (should (file-exists-p tmp-name2))
3491 (should-not (vc-registered tmp-name1))
3492 (should-not (vc-registered tmp-name2))
3494 (let ((default-directory tmp-name1))
3495 ;; Create empty repository, and register the file.
3496 ;; Sometimes, creation of repository fails (bzr!); we
3497 ;; skip the test then.
3498 (condition-case nil
3499 (vc-create-repo (car vc-handled-backends))
3500 (error (skip-unless nil)))
3501 ;; The structure of VC-FILESET is not documented. Let's
3502 ;; hope it won't change.
3503 (condition-case nil
3504 (vc-register
3505 (list (car vc-handled-backends)
3506 (list (file-name-nondirectory tmp-name2))))
3507 ;; `vc-register' has changed its arguments in Emacs 25.1.
3508 (error
3509 (vc-register
3510 nil (list (car vc-handled-backends)
3511 (list (file-name-nondirectory tmp-name2))))))
3512 ;; vc-git uses an own process sentinel, Tramp's sentinel
3513 ;; for flushing the cache isn't used.
3514 (dired-uncache (concat (file-remote-p default-directory) "/"))
3515 (should (vc-registered (file-name-nondirectory tmp-name2)))))
3517 ;; Cleanup.
3518 (ignore-errors (delete-directory tmp-name1 'recursive))))))
3520 (ert-deftest tramp-test33-make-auto-save-file-name ()
3521 "Check `make-auto-save-file-name'."
3522 (skip-unless (tramp--test-enabled))
3524 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3525 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3526 (tmp-name2 (tramp--test-make-temp-name nil quoted)))
3528 (unwind-protect
3529 (progn
3530 ;; Use default `auto-save-file-name-transforms' mechanism.
3531 (let (tramp-auto-save-directory)
3532 (with-temp-buffer
3533 (setq buffer-file-name tmp-name1)
3534 (should
3535 (string-equal
3536 (make-auto-save-file-name)
3537 ;; This is taken from original `make-auto-save-file-name'.
3538 ;; We call `convert-standard-filename', because on
3539 ;; MS Windows the (local) colons must be replaced by
3540 ;; exclamation marks.
3541 (convert-standard-filename
3542 (expand-file-name
3543 (format
3544 "#%s#"
3545 (subst-char-in-string
3546 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3547 temporary-file-directory))))))
3549 ;; No mapping.
3550 (let (tramp-auto-save-directory auto-save-file-name-transforms)
3551 (with-temp-buffer
3552 (setq buffer-file-name tmp-name1)
3553 (should
3554 (string-equal
3555 (make-auto-save-file-name)
3556 (funcall
3557 (if quoted 'tramp-compat-file-name-quote 'identity)
3558 (expand-file-name
3559 (format "#%s#" (file-name-nondirectory tmp-name1))
3560 tramp-test-temporary-file-directory))))))
3562 ;; TODO: The following two cases don't work yet.
3563 (when nil
3564 ;; Use default `tramp-auto-save-directory' mechanism.
3565 (let ((tramp-auto-save-directory tmp-name2))
3566 (with-temp-buffer
3567 (setq buffer-file-name tmp-name1)
3568 (should
3569 (string-equal
3570 (make-auto-save-file-name)
3571 ;; This is taken from Tramp.
3572 (expand-file-name
3573 (format
3574 "#%s#"
3575 (tramp-subst-strs-in-string
3576 '(("_" . "|")
3577 ("/" . "_a")
3578 (":" . "_b")
3579 ("|" . "__")
3580 ("[" . "_l")
3581 ("]" . "_r"))
3582 (tramp-compat-file-name-unquote tmp-name1)))
3583 tmp-name2)))
3584 (should (file-directory-p tmp-name2))))
3586 ;; Relative file names shall work, too.
3587 (let ((tramp-auto-save-directory "."))
3588 (with-temp-buffer
3589 (setq buffer-file-name tmp-name1
3590 default-directory tmp-name2)
3591 (should
3592 (string-equal
3593 (make-auto-save-file-name)
3594 ;; This is taken from Tramp.
3595 (expand-file-name
3596 (format
3597 "#%s#"
3598 (tramp-subst-strs-in-string
3599 '(("_" . "|")
3600 ("/" . "_a")
3601 (":" . "_b")
3602 ("|" . "__")
3603 ("[" . "_l")
3604 ("]" . "_r"))
3605 (tramp-compat-file-name-unquote tmp-name1)))
3606 tmp-name2)))
3607 (should (file-directory-p tmp-name2)))))
3608 ) ;; TODO
3610 ;; Cleanup.
3611 (ignore-errors (delete-file tmp-name1))
3612 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3614 ;; The functions were introduced in Emacs 26.1.
3615 (ert-deftest tramp-test34-make-nearby-temp-file ()
3616 "Check `make-nearby-temp-file' and `temporary-file-directory'."
3617 (skip-unless (tramp--test-enabled))
3618 ;; Since Emacs 26.1.
3619 (skip-unless
3620 (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
3622 ;; `make-nearby-temp-file' and `temporary-file-directory' exists
3623 ;; since Emacs 26. We don't want to see compiler warnings for older
3624 ;; Emacsen.
3625 (let ((default-directory tramp-test-temporary-file-directory)
3626 tmp-file)
3627 ;; The remote host shall know a temporary file directory.
3628 (should (stringp (with-no-warnings (temporary-file-directory))))
3629 (should
3630 (string-equal
3631 (file-remote-p default-directory)
3632 (file-remote-p (with-no-warnings (temporary-file-directory)))))
3634 ;; The temporary file shall be located on the remote host.
3635 (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test")))
3636 (should (file-exists-p tmp-file))
3637 (should (file-regular-p tmp-file))
3638 (should
3639 (string-equal
3640 (file-remote-p default-directory)
3641 (file-remote-p tmp-file)))
3642 (delete-file tmp-file)
3643 (should-not (file-exists-p tmp-file))
3645 (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test" 'dir)))
3646 (should (file-exists-p tmp-file))
3647 (should (file-directory-p tmp-file))
3648 (delete-directory tmp-file)
3649 (should-not (file-exists-p tmp-file))))
3651 (defun tramp--test-adb-p ()
3652 "Check, whether the remote host runs Android.
3653 This requires restrictions of file name syntax."
3654 (tramp-adb-file-name-p tramp-test-temporary-file-directory))
3656 (defun tramp--test-docker-p ()
3657 "Check, whether the docker method is used.
3658 This does not support some special file names."
3659 (string-equal
3660 "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
3662 (defun tramp--test-ftp-p ()
3663 "Check, whether an FTP-like method is used.
3664 This does not support globbing characters in file names (yet)."
3665 ;; Globbing characters are ??, ?* and ?\[.
3666 (string-match
3667 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
3669 (defun tramp--test-gvfs-p (&optional method)
3670 "Check, whether the remote host runs a GVFS based method.
3671 This requires restrictions of file name syntax."
3672 (or (member method tramp-gvfs-methods)
3673 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)))
3675 (defun tramp--test-hpux-p ()
3676 "Check, whether the remote host runs HP-UX.
3677 Several special characters do not work properly there."
3678 ;; We must refill the cache. `file-truename' does it.
3679 (with-parsed-tramp-file-name
3680 (file-truename tramp-test-temporary-file-directory) nil
3681 (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
3683 (defun tramp--test-rsync-p ()
3684 "Check, whether the rsync method is used.
3685 This does not support special file names."
3686 (string-equal
3687 "rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
3689 (defun tramp--test-sh-p ()
3690 "Check, whether the remote host runs a based method from tramp-sh.el."
3692 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
3693 'tramp-sh-file-name-handler))
3695 (defun tramp--test-windows-nt-and-batch ()
3696 "Check, whether the locale host runs MS Windows in batch mode.
3697 This does not support special characters."
3698 (and (eq system-type 'windows-nt) noninteractive))
3700 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
3701 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
3702 This does not support utf8 based file transfer."
3703 (and (eq system-type 'windows-nt)
3704 (string-match
3705 (regexp-opt '("pscp" "psftp"))
3706 (file-remote-p tramp-test-temporary-file-directory 'method))))
3708 (defun tramp--test-windows-nt-or-smb-p ()
3709 "Check, whether the locale or remote host runs MS Windows.
3710 This requires restrictions of file name syntax."
3711 (or (eq system-type 'windows-nt)
3712 (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
3714 (defun tramp--test-check-files (&rest files)
3715 "Run a simple but comprehensive test over every file in FILES."
3716 ;; TODO: The quoted case does not work.
3717 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3718 (let (quoted)
3719 ;; We must use `file-truename' for the temporary directory,
3720 ;; because it could be located on a symlinked directory. This
3721 ;; would let the test fail.
3722 (let* ((tramp-test-temporary-file-directory
3723 (file-truename tramp-test-temporary-file-directory))
3724 (tmp-name1 (tramp--test-make-temp-name nil quoted))
3725 (tmp-name2 (tramp--test-make-temp-name 'local quoted))
3726 (files (delq nil files))
3727 (process-environment process-environment))
3728 (unwind-protect
3729 (progn
3730 (make-directory tmp-name1)
3731 (make-directory tmp-name2)
3733 (dolist (elt files)
3734 (let* ((file1 (expand-file-name elt tmp-name1))
3735 (file2 (expand-file-name elt tmp-name2))
3736 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
3737 (write-region elt nil file1)
3738 (should (file-exists-p file1))
3740 ;; Check file contents.
3741 (with-temp-buffer
3742 (insert-file-contents file1)
3743 (should (string-equal (buffer-string) elt)))
3745 ;; Copy file both directions.
3746 (copy-file file1 (file-name-as-directory tmp-name2))
3747 (should (file-exists-p file2))
3748 (delete-file file1)
3749 (should-not (file-exists-p file1))
3750 (copy-file file2 (file-name-as-directory tmp-name1))
3751 (should (file-exists-p file1))
3753 (tramp--test-ignore-make-symbolic-link-error
3754 (make-symbolic-link file1 file3)
3755 (should (file-symlink-p file3))
3756 (should
3757 (string-equal
3758 (expand-file-name file1) (file-truename file3)))
3759 (should
3760 (string-equal
3761 (funcall
3762 (if quoted 'tramp-compat-file-name-quote 'identity)
3763 (car (file-attributes file3)))
3764 (file-remote-p (file-truename file1) 'localname)))
3765 ;; Check file contents.
3766 (with-temp-buffer
3767 (insert-file-contents file3)
3768 (should (string-equal (buffer-string) elt)))
3769 (delete-file file3))))
3771 ;; Check file names.
3772 (should (equal (directory-files
3773 tmp-name1 nil directory-files-no-dot-files-regexp)
3774 (sort (copy-sequence files) 'string-lessp)))
3775 (should (equal (directory-files
3776 tmp-name2 nil directory-files-no-dot-files-regexp)
3777 (sort (copy-sequence files) 'string-lessp)))
3779 ;; `substitute-in-file-name' could return different
3780 ;; values. For `adb', there could be strange file
3781 ;; permissions preventing overwriting a file. We don't
3782 ;; care in this testcase.
3783 (dolist (elt files)
3784 (let ((file1
3785 (substitute-in-file-name (expand-file-name elt tmp-name1)))
3786 (file2
3787 (substitute-in-file-name
3788 (expand-file-name elt tmp-name2))))
3789 (ignore-errors (write-region elt nil file1))
3790 (should (file-exists-p file1))
3791 (ignore-errors (write-region elt nil file2 nil 'nomessage))
3792 (should (file-exists-p file2))))
3794 (should (equal (directory-files
3795 tmp-name1 nil directory-files-no-dot-files-regexp)
3796 (directory-files
3797 tmp-name2 nil directory-files-no-dot-files-regexp)))
3799 ;; Check directory creation. We use a subdirectory "foo"
3800 ;; in order to avoid conflicts with previous file name tests.
3801 (dolist (elt files)
3802 (let* ((elt1 (concat elt "foo"))
3803 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
3804 (file2 (expand-file-name elt file1))
3805 (file3 (expand-file-name elt1 file1)))
3806 (make-directory file1 'parents)
3807 (should (file-directory-p file1))
3808 (write-region elt nil file2)
3809 (should (file-exists-p file2))
3810 (should
3811 (equal
3812 (directory-files
3813 file1 nil directory-files-no-dot-files-regexp)
3814 `(,elt)))
3815 (should
3816 (equal
3817 (caar (directory-files-and-attributes
3818 file1 nil directory-files-no-dot-files-regexp))
3819 elt))
3821 ;; Check symlink in `directory-files-and-attributes'.
3822 ;; It does not work in the "smb" case, only relative
3823 ;; symlinks to existing files are shown there.
3824 (tramp--test-ignore-make-symbolic-link-error
3825 (unless
3826 (tramp-smb-file-name-p tramp-test-temporary-file-directory)
3827 (make-symbolic-link file2 file3)
3828 (should (file-symlink-p file3))
3829 (should
3830 (string-equal
3831 (caar (directory-files-and-attributes
3832 file1 nil (regexp-quote elt1)))
3833 elt1))
3834 (should
3835 (string-equal
3836 (funcall
3837 (if quoted 'tramp-compat-file-name-quote 'identity)
3838 (cadr (car (directory-files-and-attributes
3839 file1 nil (regexp-quote elt1)))))
3840 (file-remote-p (file-truename file2) 'localname)))
3841 (delete-file file3)
3842 (should-not (file-exists-p file3))))
3844 (delete-file file2)
3845 (should-not (file-exists-p file2))
3846 (delete-directory file1)
3847 (should-not (file-exists-p file1))))
3849 ;; Check, that environment variables are set correctly.
3850 (when (and tramp--test-expensive-test (tramp--test-sh-p))
3851 (dolist (elt files)
3852 (let ((envvar (concat "VAR_" (upcase (md5 elt))))
3853 (default-directory tramp-test-temporary-file-directory)
3854 (process-environment process-environment))
3855 (setenv envvar elt)
3856 ;; The value of PS1 could confuse Tramp's detection
3857 ;; of process output. So we unset it temporarily.
3858 (setenv "PS1")
3859 (with-temp-buffer
3860 (should (zerop (process-file "env" nil t nil)))
3861 (goto-char (point-min))
3862 (should
3863 (re-search-forward
3864 (format
3865 "^%s=%s$"
3866 (regexp-quote envvar)
3867 (regexp-quote (getenv envvar))))))))))
3869 ;; Cleanup.
3870 (ignore-errors (delete-directory tmp-name1 'recursive))
3871 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3873 (defun tramp--test-special-characters ()
3874 "Perform the test in `tramp-test35-special-characters*'."
3875 ;; Newlines, slashes and backslashes in file names are not
3876 ;; supported. So we don't test. And we don't test the tab
3877 ;; character on Windows or Cygwin, because the backslash is
3878 ;; interpreted as a path separator, preventing "\t" from being
3879 ;; expanded to <TAB>.
3880 (tramp--test-check-files
3881 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3882 "foo bar baz"
3883 (if (or (tramp--test-adb-p)
3884 (tramp--test-docker-p)
3885 (eq system-type 'cygwin))
3886 " foo bar baz "
3887 " foo\tbar baz\t"))
3888 "$foo$bar$$baz$"
3889 "-foo-bar-baz-"
3890 "%foo%bar%baz%"
3891 "&foo&bar&baz&"
3892 (unless (or (tramp--test-ftp-p)
3893 (tramp--test-gvfs-p)
3894 (tramp--test-windows-nt-or-smb-p))
3895 "?foo?bar?baz?")
3896 (unless (or (tramp--test-ftp-p)
3897 (tramp--test-gvfs-p)
3898 (tramp--test-windows-nt-or-smb-p))
3899 "*foo*bar*baz*")
3900 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3901 "'foo'bar'baz'"
3902 "'foo\"bar'baz\"")
3903 "#foo~bar#baz~"
3904 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3905 "!foo!bar!baz!"
3906 "!foo|bar!baz|")
3907 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3908 ";foo;bar;baz;"
3909 ":foo;bar:baz;")
3910 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3911 "<foo>bar<baz>")
3912 "(foo)bar(baz)"
3913 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
3914 "{foo}bar{baz}"))
3916 ;; These tests are inspired by Bug#17238.
3917 (ert-deftest tramp-test35-special-characters ()
3918 "Check special characters in file names."
3919 (skip-unless (tramp--test-enabled))
3920 (skip-unless (not (tramp--test-rsync-p)))
3921 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3923 (tramp--test-special-characters))
3925 (ert-deftest tramp-test35-special-characters-with-stat ()
3926 "Check special characters in file names.
3927 Use the `stat' command."
3928 :tags '(:expensive-test)
3929 (skip-unless (tramp--test-enabled))
3930 (skip-unless (tramp--test-sh-p))
3931 (skip-unless (not (tramp--test-rsync-p)))
3932 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3933 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3934 (skip-unless (tramp-get-remote-stat v)))
3936 (let ((tramp-connection-properties
3937 (append
3938 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3939 "perl" nil))
3940 tramp-connection-properties)))
3941 (tramp--test-special-characters)))
3943 (ert-deftest tramp-test35-special-characters-with-perl ()
3944 "Check special characters in file names.
3945 Use the `perl' command."
3946 :tags '(:expensive-test)
3947 (skip-unless (tramp--test-enabled))
3948 (skip-unless (tramp--test-sh-p))
3949 (skip-unless (not (tramp--test-rsync-p)))
3950 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3951 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3952 (skip-unless (tramp-get-remote-perl v)))
3954 (let ((tramp-connection-properties
3955 (append
3956 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3957 "stat" nil)
3958 ;; See `tramp-sh-handle-file-truename'.
3959 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3960 "readlink" nil))
3961 tramp-connection-properties)))
3962 (tramp--test-special-characters)))
3964 (ert-deftest tramp-test35-special-characters-with-ls ()
3965 "Check special characters in file names.
3966 Use the `ls' command."
3967 :tags '(:expensive-test)
3968 (skip-unless (tramp--test-enabled))
3969 (skip-unless (tramp--test-sh-p))
3970 (skip-unless (not (tramp--test-rsync-p)))
3971 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3972 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3974 (let ((tramp-connection-properties
3975 (append
3976 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3977 "perl" nil)
3978 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3979 "stat" nil)
3980 ;; See `tramp-sh-handle-file-truename'.
3981 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3982 "readlink" nil))
3983 tramp-connection-properties)))
3984 (tramp--test-special-characters)))
3986 (defun tramp--test-utf8 ()
3987 "Perform the test in `tramp-test36-utf8*'."
3988 (let* ((utf8 (if (and (eq system-type 'darwin)
3989 (memq 'utf-8-hfs (coding-system-list)))
3990 'utf-8-hfs 'utf-8))
3991 (coding-system-for-read utf8)
3992 (coding-system-for-write utf8)
3993 (file-name-coding-system
3994 (coding-system-change-eol-conversion utf8 'unix)))
3995 (tramp--test-check-files
3996 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
3997 (unless (tramp--test-hpux-p)
3998 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
3999 "银河系漫游指南系列"
4000 "Автостопом по гала́ктике")))
4002 (ert-deftest tramp-test36-utf8 ()
4003 "Check UTF8 encoding in file names and file contents."
4004 (skip-unless (tramp--test-enabled))
4005 (skip-unless (not (tramp--test-docker-p)))
4006 (skip-unless (not (tramp--test-rsync-p)))
4007 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4008 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4010 (tramp--test-utf8))
4012 (ert-deftest tramp-test36-utf8-with-stat ()
4013 "Check UTF8 encoding in file names and file contents.
4014 Use the `stat' command."
4015 :tags '(:expensive-test)
4016 (skip-unless (tramp--test-enabled))
4017 (skip-unless (tramp--test-sh-p))
4018 (skip-unless (not (tramp--test-docker-p)))
4019 (skip-unless (not (tramp--test-rsync-p)))
4020 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4021 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4022 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4023 (skip-unless (tramp-get-remote-stat v)))
4025 (let ((tramp-connection-properties
4026 (append
4027 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4028 "perl" nil))
4029 tramp-connection-properties)))
4030 (tramp--test-utf8)))
4032 (ert-deftest tramp-test36-utf8-with-perl ()
4033 "Check UTF8 encoding in file names and file contents.
4034 Use the `perl' command."
4035 :tags '(:expensive-test)
4036 (skip-unless (tramp--test-enabled))
4037 (skip-unless (tramp--test-sh-p))
4038 (skip-unless (not (tramp--test-docker-p)))
4039 (skip-unless (not (tramp--test-rsync-p)))
4040 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4041 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4042 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4043 (skip-unless (tramp-get-remote-perl v)))
4045 (let ((tramp-connection-properties
4046 (append
4047 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4048 "stat" nil)
4049 ;; See `tramp-sh-handle-file-truename'.
4050 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4051 "readlink" nil))
4052 tramp-connection-properties)))
4053 (tramp--test-utf8)))
4055 (ert-deftest tramp-test36-utf8-with-ls ()
4056 "Check UTF8 encoding in file names and file contents.
4057 Use the `ls' command."
4058 :tags '(:expensive-test)
4059 (skip-unless (tramp--test-enabled))
4060 (skip-unless (tramp--test-sh-p))
4061 (skip-unless (not (tramp--test-docker-p)))
4062 (skip-unless (not (tramp--test-rsync-p)))
4063 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4064 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4066 (let ((tramp-connection-properties
4067 (append
4068 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4069 "perl" nil)
4070 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4071 "stat" nil)
4072 ;; See `tramp-sh-handle-file-truename'.
4073 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
4074 "readlink" nil))
4075 tramp-connection-properties)))
4076 (tramp--test-utf8)))
4078 (defun tramp--test-timeout-handler ()
4079 (interactive)
4080 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
4082 ;; This test is inspired by Bug#16928.
4083 (ert-deftest tramp-test37-asynchronous-requests ()
4084 "Check parallel asynchronous requests.
4085 Such requests could arrive from timers, process filters and
4086 process sentinels. They shall not disturb each other."
4087 :tags '(:expensive-test)
4088 (skip-unless (tramp--test-enabled))
4089 (skip-unless (tramp--test-sh-p))
4091 ;; This test could be blocked on hydra. So we set a timeout of 300
4092 ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
4093 (with-timeout (300 (tramp--test-timeout-handler))
4094 (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler)
4095 (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
4096 (let* (;; For the watchdog.
4097 (default-directory (expand-file-name temporary-file-directory))
4098 (watchdog
4099 (start-process
4100 "*watchdog*" nil shell-file-name shell-command-switch
4101 (format "sleep 300; kill -USR1 %d" (emacs-pid))))
4102 (tmp-name (tramp--test-make-temp-name))
4103 (default-directory tmp-name)
4104 ;; Do not cache Tramp properties.
4105 (remote-file-name-inhibit-cache t)
4106 (process-file-side-effects t)
4107 ;; Suppress nasty messages.
4108 (inhibit-message t)
4109 ;; Do not run delayed timers.
4110 (timer-max-repeats 0)
4111 ;; Number of asynchronous processes for test.
4112 (number-proc 10)
4113 ;; On hydra, timings are bad.
4114 (timer-repeat
4115 (cond
4116 ((getenv "EMACS_HYDRA_CI") 10)
4117 (t 1)))
4118 ;; We must distinguish due to performance reasons.
4119 (timer-operation
4120 (cond
4121 ((string-equal "mock" (file-remote-p tmp-name 'method))
4122 'vc-registered)
4123 (t 'file-attributes)))
4124 timer buffers kill-buffer-query-functions)
4126 (unwind-protect
4127 (progn
4128 (make-directory tmp-name)
4130 ;; Setup a timer in order to raise an ordinary command
4131 ;; again and again. `vc-registered' is well suited,
4132 ;; because there are many checks.
4133 (setq
4134 timer
4135 (run-at-time
4136 0 timer-repeat
4137 (lambda ()
4138 (when buffers
4139 (let ((time (float-time))
4140 (default-directory tmp-name)
4141 (file
4142 (buffer-name (nth (random (length buffers)) buffers))))
4143 (tramp--test-message
4144 "Start timer %s %s" file (current-time-string))
4145 (funcall timer-operation file)
4146 ;; Adjust timer if it takes too much time.
4147 (when (> (- (float-time) time) timer-repeat)
4148 (setq timer-repeat (* 1.5 timer-repeat))
4149 (setf (timer--repeat-delay timer) timer-repeat)
4150 (tramp--test-message "Increase timer %s" timer-repeat))
4151 (tramp--test-message
4152 "Stop timer %s %s" file (current-time-string)))))))
4154 ;; Create temporary buffers. The number of buffers
4155 ;; corresponds to the number of processes; it could be
4156 ;; increased in order to make pressure on Tramp.
4157 (dotimes (_ number-proc)
4158 (setq buffers (cons (generate-new-buffer "foo") buffers)))
4160 ;; Open asynchronous processes. Set process filter and sentinel.
4161 (dolist (buf buffers)
4162 ;; Activate timer.
4163 (sit-for 0.01 'nodisp)
4164 (let ((proc
4165 (start-file-process-shell-command
4166 (buffer-name buf) buf
4167 (concat
4168 "(read line && echo $line >$line);"
4169 "(read line && cat $line);"
4170 "(read line && rm $line)")))
4171 (file (expand-file-name (buffer-name buf))))
4172 ;; Remember the file name. Add counter.
4173 (process-put proc 'foo file)
4174 (process-put proc 'bar 0)
4175 ;; Add process filter.
4176 (set-process-filter
4177 proc
4178 (lambda (proc string)
4179 (with-current-buffer (process-buffer proc)
4180 (insert string))
4181 (unless (zerop (length string))
4182 (should (file-attributes (process-get proc 'foo))))))
4183 ;; Add process sentinel.
4184 (set-process-sentinel
4185 proc
4186 (lambda (proc _state)
4187 (should-not (file-attributes (process-get proc 'foo)))))))
4189 ;; Send a string. Use a random order of the buffers. Mix
4190 ;; with regular operation.
4191 (let ((buffers (copy-sequence buffers)))
4192 (while buffers
4193 ;; Activate timer.
4194 (sit-for 0.01 'nodisp)
4195 (let* ((buf (nth (random (length buffers)) buffers))
4196 (proc (get-buffer-process buf))
4197 (file (process-get proc 'foo))
4198 (count (process-get proc 'bar)))
4199 (tramp--test-message
4200 "Start action %d %s %s" count buf (current-time-string))
4201 ;; Regular operation prior process action.
4202 (if (= count 0)
4203 (should-not (file-attributes file))
4204 (should (file-attributes file)))
4205 ;; Send string to process.
4206 (process-send-string proc (format "%s\n" (buffer-name buf)))
4207 (accept-process-output proc 0.1 nil 0)
4208 ;; Give the watchdog a chance.
4209 (read-event nil nil 0.01)
4210 ;; Regular operation post process action.
4211 (if (= count 2)
4212 (should-not (file-attributes file))
4213 (should (file-attributes file)))
4214 (tramp--test-message
4215 "Stop action %d %s %s" count buf (current-time-string))
4216 (process-put proc 'bar (1+ count))
4217 (unless (process-live-p proc)
4218 (setq buffers (delq buf buffers))))))
4220 ;; Checks. All process output shall exists in the
4221 ;; respective buffers. All created files shall be
4222 ;; deleted.
4223 (tramp--test-message "Check %s" (current-time-string))
4224 (dolist (buf buffers)
4225 (with-current-buffer buf
4226 (should (string-equal (format "%s\n" buf) (buffer-string)))))
4227 (should-not
4228 (directory-files
4229 tmp-name nil directory-files-no-dot-files-regexp)))
4231 ;; Cleanup.
4232 (define-key special-event-map [sigusr1] 'ignore)
4233 (ignore-errors (quit-process watchdog))
4234 (dolist (buf buffers)
4235 (ignore-errors (delete-process (get-buffer-process buf)))
4236 (ignore-errors (kill-buffer buf)))
4237 (ignore-errors (cancel-timer timer))
4238 (ignore-errors (delete-directory tmp-name 'recursive)))))))
4240 (ert-deftest tramp-test38-recursive-load ()
4241 "Check that Tramp does not fail due to recursive load."
4242 (skip-unless (tramp--test-enabled))
4244 (let ((default-directory (expand-file-name temporary-file-directory)))
4245 (dolist (code
4246 (list
4247 (format
4248 "(expand-file-name %S)" tramp-test-temporary-file-directory)
4249 (format
4250 "(let ((default-directory %S)) (expand-file-name %S))"
4251 tramp-test-temporary-file-directory
4252 temporary-file-directory)))
4253 (should-not
4254 (string-match
4255 "Recursive load"
4256 (shell-command-to-string
4257 (format
4258 "%s -batch -Q -L %s --eval %s"
4259 (expand-file-name invocation-name invocation-directory)
4260 (mapconcat 'shell-quote-argument load-path " -L ")
4261 (shell-quote-argument code))))))))
4263 (ert-deftest tramp-test39-remote-load-path ()
4264 "Check that Tramp autoloads its packages with remote `load-path'."
4265 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
4266 ;; It shall still work, when a remote file name is in the
4267 ;; `load-path'.
4268 (let ((default-directory (expand-file-name temporary-file-directory))
4269 (code
4270 "(let ((force-load-messages t) \
4271 (load-path (cons \"/foo:bar:\" load-path))) \
4272 (tramp-cleanup-all-connections))"))
4273 (should
4274 (string-match
4275 (format
4276 "Loading %s"
4277 (expand-file-name
4278 "tramp-cmds" (file-name-directory (locate-library "tramp"))))
4279 (shell-command-to-string
4280 (format
4281 "%s -batch -Q -L %s -l tramp-sh --eval %s"
4282 (expand-file-name invocation-name invocation-directory)
4283 (mapconcat 'shell-quote-argument load-path " -L ")
4284 (shell-quote-argument code)))))))
4286 (ert-deftest tramp-test40-unload ()
4287 "Check that Tramp and its subpackages unload completely.
4288 Since it unloads Tramp, it shall be the last test to run."
4289 :tags '(:expensive-test)
4290 (skip-unless noninteractive)
4292 (when (featurep 'tramp)
4293 (unload-feature 'tramp 'force)
4294 ;; No Tramp feature must be left.
4295 (should-not (featurep 'tramp))
4296 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
4297 ;; `file-name-handler-alist' must be clean.
4298 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
4299 ;; There shouldn't be left a bound symbol, except buffer-local
4300 ;; variables, and autoload functions. We do not regard our test
4301 ;; symbols, and the Tramp unload hooks.
4302 (mapatoms
4303 (lambda (x)
4304 (and (or (and (boundp x) (null (local-variable-if-set-p x)))
4305 (and (functionp x) (null (autoloadp (symbol-function x)))))
4306 (string-match "^tramp" (symbol-name x))
4307 (not (string-match "^tramp--?test" (symbol-name x)))
4308 (not (string-match "unload-hook$" (symbol-name x)))
4309 (ert-fail (format "`%s' still bound" x)))))
4310 ;; The defstruct `tramp-file-name' and all its internal functions
4311 ;; shall be purged.
4312 (should-not (cl--find-class 'tramp-file-name))
4313 (mapatoms
4314 (lambda (x)
4315 (and (functionp x)
4316 (string-match "tramp-file-name" (symbol-name x))
4317 (ert-fail (format "Structure function `%s' still exists" x)))))
4318 ;; There shouldn't be left a hook function containing a Tramp
4319 ;; function. We do not regard the Tramp unload hooks.
4320 (mapatoms
4321 (lambda (x)
4322 (and (boundp x)
4323 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
4324 (not (string-match "unload-hook$" (symbol-name x)))
4325 (consp (symbol-value x))
4326 (ignore-errors (all-completions "tramp" (symbol-value x)))
4327 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
4329 ;; TODO:
4331 ;; * dired-compress-file
4332 ;; * dired-uncache
4333 ;; * file-acl
4334 ;; * file-name-case-insensitive-p
4335 ;; * file-selinux-context
4336 ;; * find-backup-file-name
4337 ;; * set-file-acl
4338 ;; * set-file-selinux-context
4340 ;; * Work on skipped tests. Make a comment, when it is impossible.
4341 ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
4342 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4343 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
4344 ;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'.
4346 (defun tramp-test-all (&optional interactive)
4347 "Run all tests for \\[tramp]."
4348 (interactive "p")
4349 (funcall
4350 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
4352 (provide 'tramp-tests)
4353 ;;; tramp-tests.el ends here