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