; Spelling fixes
[emacs.git] / test / lisp / net / tramp-tests.el
blob3d92dff38113a0c09144009c5efc44ff54aa9bac
1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `http://www.gnu.org/licenses/'.
20 ;;; Commentary:
22 ;; The tests require a recent ert.el from Emacs 24.4.
24 ;; Some of the tests require access to a remote host files. Since
25 ;; this could be problematic, a mock-up connection method "mock" is
26 ;; used. Emulating a remote connection, it simply calls "sh -i".
27 ;; Tramp's file name handlers still run, so this test is sufficient
28 ;; except for connection establishing.
30 ;; If you want to test a real Tramp connection, set
31 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
32 ;; overwrite the default value. If you want to skip tests accessing a
33 ;; remote host, set this environment variable to "/dev/null" or
34 ;; whatever is appropriate on your system.
36 ;; A whole test run can be performed calling the command `tramp-test-all'.
38 ;;; Code:
40 (require 'ert)
41 (require 'tramp)
42 (require 'vc)
43 (require 'vc-bzr)
44 (require 'vc-git)
45 (require 'vc-hg)
47 (autoload 'dired-uncache "dired")
48 (declare-function tramp-find-executable "tramp-sh")
49 (declare-function tramp-get-remote-path "tramp-sh")
50 (declare-function tramp-get-remote-stat "tramp-sh")
51 (declare-function tramp-get-remote-perl "tramp-sh")
52 (defvar tramp-copy-size-limit)
53 (defvar tramp-persistency-file-name)
54 (defvar tramp-remote-process-environment)
56 ;; There is no default value on w32 systems, which could work out of the box.
57 (defconst tramp-test-temporary-file-directory
58 (cond
59 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
60 ((eq system-type 'windows-nt) null-device)
61 (t (add-to-list
62 'tramp-methods
63 '("mock"
64 (tramp-login-program "sh")
65 (tramp-login-args (("-i")))
66 (tramp-remote-shell "/bin/sh")
67 (tramp-remote-shell-args ("-c"))
68 (tramp-connection-timeout 10)))
69 (format "/mock::%s" temporary-file-directory)))
70 "Temporary directory for Tramp tests.")
72 (setq password-cache-expiry nil
73 tramp-verbose 0
74 tramp-copy-size-limit nil
75 tramp-message-show-message nil
76 tramp-persistency-file-name nil)
78 ;; This shall happen on hydra only.
79 (when (getenv "NIX_STORE")
80 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
82 (defvar tramp--test-expensive-test
83 (null
84 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
85 "Whether expensive tests are run.")
87 (defvar tramp--test-enabled-checked nil
88 "Cached result of `tramp--test-enabled'.
89 If the function did run, the value is a cons cell, the `cdr'
90 being the result.")
92 (defun tramp--test-enabled ()
93 "Whether remote file access is enabled."
94 (unless (consp tramp--test-enabled-checked)
95 (setq
96 tramp--test-enabled-checked
97 (cons
98 t (ignore-errors
99 (and
100 (file-remote-p tramp-test-temporary-file-directory)
101 (file-directory-p tramp-test-temporary-file-directory)
102 (file-writable-p tramp-test-temporary-file-directory))))))
104 (when (cdr tramp--test-enabled-checked)
105 ;; Cleanup connection.
106 (ignore-errors
107 (tramp-cleanup-connection
108 (tramp-dissect-file-name tramp-test-temporary-file-directory)
109 nil 'keep-password)))
111 ;; Return result.
112 (cdr tramp--test-enabled-checked))
114 (defun tramp--test-make-temp-name (&optional local quoted)
115 "Create a temporary file name for test.
116 If LOCAL is non-nil, a local file is created.
117 If QUOTED is non-nil, the local part of the file is quoted."
118 (funcall
119 (if quoted 'tramp-compat-file-name-quote 'identity)
120 (expand-file-name
121 (make-temp-name "tramp-test")
122 (if local temporary-file-directory tramp-test-temporary-file-directory))))
124 (defmacro tramp--instrument-test-case (verbose &rest body)
125 "Run BODY with `tramp-verbose' equal VERBOSE.
126 Print the the content of the Tramp debug buffer, if BODY does not
127 eval properly in `should' or `should-not'. `should-error' is not
128 handled properly. BODY shall not contain a timeout."
129 (declare (indent 1) (debug (natnump body)))
130 `(let ((tramp-verbose ,verbose)
131 (tramp-debug-on-error t)
132 (debug-ignored-errors
133 (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
134 (unwind-protect
135 (progn ,@body)
136 (when (> tramp-verbose 3)
137 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
138 (with-current-buffer (tramp-get-connection-buffer v)
139 (message "%s" (buffer-string)))
140 (with-current-buffer (tramp-get-debug-buffer v)
141 (message "%s" (buffer-string))))))))
143 (ert-deftest tramp-test00-availability ()
144 "Test availability of Tramp functions."
145 :expected-result (if (tramp--test-enabled) :passed :failed)
146 (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
147 (should (ignore-errors
148 (and
149 (file-remote-p tramp-test-temporary-file-directory)
150 (file-directory-p tramp-test-temporary-file-directory)
151 (file-writable-p tramp-test-temporary-file-directory)))))
153 (ert-deftest tramp-test01-file-name-syntax ()
154 "Check remote file name syntax."
155 ;; Simple cases.
156 (should (tramp-tramp-file-p "/method::"))
157 (should (tramp-tramp-file-p "/host:"))
158 (should (tramp-tramp-file-p "/user@:"))
159 (should (tramp-tramp-file-p "/user@host:"))
160 (should (tramp-tramp-file-p "/method:host:"))
161 (should (tramp-tramp-file-p "/method:user@:"))
162 (should (tramp-tramp-file-p "/method:user@host:"))
163 (should (tramp-tramp-file-p "/method:user@email@host:"))
165 ;; Using a port.
166 (should (tramp-tramp-file-p "/host#1234:"))
167 (should (tramp-tramp-file-p "/user@host#1234:"))
168 (should (tramp-tramp-file-p "/method:host#1234:"))
169 (should (tramp-tramp-file-p "/method:user@host#1234:"))
171 ;; Using an IPv4 address.
172 (should (tramp-tramp-file-p "/1.2.3.4:"))
173 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
174 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
175 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
177 ;; Using an IPv6 address.
178 (should (tramp-tramp-file-p "/[]:"))
179 (should (tramp-tramp-file-p "/[::1]:"))
180 (should (tramp-tramp-file-p "/user@[::1]:"))
181 (should (tramp-tramp-file-p "/method:[::1]:"))
182 (should (tramp-tramp-file-p "/method:user@[::1]:"))
184 ;; Local file name part.
185 (should (tramp-tramp-file-p "/host:/:"))
186 (should (tramp-tramp-file-p "/method:::"))
187 (should (tramp-tramp-file-p "/method::/:"))
188 (should (tramp-tramp-file-p "/method::/path/to/file"))
189 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
190 (should (tramp-tramp-file-p "/method::file"))
191 (should (tramp-tramp-file-p "/method::/:file"))
193 ;; Multihop.
194 (should (tramp-tramp-file-p "/method1:|method2::"))
195 (should (tramp-tramp-file-p "/method1:host1|host2:"))
196 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
197 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
198 (should (tramp-tramp-file-p
199 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
200 (should (tramp-tramp-file-p "/host1|host2:"))
201 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
203 ;; No strings.
204 (should-not (tramp-tramp-file-p nil))
205 (should-not (tramp-tramp-file-p 'symbol))
206 ;; Quote with "/:" suppresses file name handlers.
207 (should-not (tramp-tramp-file-p "/::"))
208 (should-not (tramp-tramp-file-p "/:@:"))
209 (should-not (tramp-tramp-file-p "/:[]:"))
210 ;; Methods or host names shall be at least two characters on MS Windows.
211 (let ((system-type 'windows-nt))
212 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
213 (should-not (tramp-tramp-file-p "/c::/path/to/file")))
214 (let ((system-type 'gnu/linux))
215 (should (tramp-tramp-file-p "/h:/path/to/file"))
216 (should (tramp-tramp-file-p "/m::/path/to/file"))))
218 (ert-deftest tramp-test02-file-name-dissect ()
219 "Check remote file name components."
220 (let ((tramp-default-method "default-method")
221 (tramp-default-user "default-user")
222 (tramp-default-host "default-host"))
223 ;; Expand `tramp-default-user' and `tramp-default-host'.
224 (should (string-equal
225 (file-remote-p "/method::")
226 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
227 (should (string-equal (file-remote-p "/method::" 'method) "method"))
228 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
229 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
230 (should (string-equal (file-remote-p "/method::" 'localname) ""))
231 (should (string-equal (file-remote-p "/method::" 'hop) nil))
233 ;; Expand `tramp-default-method' and `tramp-default-user'.
234 (should (string-equal
235 (file-remote-p "/host:")
236 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
237 (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
238 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
239 (should (string-equal (file-remote-p "/host:" 'host) "host"))
240 (should (string-equal (file-remote-p "/host:" 'localname) ""))
241 (should (string-equal (file-remote-p "/host:" 'hop) nil))
243 ;; Expand `tramp-default-method' and `tramp-default-host'.
244 (should (string-equal
245 (file-remote-p "/user@:")
246 (format "/%s:%s@%s:" "default-method""user" "default-host")))
247 (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
248 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
249 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
250 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
251 (should (string-equal (file-remote-p "/user@:" 'hop) nil))
253 ;; Expand `tramp-default-method'.
254 (should (string-equal
255 (file-remote-p "/user@host:")
256 (format "/%s:%s@%s:" "default-method" "user" "host")))
257 (should (string-equal
258 (file-remote-p "/user@host:" 'method) "default-method"))
259 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
260 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
261 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
262 (should (string-equal (file-remote-p "/user@host:" 'hop) nil))
264 ;; Expand `tramp-default-user'.
265 (should (string-equal
266 (file-remote-p "/method:host:")
267 (format "/%s:%s@%s:" "method" "default-user" "host")))
268 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
269 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
270 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
271 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
272 (should (string-equal (file-remote-p "/method:host:" 'hop) nil))
274 ;; Expand `tramp-default-host'.
275 (should (string-equal
276 (file-remote-p "/method:user@:")
277 (format "/%s:%s@%s:" "method" "user" "default-host")))
278 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
279 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
280 (should (string-equal (file-remote-p "/method:user@:" 'host)
281 "default-host"))
282 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
283 (should (string-equal (file-remote-p "/method:user@:" 'hop) nil))
285 ;; No expansion.
286 (should (string-equal
287 (file-remote-p "/method:user@host:")
288 (format "/%s:%s@%s:" "method" "user" "host")))
289 (should (string-equal
290 (file-remote-p "/method:user@host:" 'method) "method"))
291 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
292 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
293 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
294 (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil))
296 ;; No expansion.
297 (should (string-equal
298 (file-remote-p "/method:user@email@host:")
299 (format "/%s:%s@%s:" "method" "user@email" "host")))
300 (should (string-equal
301 (file-remote-p "/method:user@email@host:" 'method) "method"))
302 (should (string-equal
303 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
304 (should (string-equal
305 (file-remote-p "/method:user@email@host:" 'host) "host"))
306 (should (string-equal
307 (file-remote-p "/method:user@email@host:" 'localname) ""))
308 (should (string-equal
309 (file-remote-p "/method:user@email@host:" 'hop) nil))
311 ;; Expand `tramp-default-method' and `tramp-default-user'.
312 (should (string-equal
313 (file-remote-p "/host#1234:")
314 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
315 (should (string-equal
316 (file-remote-p "/host#1234:" 'method) "default-method"))
317 (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
318 (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
319 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
320 (should (string-equal (file-remote-p "/host#1234:" 'hop) nil))
322 ;; Expand `tramp-default-method'.
323 (should (string-equal
324 (file-remote-p "/user@host#1234:")
325 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
326 (should (string-equal
327 (file-remote-p "/user@host#1234:" 'method) "default-method"))
328 (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
329 (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
330 (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
331 (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil))
333 ;; Expand `tramp-default-user'.
334 (should (string-equal
335 (file-remote-p "/method:host#1234:")
336 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
337 (should (string-equal
338 (file-remote-p "/method:host#1234:" 'method) "method"))
339 (should (string-equal
340 (file-remote-p "/method:host#1234:" 'user) "default-user"))
341 (should (string-equal
342 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
343 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
344 (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil))
346 ;; No expansion.
347 (should (string-equal
348 (file-remote-p "/method:user@host#1234:")
349 (format "/%s:%s@%s:" "method" "user" "host#1234")))
350 (should (string-equal
351 (file-remote-p "/method:user@host#1234:" 'method) "method"))
352 (should (string-equal
353 (file-remote-p "/method:user@host#1234:" 'user) "user"))
354 (should (string-equal
355 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
356 (should (string-equal
357 (file-remote-p "/method:user@host#1234:" 'localname) ""))
358 (should (string-equal
359 (file-remote-p "/method:user@host#1234:" 'hop) nil))
361 ;; Expand `tramp-default-method' and `tramp-default-user'.
362 (should (string-equal
363 (file-remote-p "/1.2.3.4:")
364 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
365 (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
366 (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
367 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
368 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
369 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil))
371 ;; Expand `tramp-default-method'.
372 (should (string-equal
373 (file-remote-p "/user@1.2.3.4:")
374 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
375 (should (string-equal
376 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
377 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
378 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
379 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
380 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil))
382 ;; Expand `tramp-default-user'.
383 (should (string-equal
384 (file-remote-p "/method:1.2.3.4:")
385 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
386 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
387 (should (string-equal
388 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
389 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
390 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
391 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil))
393 ;; No expansion.
394 (should (string-equal
395 (file-remote-p "/method:user@1.2.3.4:")
396 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
397 (should (string-equal
398 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
399 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
400 (should (string-equal
401 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
402 (should (string-equal
403 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
404 (should (string-equal
405 (file-remote-p "/method:user@1.2.3.4:" 'hop) nil))
407 ;; Expand `tramp-default-method', `tramp-default-user' and
408 ;; `tramp-default-host'.
409 (should (string-equal
410 (file-remote-p "/[]:")
411 (format
412 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
413 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
414 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
415 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
416 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
417 (should (string-equal (file-remote-p "/[]:" 'hop) nil))
419 ;; Expand `tramp-default-method' and `tramp-default-user'.
420 (let ((tramp-default-host "::1"))
421 (should (string-equal
422 (file-remote-p "/[]:")
423 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
424 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
425 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
426 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
427 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
428 (should (string-equal (file-remote-p "/[]:" 'hop) nil)))
430 ;; Expand `tramp-default-method' and `tramp-default-user'.
431 (should (string-equal
432 (file-remote-p "/[::1]:")
433 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
434 (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
435 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
436 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
437 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
438 (should (string-equal (file-remote-p "/[::1]:" 'hop) nil))
440 ;; Expand `tramp-default-method'.
441 (should (string-equal
442 (file-remote-p "/user@[::1]:")
443 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
444 (should (string-equal
445 (file-remote-p "/user@[::1]:" 'method) "default-method"))
446 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
447 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
448 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
449 (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
451 ;; Expand `tramp-default-user'.
452 (should (string-equal
453 (file-remote-p "/method:[::1]:")
454 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
455 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
456 (should (string-equal
457 (file-remote-p "/method:[::1]:" 'user) "default-user"))
458 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
459 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
460 (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
462 ;; No expansion.
463 (should (string-equal
464 (file-remote-p "/method:user@[::1]:")
465 (format "/%s:%s@%s:" "method" "user" "[::1]")))
466 (should (string-equal
467 (file-remote-p "/method:user@[::1]:" 'method) "method"))
468 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
469 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
470 (should (string-equal
471 (file-remote-p "/method:user@[::1]:" 'localname) ""))
472 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
474 ;; Local file name part.
475 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
476 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
477 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
478 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
479 (should (string-equal
480 (file-remote-p "/method::/path/to/file" 'localname)
481 "/path/to/file"))
483 ;; Multihop.
484 (should
485 (string-equal
486 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
487 (format "/%s:%s@%s|%s:%s@%s:"
488 "method1" "user1" "host1" "method2" "user2" "host2")))
489 (should
490 (string-equal
491 (file-remote-p
492 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
493 "method2"))
494 (should
495 (string-equal
496 (file-remote-p
497 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
498 "user2"))
499 (should
500 (string-equal
501 (file-remote-p
502 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
503 "host2"))
504 (should
505 (string-equal
506 (file-remote-p
507 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
508 "/path/to/file"))
509 (should
510 (string-equal
511 (file-remote-p
512 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
513 (format "%s:%s@%s|"
514 "method1" "user1" "host1")))
516 (should
517 (string-equal
518 (file-remote-p
519 (concat
520 "/method1:user1@host1"
521 "|method2:user2@host2"
522 "|method3:user3@host3:/path/to/file"))
523 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
524 "method1" "user1" "host1"
525 "method2" "user2" "host2"
526 "method3" "user3" "host3")))
527 (should
528 (string-equal
529 (file-remote-p
530 (concat
531 "/method1:user1@host1"
532 "|method2:user2@host2"
533 "|method3:user3@host3:/path/to/file")
534 'method)
535 "method3"))
536 (should
537 (string-equal
538 (file-remote-p
539 (concat
540 "/method1:user1@host1"
541 "|method2:user2@host2"
542 "|method3:user3@host3:/path/to/file")
543 'user)
544 "user3"))
545 (should
546 (string-equal
547 (file-remote-p
548 (concat
549 "/method1:user1@host1"
550 "|method2:user2@host2"
551 "|method3:user3@host3:/path/to/file")
552 'host)
553 "host3"))
554 (should
555 (string-equal
556 (file-remote-p
557 (concat
558 "/method1:user1@host1"
559 "|method2:user2@host2"
560 "|method3:user3@host3:/path/to/file")
561 'localname)
562 "/path/to/file"))
563 (should
564 (string-equal
565 (file-remote-p
566 (concat
567 "/method1:user1@host1"
568 "|method2:user2@host2"
569 "|method3:user3@host3:/path/to/file")
570 'hop)
571 (format "%s:%s@%s|%s:%s@%s|"
572 "method1" "user1" "host1" "method2" "user2" "host2")))))
574 (ert-deftest tramp-test03-file-name-defaults ()
575 "Check default values for some methods."
576 ;; Default values in tramp-adb.el.
577 (should (string-equal (file-remote-p "/adb::" 'host) ""))
578 ;; Default values in tramp-ftp.el.
579 (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
580 (dolist (u '("ftp" "anonymous"))
581 (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
582 ;; Default values in tramp-gvfs.el.
583 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
584 (symbol-value 'tramp-gvfs-enabled))
585 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
586 ;; Default values in tramp-sh.el.
587 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
588 (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
589 (dolist (m '("su" "sudo" "ksu"))
590 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
591 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
592 (should
593 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
594 ;; Default values in tramp-smb.el.
595 (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
596 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
598 (ert-deftest tramp-test04-substitute-in-file-name ()
599 "Check `substitute-in-file-name'."
600 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
601 (should
602 (string-equal
603 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
604 (should
605 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
606 ;; Quoting local part.
607 (should
608 (string-equal
609 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
610 (should
611 (string-equal
612 (substitute-in-file-name "/method:host:/:/path//foo")
613 "/method:host:/:/path//foo"))
614 (should
615 (string-equal
616 (substitute-in-file-name "/method:host:/:/path///foo")
617 "/method:host:/:/path///foo"))
619 (should
620 (string-equal
621 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
622 (should
623 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
624 ;; Quoting local part.
625 (should
626 (string-equal
627 (substitute-in-file-name "/method:host:/:/path/~/foo")
628 "/method:host:/:/path/~/foo"))
629 (should
630 (string-equal
631 (substitute-in-file-name "/method:host:/:/path//~/foo")
632 "/method:host:/:/path//~/foo"))
634 (let (process-environment)
635 (should
636 (string-equal
637 (substitute-in-file-name "/method:host:/path/$FOO")
638 "/method:host:/path/$FOO"))
639 (setenv "FOO" "bla")
640 (should
641 (string-equal
642 (substitute-in-file-name "/method:host:/path/$FOO")
643 "/method:host:/path/bla"))
644 (should
645 (string-equal
646 (substitute-in-file-name "/method:host:/path/$$FOO")
647 "/method:host:/path/$FOO"))
648 ;; Quoting local part.
649 (should
650 (string-equal
651 (substitute-in-file-name "/method:host:/:/path/$FOO")
652 "/method:host:/:/path/$FOO"))
653 (setenv "FOO" "bla")
654 (should
655 (string-equal
656 (substitute-in-file-name "/method:host:/:/path/$FOO")
657 "/method:host:/:/path/$FOO"))
658 (should
659 (string-equal
660 (substitute-in-file-name "/method:host:/:/path/$$FOO")
661 "/method:host:/:/path/$$FOO"))))
663 (ert-deftest tramp-test05-expand-file-name ()
664 "Check `expand-file-name'."
665 (should
666 (string-equal
667 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
668 (should
669 (string-equal
670 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
671 ;; Quoting local part.
672 (should
673 (string-equal
674 (expand-file-name "/method:host:/:/path/./file")
675 "/method:host:/:/path/file"))
676 (should
677 (string-equal
678 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
679 (should
680 (string-equal
681 (expand-file-name "/method:host:/:/~/path/./file")
682 "/method:host:/:/~/path/file")))
684 (ert-deftest tramp-test06-directory-file-name ()
685 "Check `directory-file-name'.
686 This checks also `file-name-as-directory', `file-name-directory',
687 `file-name-nondirectory' and `unhandled-file-name-directory'."
688 (should
689 (string-equal
690 (directory-file-name "/method:host:/path/to/file")
691 "/method:host:/path/to/file"))
692 (should
693 (string-equal
694 (directory-file-name "/method:host:/path/to/file/")
695 "/method:host:/path/to/file"))
696 (should
697 (string-equal
698 (file-name-as-directory "/method:host:/path/to/file")
699 "/method:host:/path/to/file/"))
700 (should
701 (string-equal
702 (file-name-as-directory "/method:host:/path/to/file/")
703 "/method:host:/path/to/file/"))
704 (should
705 (string-equal
706 (file-name-directory "/method:host:/path/to/file")
707 "/method:host:/path/to/"))
708 (should
709 (string-equal
710 (file-name-directory "/method:host:/path/to/file/")
711 "/method:host:/path/to/file/"))
712 (should
713 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
714 (should
715 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
716 (should-not
717 (unhandled-file-name-directory "/method:host:/path/to/file"))
719 ;; Bug#10085.
720 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
721 (dolist (n-e '(nil t))
722 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
723 ;; which ruins the tests.
724 (let ((non-essential n-e)
725 tramp-default-method)
726 (dolist (file
727 `(,(file-remote-p tramp-test-temporary-file-directory 'method)
728 ,(file-remote-p tramp-test-temporary-file-directory 'host)))
729 (unless (zerop (length file))
730 (setq file (format "/%s:" file))
731 (should (string-equal (directory-file-name file) file))
732 (should
733 (string-equal
734 (file-name-as-directory file)
735 (if (tramp-completion-mode-p) file (concat file "./"))))
736 (should (string-equal (file-name-directory file) file))
737 (should (string-equal (file-name-nondirectory file) ""))))))))
739 (ert-deftest tramp-test07-file-exists-p ()
740 "Check `file-exist-p', `write-region' and `delete-file'."
741 (skip-unless (tramp--test-enabled))
743 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
744 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
745 (should-not (file-exists-p tmp-name))
746 (write-region "foo" nil tmp-name)
747 (should (file-exists-p tmp-name))
748 (delete-file tmp-name)
749 (should-not (file-exists-p tmp-name)))))
751 (ert-deftest tramp-test08-file-local-copy ()
752 "Check `file-local-copy'."
753 (skip-unless (tramp--test-enabled))
755 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
756 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
757 tmp-name2)
758 (unwind-protect
759 (progn
760 (write-region "foo" nil tmp-name1)
761 (should (setq tmp-name2 (file-local-copy tmp-name1)))
762 (with-temp-buffer
763 (insert-file-contents tmp-name2)
764 (should (string-equal (buffer-string) "foo")))
765 ;; Check also that a file transfer with compression works.
766 (let ((default-directory tramp-test-temporary-file-directory)
767 (tramp-copy-size-limit 4)
768 (tramp-inline-compress-start-size 2))
769 (delete-file tmp-name2)
770 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
772 ;; Cleanup.
773 (ignore-errors
774 (delete-file tmp-name1)
775 (delete-file tmp-name2))))))
777 (ert-deftest tramp-test09-insert-file-contents ()
778 "Check `insert-file-contents'."
779 (skip-unless (tramp--test-enabled))
781 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
782 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
783 (unwind-protect
784 (progn
785 (write-region "foo" nil tmp-name)
786 (with-temp-buffer
787 (insert-file-contents tmp-name)
788 (should (string-equal (buffer-string) "foo"))
789 (insert-file-contents tmp-name)
790 (should (string-equal (buffer-string) "foofoo"))
791 ;; Insert partly.
792 (insert-file-contents tmp-name nil 1 3)
793 (should (string-equal (buffer-string) "oofoofoo"))
794 ;; Replace.
795 (insert-file-contents tmp-name nil nil nil 'replace)
796 (should (string-equal (buffer-string) "foo"))))
798 ;; Cleanup.
799 (ignore-errors (delete-file tmp-name))))))
801 (ert-deftest tramp-test10-write-region ()
802 "Check `write-region'."
803 (skip-unless (tramp--test-enabled))
805 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
806 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
807 (unwind-protect
808 (progn
809 (with-temp-buffer
810 (insert "foo")
811 (write-region nil nil tmp-name))
812 (with-temp-buffer
813 (insert-file-contents tmp-name)
814 (should (string-equal (buffer-string) "foo")))
815 ;; Append.
816 (with-temp-buffer
817 (insert "bla")
818 (write-region nil nil tmp-name 'append))
819 (with-temp-buffer
820 (insert-file-contents tmp-name)
821 (should (string-equal (buffer-string) "foobla")))
822 ;; Write string.
823 (write-region "foo" nil tmp-name)
824 (with-temp-buffer
825 (insert-file-contents tmp-name)
826 (should (string-equal (buffer-string) "foo")))
827 ;; Write partly.
828 (with-temp-buffer
829 (insert "123456789")
830 (write-region 3 5 tmp-name))
831 (with-temp-buffer
832 (insert-file-contents tmp-name)
833 (should (string-equal (buffer-string) "34"))))
835 ;; Cleanup.
836 (ignore-errors (delete-file tmp-name))))))
838 (ert-deftest tramp-test11-copy-file ()
839 "Check `copy-file'."
840 (skip-unless (tramp--test-enabled))
842 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
843 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
844 (tmp-name2 (tramp--test-make-temp-name nil quoted))
845 (tmp-name3 (tramp--test-make-temp-name nil quoted))
846 (tmp-name4 (tramp--test-make-temp-name 'local quoted))
847 (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
849 ;; Copy on remote side.
850 (unwind-protect
851 (progn
852 (write-region "foo" nil tmp-name1)
853 (copy-file tmp-name1 tmp-name2)
854 (should (file-exists-p tmp-name2))
855 (with-temp-buffer
856 (insert-file-contents tmp-name2)
857 (should (string-equal (buffer-string) "foo")))
858 (should-error (copy-file tmp-name1 tmp-name2))
859 (copy-file tmp-name1 tmp-name2 'ok)
860 (make-directory tmp-name3)
861 (copy-file tmp-name1 tmp-name3)
862 (should
863 (file-exists-p
864 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
866 ;; Cleanup.
867 (ignore-errors (delete-file tmp-name1))
868 (ignore-errors (delete-file tmp-name2))
869 (ignore-errors (delete-directory tmp-name3 'recursive)))
871 ;; Copy from remote side to local side.
872 (unwind-protect
873 (progn
874 (write-region "foo" nil tmp-name1)
875 (copy-file tmp-name1 tmp-name4)
876 (should (file-exists-p tmp-name4))
877 (with-temp-buffer
878 (insert-file-contents tmp-name4)
879 (should (string-equal (buffer-string) "foo")))
880 (should-error (copy-file tmp-name1 tmp-name4))
881 (copy-file tmp-name1 tmp-name4 'ok)
882 (make-directory tmp-name5)
883 (copy-file tmp-name1 tmp-name5)
884 (should
885 (file-exists-p
886 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
888 ;; Cleanup.
889 (ignore-errors (delete-file tmp-name1))
890 (ignore-errors (delete-file tmp-name4))
891 (ignore-errors (delete-directory tmp-name5 'recursive)))
893 ;; Copy from local side to remote side.
894 (unwind-protect
895 (progn
896 (write-region "foo" nil tmp-name4 nil 'nomessage)
897 (copy-file tmp-name4 tmp-name1)
898 (should (file-exists-p tmp-name1))
899 (with-temp-buffer
900 (insert-file-contents tmp-name1)
901 (should (string-equal (buffer-string) "foo")))
902 (should-error (copy-file tmp-name4 tmp-name1))
903 (copy-file tmp-name4 tmp-name1 'ok)
904 (make-directory tmp-name3)
905 (copy-file tmp-name4 tmp-name3)
906 (should
907 (file-exists-p
908 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
910 ;; Cleanup.
911 (ignore-errors (delete-file tmp-name1))
912 (ignore-errors (delete-file tmp-name4))
913 (ignore-errors (delete-directory tmp-name3 'recursive))))))
915 (ert-deftest tramp-test12-rename-file ()
916 "Check `rename-file'."
917 (skip-unless (tramp--test-enabled))
919 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
920 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
921 (tmp-name2 (tramp--test-make-temp-name nil quoted))
922 (tmp-name3 (tramp--test-make-temp-name nil quoted))
923 (tmp-name4 (tramp--test-make-temp-name 'local quoted))
924 (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
926 ;; Rename on remote side.
927 (unwind-protect
928 (progn
929 (write-region "foo" nil tmp-name1)
930 (rename-file tmp-name1 tmp-name2)
931 (should-not (file-exists-p tmp-name1))
932 (should (file-exists-p tmp-name2))
933 (with-temp-buffer
934 (insert-file-contents tmp-name2)
935 (should (string-equal (buffer-string) "foo")))
936 (write-region "foo" nil tmp-name1)
937 (should-error (rename-file tmp-name1 tmp-name2))
938 (rename-file tmp-name1 tmp-name2 'ok)
939 (should-not (file-exists-p tmp-name1))
940 (write-region "foo" nil tmp-name1)
941 (make-directory tmp-name3)
942 (rename-file tmp-name1 tmp-name3)
943 (should-not (file-exists-p tmp-name1))
944 (should
945 (file-exists-p
946 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
948 ;; Cleanup.
949 (ignore-errors (delete-file tmp-name1))
950 (ignore-errors (delete-file tmp-name2))
951 (ignore-errors (delete-directory tmp-name3 'recursive)))
953 ;; Rename from remote side to local side.
954 (unwind-protect
955 (progn
956 (write-region "foo" nil tmp-name1)
957 (rename-file tmp-name1 tmp-name4)
958 (should-not (file-exists-p tmp-name1))
959 (should (file-exists-p tmp-name4))
960 (with-temp-buffer
961 (insert-file-contents tmp-name4)
962 (should (string-equal (buffer-string) "foo")))
963 (write-region "foo" nil tmp-name1)
964 (should-error (rename-file tmp-name1 tmp-name4))
965 (rename-file tmp-name1 tmp-name4 'ok)
966 (should-not (file-exists-p tmp-name1))
967 (write-region "foo" nil tmp-name1)
968 (make-directory tmp-name5)
969 (rename-file tmp-name1 tmp-name5)
970 (should-not (file-exists-p tmp-name1))
971 (should
972 (file-exists-p
973 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
975 ;; Cleanup.
976 (ignore-errors (delete-file tmp-name1))
977 (ignore-errors (delete-file tmp-name4))
978 (ignore-errors (delete-directory tmp-name5 'recursive)))
980 ;; Rename from local side to remote side.
981 (unwind-protect
982 (progn
983 (write-region "foo" nil tmp-name4 nil 'nomessage)
984 (rename-file tmp-name4 tmp-name1)
985 (should-not (file-exists-p tmp-name4))
986 (should (file-exists-p tmp-name1))
987 (with-temp-buffer
988 (insert-file-contents tmp-name1)
989 (should (string-equal (buffer-string) "foo")))
990 (write-region "foo" nil tmp-name4 nil 'nomessage)
991 (should-error (rename-file tmp-name4 tmp-name1))
992 (rename-file tmp-name4 tmp-name1 'ok)
993 (should-not (file-exists-p tmp-name4))
994 (write-region "foo" nil tmp-name4 nil 'nomessage)
995 (make-directory tmp-name3)
996 (rename-file tmp-name4 tmp-name3)
997 (should-not (file-exists-p tmp-name4))
998 (should
999 (file-exists-p
1000 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
1002 ;; Cleanup.
1003 (ignore-errors (delete-file tmp-name1))
1004 (ignore-errors (delete-file tmp-name4))
1005 (ignore-errors (delete-directory tmp-name3 'recursive))))))
1007 (ert-deftest tramp-test13-make-directory ()
1008 "Check `make-directory'.
1009 This tests also `file-directory-p' and `file-accessible-directory-p'."
1010 (skip-unless (tramp--test-enabled))
1012 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1013 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1014 (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
1015 (unwind-protect
1016 (progn
1017 (make-directory tmp-name1)
1018 (should (file-directory-p tmp-name1))
1019 (should (file-accessible-directory-p tmp-name1))
1020 (should-error (make-directory tmp-name2))
1021 (make-directory tmp-name2 'parents)
1022 (should (file-directory-p tmp-name2))
1023 (should (file-accessible-directory-p tmp-name2)))
1025 ;; Cleanup.
1026 (ignore-errors (delete-directory tmp-name1 'recursive))))))
1028 (ert-deftest tramp-test14-delete-directory ()
1029 "Check `delete-directory'."
1030 (skip-unless (tramp--test-enabled))
1032 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1033 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1034 ;; Delete empty directory.
1035 (make-directory tmp-name)
1036 (should (file-directory-p tmp-name))
1037 (delete-directory tmp-name)
1038 (should-not (file-directory-p tmp-name))
1039 ;; Delete non-empty directory.
1040 (make-directory tmp-name)
1041 (should (file-directory-p tmp-name))
1042 (write-region "foo" nil (expand-file-name "bla" tmp-name))
1043 (should (file-exists-p (expand-file-name "bla" tmp-name)))
1044 (should-error (delete-directory tmp-name))
1045 (delete-directory tmp-name 'recursive)
1046 (should-not (file-directory-p tmp-name)))))
1048 (ert-deftest tramp-test15-copy-directory ()
1049 "Check `copy-directory'."
1050 (skip-unless (tramp--test-enabled))
1052 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1053 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1054 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1055 (tmp-name3 (expand-file-name
1056 (file-name-nondirectory tmp-name1) tmp-name2))
1057 (tmp-name4 (expand-file-name "foo" tmp-name1))
1058 (tmp-name5 (expand-file-name "foo" tmp-name2))
1059 (tmp-name6 (expand-file-name "foo" tmp-name3)))
1061 ;; Copy complete directory.
1062 (unwind-protect
1063 (progn
1064 ;; Copy empty directory.
1065 (make-directory tmp-name1)
1066 (write-region "foo" nil tmp-name4)
1067 (should (file-directory-p tmp-name1))
1068 (should (file-exists-p tmp-name4))
1069 (copy-directory tmp-name1 tmp-name2)
1070 (should (file-directory-p tmp-name2))
1071 (should (file-exists-p tmp-name5))
1072 ;; Target directory does exist already.
1073 (copy-directory tmp-name1 tmp-name2)
1074 (should (file-directory-p tmp-name3))
1075 (should (file-exists-p tmp-name6)))
1077 ;; Cleanup.
1078 (ignore-errors
1079 (delete-directory tmp-name1 'recursive)
1080 (delete-directory tmp-name2 'recursive)))
1082 ;; Copy directory contents.
1083 (unwind-protect
1084 (progn
1085 ;; Copy empty directory.
1086 (make-directory tmp-name1)
1087 (write-region "foo" nil tmp-name4)
1088 (should (file-directory-p tmp-name1))
1089 (should (file-exists-p tmp-name4))
1090 (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
1091 (should (file-directory-p tmp-name2))
1092 (should (file-exists-p tmp-name5))
1093 ;; Target directory does exist already.
1094 (delete-file tmp-name5)
1095 (should-not (file-exists-p tmp-name5))
1096 (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
1097 (should (file-directory-p tmp-name2))
1098 (should (file-exists-p tmp-name5))
1099 (should-not (file-directory-p tmp-name3))
1100 (should-not (file-exists-p tmp-name6)))
1102 ;; Cleanup.
1103 (ignore-errors
1104 (delete-directory tmp-name1 'recursive)
1105 (delete-directory tmp-name2 'recursive))))))
1107 (ert-deftest tramp-test16-directory-files ()
1108 "Check `directory-files'."
1109 (skip-unless (tramp--test-enabled))
1111 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1112 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1113 (tmp-name2 (expand-file-name "bla" tmp-name1))
1114 (tmp-name3 (expand-file-name "foo" tmp-name1)))
1115 (unwind-protect
1116 (progn
1117 (make-directory tmp-name1)
1118 (write-region "foo" nil tmp-name2)
1119 (write-region "bla" nil tmp-name3)
1120 (should (file-directory-p tmp-name1))
1121 (should (file-exists-p tmp-name2))
1122 (should (file-exists-p tmp-name3))
1123 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
1124 (should (equal (directory-files tmp-name1 'full)
1125 `(,(concat tmp-name1 "/.")
1126 ,(concat tmp-name1 "/..")
1127 ,tmp-name2 ,tmp-name3)))
1128 (should (equal (directory-files
1129 tmp-name1 nil directory-files-no-dot-files-regexp)
1130 '("bla" "foo")))
1131 (should (equal (directory-files
1132 tmp-name1 'full directory-files-no-dot-files-regexp)
1133 `(,tmp-name2 ,tmp-name3))))
1135 ;; Cleanup.
1136 (ignore-errors (delete-directory tmp-name1 'recursive))))))
1138 (ert-deftest tramp-test17-insert-directory ()
1139 "Check `insert-directory'."
1140 (skip-unless (tramp--test-enabled))
1142 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1143 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1144 (tmp-name2 (expand-file-name "foo" tmp-name1))
1145 ;; We test for the summary line. Keyword "total" could be localized.
1146 (process-environment
1147 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
1148 (unwind-protect
1149 (progn
1150 (make-directory tmp-name1)
1151 (write-region "foo" nil tmp-name2)
1152 (should (file-directory-p tmp-name1))
1153 (should (file-exists-p tmp-name2))
1154 (with-temp-buffer
1155 (insert-directory tmp-name1 nil)
1156 (goto-char (point-min))
1157 (should (looking-at-p (regexp-quote tmp-name1))))
1158 (with-temp-buffer
1159 (insert-directory tmp-name1 "-al")
1160 (goto-char (point-min))
1161 (should
1162 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
1163 (with-temp-buffer
1164 (insert-directory (file-name-as-directory tmp-name1) "-al")
1165 (goto-char (point-min))
1166 (should
1167 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
1168 (with-temp-buffer
1169 (insert-directory
1170 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
1171 (goto-char (point-min))
1172 (should
1173 (looking-at-p
1174 (concat
1175 ;; There might be a summary line.
1176 "\\(total.+[[:digit:]]+\n\\)?"
1177 ;; We don't know in which order ".", ".." and "foo" appear.
1178 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
1180 ;; Cleanup.
1181 (ignore-errors (delete-directory tmp-name1 'recursive))))))
1183 (ert-deftest tramp-test18-file-attributes ()
1184 "Check `file-attributes'.
1185 This tests also `file-readable-p', `file-regular-p' and
1186 `file-ownership-preserved-p'."
1187 (skip-unless (tramp--test-enabled))
1189 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1190 ;; We must use `file-truename' for the temporary directory,
1191 ;; because it could be located on a symlinked directory. This
1192 ;; would let the test fail.
1193 (let* ((tramp-test-temporary-file-directory
1194 (file-truename tramp-test-temporary-file-directory))
1195 (tmp-name1 (tramp--test-make-temp-name nil quoted))
1196 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1197 ;; File name with "//".
1198 (tmp-name3
1199 (format
1200 "%s%s"
1201 (file-remote-p tmp-name1)
1202 (replace-regexp-in-string
1203 "/" "//" (file-remote-p tmp-name1 'localname))))
1204 attr)
1205 (unwind-protect
1206 (progn
1207 ;; `file-ownership-preserved-p' should return t for
1208 ;; non-existing files. It is implemented only in tramp-sh.el.
1209 (when (tramp--test-sh-p)
1210 (should (file-ownership-preserved-p tmp-name1 'group)))
1211 (write-region "foo" nil tmp-name1)
1212 (should (file-exists-p tmp-name1))
1213 (should (file-readable-p tmp-name1))
1214 (should (file-regular-p tmp-name1))
1215 (when (tramp--test-sh-p)
1216 (should (file-ownership-preserved-p tmp-name1 'group)))
1218 ;; We do not test inodes and device numbers.
1219 (setq attr (file-attributes tmp-name1))
1220 (should (consp attr))
1221 (should (null (car attr)))
1222 (should (numberp (nth 1 attr))) ;; Link.
1223 (should (numberp (nth 2 attr))) ;; Uid.
1224 (should (numberp (nth 3 attr))) ;; Gid.
1225 ;; Last access time.
1226 (should (stringp (current-time-string (nth 4 attr))))
1227 ;; Last modification time.
1228 (should (stringp (current-time-string (nth 5 attr))))
1229 ;; Last status change time.
1230 (should (stringp (current-time-string (nth 6 attr))))
1231 (should (numberp (nth 7 attr))) ;; Size.
1232 (should (stringp (nth 8 attr))) ;; Modes.
1234 (setq attr (file-attributes tmp-name1 'string))
1235 (should (stringp (nth 2 attr))) ;; Uid.
1236 (should (stringp (nth 3 attr))) ;; Gid.
1238 (condition-case err
1239 (progn
1240 (when (tramp--test-sh-p)
1241 (should (file-ownership-preserved-p tmp-name2 'group)))
1242 (make-symbolic-link tmp-name1 tmp-name2)
1243 (should (file-exists-p tmp-name2))
1244 (should (file-symlink-p tmp-name2))
1245 (when (tramp--test-sh-p)
1246 (should (file-ownership-preserved-p tmp-name2 'group)))
1247 (setq attr (file-attributes tmp-name2))
1248 (should
1249 (string-equal
1250 (funcall
1251 (if quoted 'tramp-compat-file-name-quote 'identity)
1252 (car attr))
1253 (file-remote-p (file-truename tmp-name1) 'localname)))
1254 (delete-file tmp-name2))
1255 (file-error
1256 (should (string-equal (error-message-string err)
1257 "make-symbolic-link not supported"))))
1259 ;; Check, that "//" in symlinks are handled properly.
1260 (with-temp-buffer
1261 (let ((default-directory tramp-test-temporary-file-directory))
1262 (shell-command
1263 (format
1264 "ln -s %s %s"
1265 (tramp-file-name-localname
1266 (tramp-dissect-file-name tmp-name3))
1267 (tramp-file-name-localname
1268 (tramp-dissect-file-name tmp-name2)))
1269 t)))
1270 (when (file-symlink-p tmp-name2)
1271 (setq attr (file-attributes tmp-name2))
1272 (should
1273 (string-equal
1274 (car attr)
1275 (tramp-file-name-localname
1276 (tramp-dissect-file-name tmp-name3))))
1277 (delete-file tmp-name2))
1279 (when (tramp--test-sh-p)
1280 (should (file-ownership-preserved-p tmp-name1 'group)))
1281 (delete-file tmp-name1)
1282 (make-directory tmp-name1)
1283 (should (file-exists-p tmp-name1))
1284 (should (file-readable-p tmp-name1))
1285 (should-not (file-regular-p tmp-name1))
1286 (when (tramp--test-sh-p)
1287 (should (file-ownership-preserved-p tmp-name1 'group)))
1288 (setq attr (file-attributes tmp-name1))
1289 (should (eq (car attr) t)))
1291 ;; Cleanup.
1292 (ignore-errors (delete-directory tmp-name1))
1293 (ignore-errors (delete-file tmp-name1))
1294 (ignore-errors (delete-file tmp-name2))))))
1296 (ert-deftest tramp-test19-directory-files-and-attributes ()
1297 "Check `directory-files-and-attributes'."
1298 (skip-unless (tramp--test-enabled))
1300 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1301 ;; `directory-files-and-attributes' contains also values for
1302 ;; "../". Ensure that this doesn't change during tests, for
1303 ;; example due to handling temporary files.
1304 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1305 (tmp-name2 (expand-file-name "bla" tmp-name1))
1306 attr)
1307 (unwind-protect
1308 (progn
1309 (make-directory tmp-name1)
1310 (should (file-directory-p tmp-name1))
1311 (make-directory tmp-name2)
1312 (should (file-directory-p tmp-name2))
1313 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
1314 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
1315 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
1316 (setq attr (directory-files-and-attributes tmp-name2))
1317 (should (consp attr))
1318 ;; Dumb remote shells without perl(1) or stat(1) are not
1319 ;; able to return the date correctly. They say "don't know".
1320 (dolist (elt attr)
1321 (unless
1322 (equal
1323 (nth
1324 5 (file-attributes (expand-file-name (car elt) tmp-name2)))
1325 '(0 0))
1326 (should
1327 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
1328 (cdr elt)))))
1329 (setq attr (directory-files-and-attributes tmp-name2 'full))
1330 (dolist (elt attr)
1331 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
1332 (should
1333 (equal (file-attributes (car elt)) (cdr elt)))))
1334 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
1335 (should (equal (mapcar 'car attr) '("bar" "boz"))))
1337 ;; Cleanup.
1338 (ignore-errors (delete-directory tmp-name1 'recursive))))))
1340 (ert-deftest tramp-test20-file-modes ()
1341 "Check `file-modes'.
1342 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1343 (skip-unless (tramp--test-enabled))
1344 (skip-unless (tramp--test-sh-p))
1346 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1347 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1348 (unwind-protect
1349 (progn
1350 (write-region "foo" nil tmp-name)
1351 (should (file-exists-p tmp-name))
1352 (set-file-modes tmp-name #o777)
1353 (should (= (file-modes tmp-name) #o777))
1354 (should (file-executable-p tmp-name))
1355 (should (file-writable-p tmp-name))
1356 (set-file-modes tmp-name #o444)
1357 (should (= (file-modes tmp-name) #o444))
1358 (should-not (file-executable-p tmp-name))
1359 ;; A file is always writable for user "root".
1360 (unless (zerop (nth 2 (file-attributes tmp-name)))
1361 (should-not (file-writable-p tmp-name))))
1363 ;; Cleanup.
1364 (ignore-errors (delete-file tmp-name))))))
1366 (ert-deftest tramp-test21-file-links ()
1367 "Check `file-symlink-p'.
1368 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1369 (skip-unless (tramp--test-enabled))
1371 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1372 ;; We must use `file-truename' for the temporary directory,
1373 ;; because it could be located on a symlinked directory. This
1374 ;; would let the test fail.
1375 (let* ((tramp-test-temporary-file-directory
1376 (file-truename tramp-test-temporary-file-directory))
1377 (tmp-name1 (tramp--test-make-temp-name nil quoted))
1378 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1379 (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
1381 ;; Check `make-symbolic-link'.
1382 (unwind-protect
1383 (progn
1384 (write-region "foo" nil tmp-name1)
1385 (should (file-exists-p tmp-name1))
1386 ;; Method "smb" supports `make-symbolic-link' only if the
1387 ;; remote host has CIFS capabilities. tramp-adb.el and
1388 ;; tramp-gvfs.el do not support symbolic links at all.
1389 (condition-case err
1390 (make-symbolic-link tmp-name1 tmp-name2)
1391 (file-error
1392 (skip-unless
1393 (not (string-equal (error-message-string err)
1394 "make-symbolic-link not supported")))))
1395 (should (file-symlink-p tmp-name2))
1396 (should-error (make-symbolic-link tmp-name1 tmp-name2))
1397 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
1398 (should (file-symlink-p tmp-name2))
1399 ;; `tmp-name3' is a local file name.
1400 (should-error (make-symbolic-link tmp-name1 tmp-name3)))
1402 ;; Cleanup.
1403 (ignore-errors
1404 (delete-file tmp-name1)
1405 (delete-file tmp-name2)))
1407 ;; Check `add-name-to-file'.
1408 (unwind-protect
1409 (progn
1410 (write-region "foo" nil tmp-name1)
1411 (should (file-exists-p tmp-name1))
1412 (add-name-to-file tmp-name1 tmp-name2)
1413 (should-not (file-symlink-p tmp-name2))
1414 (should-error (add-name-to-file tmp-name1 tmp-name2))
1415 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
1416 (should-not (file-symlink-p tmp-name2))
1417 ;; `tmp-name3' is a local file name.
1418 (should-error (add-name-to-file tmp-name1 tmp-name3)))
1420 ;; Cleanup.
1421 (ignore-errors
1422 (delete-file tmp-name1)
1423 (delete-file tmp-name2)))
1425 ;; Check `file-truename'.
1426 (unwind-protect
1427 (progn
1428 (write-region "foo" nil tmp-name1)
1429 (should (file-exists-p tmp-name1))
1430 (make-symbolic-link tmp-name1 tmp-name2)
1431 (should (file-symlink-p tmp-name2))
1432 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
1433 (should
1434 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
1435 (should (file-equal-p tmp-name1 tmp-name2)))
1436 (ignore-errors
1437 (delete-file tmp-name1)
1438 (delete-file tmp-name2)))
1440 ;; `file-truename' shall preserve trailing link of directories.
1441 (unless (file-symlink-p tramp-test-temporary-file-directory)
1442 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
1443 (dir2 (file-name-as-directory dir1)))
1444 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
1445 (should
1446 (string-equal (file-truename dir2) (expand-file-name dir2))))))))
1448 (ert-deftest tramp-test22-file-times ()
1449 "Check `set-file-times' and `file-newer-than-file-p'."
1450 (skip-unless (tramp--test-enabled))
1451 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
1453 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1454 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1455 (tmp-name2 (tramp--test-make-temp-name nil quoted))
1456 (tmp-name3 (tramp--test-make-temp-name nil quoted)))
1457 (unwind-protect
1458 (progn
1459 (write-region "foo" nil tmp-name1)
1460 (should (file-exists-p tmp-name1))
1461 (should (consp (nth 5 (file-attributes tmp-name1))))
1462 ;; '(0 0) means don't know, and will be replaced by
1463 ;; `current-time'. Therefore, we use '(0 1). We skip the
1464 ;; test, if the remote handler is not able to set the
1465 ;; correct time.
1466 (skip-unless (set-file-times tmp-name1 '(0 1)))
1467 ;; Dumb remote shells without perl(1) or stat(1) are not
1468 ;; able to return the date correctly. They say "don't know".
1469 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
1470 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1471 (write-region "bla" nil tmp-name2)
1472 (should (file-exists-p tmp-name2))
1473 (should (file-newer-than-file-p tmp-name2 tmp-name1))
1474 ;; `tmp-name3' does not exist.
1475 (should (file-newer-than-file-p tmp-name2 tmp-name3))
1476 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
1478 ;; Cleanup.
1479 (ignore-errors
1480 (delete-file tmp-name1)
1481 (delete-file tmp-name2))))))
1483 (ert-deftest tramp-test23-visited-file-modtime ()
1484 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1485 (skip-unless (tramp--test-enabled))
1487 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1488 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1489 (unwind-protect
1490 (progn
1491 (write-region "foo" nil tmp-name)
1492 (should (file-exists-p tmp-name))
1493 (with-temp-buffer
1494 (insert-file-contents tmp-name)
1495 (should (verify-visited-file-modtime))
1496 (set-visited-file-modtime '(0 1))
1497 (should (verify-visited-file-modtime))
1498 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1500 ;; Cleanup.
1501 (ignore-errors (delete-file tmp-name))))))
1503 (ert-deftest tramp-test24-file-name-completion ()
1504 "Check `file-name-completion' and `file-name-all-completions'."
1505 (skip-unless (tramp--test-enabled))
1507 (dolist (n-e '(nil t))
1508 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1509 (let ((non-essential n-e)
1510 (tmp-name (tramp--test-make-temp-name nil quoted))
1511 (method (file-remote-p tramp-test-temporary-file-directory 'method))
1512 (host (file-remote-p tramp-test-temporary-file-directory 'host)))
1514 (unwind-protect
1515 (progn
1516 ;; Method and host name in completion mode. This kind
1517 ;; of completion does not work on MS Windows.
1518 (when (and (tramp-completion-mode-p)
1519 (not (memq system-type '(cygwin windows-nt))))
1520 (unless (zerop (length method))
1521 (should
1522 (member
1523 (format "%s:" method)
1524 (file-name-all-completions (substring method 0 1) "/"))))
1525 (unless (zerop (length host))
1526 (let ((tramp-default-method (or method tramp-default-method)))
1527 (should
1528 (member
1529 (format "%s:" host)
1530 (file-name-all-completions (substring host 0 1) "/")))))
1531 (unless (or (zerop (length method)) (zerop (length host)))
1532 (should
1533 (member
1534 (format "%s:" host)
1535 (file-name-all-completions
1536 (substring host 0 1) (format "/%s:" method))))))
1538 ;; Local files.
1539 (make-directory tmp-name)
1540 (should (file-directory-p tmp-name))
1541 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1542 (should (file-exists-p (expand-file-name "foo" tmp-name)))
1543 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1544 (should (file-exists-p (expand-file-name "bold" tmp-name)))
1545 (make-directory (expand-file-name "boz" tmp-name))
1546 (should (file-directory-p (expand-file-name "boz" tmp-name)))
1547 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1548 (should (equal (file-name-completion "foo" tmp-name) t))
1549 (should (equal (file-name-completion "b" tmp-name) "bo"))
1550 (should-not (file-name-completion "a" tmp-name))
1551 (should
1552 (equal
1553 (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1554 (should
1555 (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1556 (should
1557 (equal
1558 (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1559 '("bold" "boz/")))
1560 (should-not (file-name-all-completions "a" tmp-name))
1561 ;; `completion-regexp-list' restricts the completion to
1562 ;; files which match all expressions in this list.
1563 (let ((completion-regexp-list
1564 `(,directory-files-no-dot-files-regexp "b")))
1565 (should
1566 (equal (file-name-completion "" tmp-name) "bo"))
1567 (should
1568 (equal
1569 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
1570 '("bold" "boz/"))))
1571 ;; `file-name-completion' ignores file names that end in
1572 ;; any string in `completion-ignored-extensions'.
1573 (let ((completion-ignored-extensions '(".ext")))
1574 (write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
1575 (should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
1576 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1577 (should (equal (file-name-completion "foo" tmp-name) t))
1578 (should
1579 (equal (file-name-completion "foo." tmp-name) "foo.ext"))
1580 (should (equal (file-name-completion "foo.ext" tmp-name) t))
1581 ;; `file-name-all-completions' is not affected.
1582 (should
1583 (equal
1584 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
1585 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
1587 ;; Cleanup.
1588 (ignore-errors (delete-directory tmp-name 'recursive)))))))
1590 (ert-deftest tramp-test25-load ()
1591 "Check `load'."
1592 (skip-unless (tramp--test-enabled))
1594 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1595 (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1596 (unwind-protect
1597 (progn
1598 (load tmp-name 'noerror 'nomessage)
1599 (should-not (featurep 'tramp-test-load))
1600 (write-region "(provide 'tramp-test-load)" nil tmp-name)
1601 ;; `load' in lread.c does not pass `must-suffix'. Why?
1602 ;;(should-error
1603 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1604 (load tmp-name nil 'nomessage 'nosuffix)
1605 (should (featurep 'tramp-test-load)))
1607 ;; Cleanup.
1608 (ignore-errors
1609 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1610 (delete-file tmp-name))))))
1612 (ert-deftest tramp-test26-process-file ()
1613 "Check `process-file'."
1614 :tags '(:expensive-test)
1615 (skip-unless (tramp--test-enabled))
1616 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
1618 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1619 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
1620 (fnnd (file-name-nondirectory tmp-name))
1621 (default-directory tramp-test-temporary-file-directory)
1622 kill-buffer-query-functions)
1623 (unwind-protect
1624 (progn
1625 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1626 ;; do not exist on hydra.
1627 (should (zerop (process-file "true")))
1628 (should-not (zerop (process-file "false")))
1629 (should-not (zerop (process-file "binary-does-not-exist")))
1630 (with-temp-buffer
1631 (write-region "foo" nil tmp-name)
1632 (should (file-exists-p tmp-name))
1633 (should (zerop (process-file "ls" nil t nil fnnd)))
1634 ;; `ls' could produce colorized output.
1635 (goto-char (point-min))
1636 (while
1637 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1638 (replace-match "" nil nil))
1639 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1640 (should-not (get-buffer-window (current-buffer) t))
1642 ;; Second run. The output must be appended.
1643 (goto-char (point-max))
1644 (should (zerop (process-file "ls" nil t t fnnd)))
1645 ;; `ls' could produce colorized output.
1646 (goto-char (point-min))
1647 (while
1648 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1649 (replace-match "" nil nil))
1650 (should
1651 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
1652 ;; A non-nil DISPLAY must not raise the buffer.
1653 (should-not (get-buffer-window (current-buffer) t))))
1655 ;; Cleanup.
1656 (ignore-errors (delete-file tmp-name))))))
1658 (ert-deftest tramp-test27-start-file-process ()
1659 "Check `start-file-process'."
1660 :tags '(:expensive-test)
1661 (skip-unless (tramp--test-enabled))
1662 (skip-unless (tramp--test-sh-p))
1664 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1665 (let ((default-directory tramp-test-temporary-file-directory)
1666 (tmp-name (tramp--test-make-temp-name nil quoted))
1667 kill-buffer-query-functions proc)
1668 (unwind-protect
1669 (with-temp-buffer
1670 (setq proc (start-file-process "test1" (current-buffer) "cat"))
1671 (should (processp proc))
1672 (should (equal (process-status proc) 'run))
1673 (process-send-string proc "foo")
1674 (process-send-eof proc)
1675 ;; Read output.
1676 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1677 (while (< (- (point-max) (point-min)) (length "foo"))
1678 (accept-process-output proc 0.1)))
1679 (should (string-equal (buffer-string) "foo")))
1681 ;; Cleanup.
1682 (ignore-errors (delete-process proc)))
1684 (unwind-protect
1685 (with-temp-buffer
1686 (write-region "foo" nil tmp-name)
1687 (should (file-exists-p tmp-name))
1688 (setq proc
1689 (start-file-process
1690 "test2" (current-buffer)
1691 "cat" (file-name-nondirectory tmp-name)))
1692 (should (processp proc))
1693 ;; Read output.
1694 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1695 (while (< (- (point-max) (point-min)) (length "foo"))
1696 (accept-process-output proc 0.1)))
1697 (should (string-equal (buffer-string) "foo")))
1699 ;; Cleanup.
1700 (ignore-errors
1701 (delete-process proc)
1702 (delete-file tmp-name)))
1704 (unwind-protect
1705 (with-temp-buffer
1706 (setq proc (start-file-process "test3" (current-buffer) "cat"))
1707 (should (processp proc))
1708 (should (equal (process-status proc) 'run))
1709 (set-process-filter
1710 proc
1711 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
1712 (process-send-string proc "foo")
1713 (process-send-eof proc)
1714 ;; Read output.
1715 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1716 (while (< (- (point-max) (point-min)) (length "foo"))
1717 (accept-process-output proc 0.1)))
1718 (should (string-equal (buffer-string) "foo")))
1720 ;; Cleanup.
1721 (ignore-errors (delete-process proc))))))
1723 (ert-deftest tramp-test28-shell-command ()
1724 "Check `shell-command'."
1725 :tags '(:expensive-test)
1726 (skip-unless (tramp--test-enabled))
1727 (skip-unless (tramp--test-sh-p))
1729 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1730 (let ((tmp-name (tramp--test-make-temp-name nil quoted))
1731 (default-directory tramp-test-temporary-file-directory)
1732 kill-buffer-query-functions)
1733 (unwind-protect
1734 (with-temp-buffer
1735 (write-region "foo" nil tmp-name)
1736 (should (file-exists-p tmp-name))
1737 (shell-command
1738 (format "ls %s" (file-name-nondirectory tmp-name))
1739 (current-buffer))
1740 ;; `ls' could produce colorized output.
1741 (goto-char (point-min))
1742 (while
1743 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1744 (replace-match "" nil nil))
1745 (should
1746 (string-equal
1747 (format "%s\n" (file-name-nondirectory tmp-name))
1748 (buffer-string))))
1750 ;; Cleanup.
1751 (ignore-errors (delete-file tmp-name)))
1753 (unwind-protect
1754 (with-temp-buffer
1755 (write-region "foo" nil tmp-name)
1756 (should (file-exists-p tmp-name))
1757 (async-shell-command
1758 (format "ls %s" (file-name-nondirectory tmp-name))
1759 (current-buffer))
1760 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1761 ;; Read output.
1762 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1763 (while (< (- (point-max) (point-min))
1764 (1+ (length (file-name-nondirectory tmp-name))))
1765 (accept-process-output
1766 (get-buffer-process (current-buffer)) 0.1)))
1767 ;; `ls' could produce colorized output.
1768 (goto-char (point-min))
1769 (while
1770 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1771 (replace-match "" nil nil))
1772 ;; There might be a nasty "Process *Async Shell* finished" message.
1773 (goto-char (point-min))
1774 (forward-line)
1775 (narrow-to-region (point-min) (point))
1776 (should
1777 (string-equal
1778 (format "%s\n" (file-name-nondirectory tmp-name))
1779 (buffer-string))))
1781 ;; Cleanup.
1782 (ignore-errors (delete-file tmp-name)))
1784 (unwind-protect
1785 (with-temp-buffer
1786 (write-region "foo" nil tmp-name)
1787 (should (file-exists-p tmp-name))
1788 (async-shell-command "read line; ls $line" (current-buffer))
1789 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1790 (process-send-string
1791 (get-buffer-process (current-buffer))
1792 (format "%s\n" (file-name-nondirectory tmp-name)))
1793 ;; Read output.
1794 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1795 (while (< (- (point-max) (point-min))
1796 (1+ (length (file-name-nondirectory tmp-name))))
1797 (accept-process-output
1798 (get-buffer-process (current-buffer)) 0.1)))
1799 ;; `ls' could produce colorized output.
1800 (goto-char (point-min))
1801 (while
1802 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1803 (replace-match "" nil nil))
1804 ;; There might be a nasty "Process *Async Shell* finished" message.
1805 (goto-char (point-min))
1806 (forward-line)
1807 (narrow-to-region (point-min) (point))
1808 (should
1809 (string-equal
1810 (format "%s\n" (file-name-nondirectory tmp-name))
1811 (buffer-string))))
1813 ;; Cleanup.
1814 (ignore-errors (delete-file tmp-name))))))
1816 (defun tramp--test-shell-command-to-string-asynchronously (command)
1817 "Like `shell-command-to-string', but for asynchronous processes."
1818 (with-temp-buffer
1819 (async-shell-command command (current-buffer))
1820 ;; Suppress nasty messages.
1821 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1822 (with-timeout (10)
1823 (while (get-buffer-process (current-buffer))
1824 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
1825 (accept-process-output nil 0.1)
1826 (buffer-substring-no-properties (point-min) (point-max))))
1828 ;; This test is inspired by Bug#23952.
1829 (ert-deftest tramp-test29-environment-variables ()
1830 "Check that remote processes set / unset environment variables properly."
1831 :tags '(:expensive-test)
1832 (skip-unless (tramp--test-enabled))
1833 (skip-unless (tramp--test-sh-p))
1835 (dolist (this-shell-command-to-string
1836 '(;; Synchronously.
1837 shell-command-to-string
1838 ;; Asynchronously.
1839 tramp--test-shell-command-to-string-asynchronously))
1841 (let ((default-directory tramp-test-temporary-file-directory)
1842 (shell-file-name "/bin/sh")
1843 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
1844 kill-buffer-query-functions)
1846 (unwind-protect
1847 ;; Set a value.
1848 (let ((process-environment
1849 (cons (concat envvar "=foo") process-environment)))
1850 ;; Default value.
1851 (should
1852 (string-match
1853 "foo"
1854 (funcall
1855 this-shell-command-to-string
1856 (format "echo -n ${%s:?bla}" envvar))))))
1858 (unwind-protect
1859 ;; Set the empty value.
1860 (let ((process-environment
1861 (cons (concat envvar "=") process-environment)))
1862 ;; Value is null.
1863 (should
1864 (string-match
1865 "bla"
1866 (funcall
1867 this-shell-command-to-string
1868 (format "echo -n ${%s:?bla}" envvar))))
1869 ;; Variable is set.
1870 (should
1871 (string-match
1872 (regexp-quote envvar)
1873 (funcall this-shell-command-to-string "set")))))
1875 ;; We force a reconnect, in order to have a clean environment.
1876 (tramp-cleanup-connection
1877 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1878 'keep-debug 'keep-password)
1879 (unwind-protect
1880 ;; Unset the variable.
1881 (let ((tramp-remote-process-environment
1882 (cons (concat envvar "=foo")
1883 tramp-remote-process-environment)))
1884 ;; Set the initial value, we want to unset below.
1885 (should
1886 (string-match
1887 "foo"
1888 (funcall
1889 this-shell-command-to-string
1890 (format "echo -n ${%s:?bla}" envvar))))
1891 (let ((process-environment
1892 (cons envvar process-environment)))
1893 ;; Variable is unset.
1894 (should
1895 (string-match
1896 "bla"
1897 (funcall
1898 this-shell-command-to-string
1899 (format "echo -n ${%s:?bla}" envvar))))
1900 ;; Variable is unset.
1901 (should-not
1902 (string-match
1903 (regexp-quote envvar)
1904 (funcall this-shell-command-to-string "set")))))))))
1906 (ert-deftest tramp-test30-vc-registered ()
1907 "Check `vc-registered'."
1908 :tags '(:expensive-test)
1909 (skip-unless (tramp--test-enabled))
1910 (skip-unless (tramp--test-sh-p))
1912 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1913 (let* ((default-directory tramp-test-temporary-file-directory)
1914 (tmp-name1 (tramp--test-make-temp-name nil quoted))
1915 (tmp-name2 (expand-file-name "foo" tmp-name1))
1916 (tramp-remote-process-environment tramp-remote-process-environment)
1917 (vc-handled-backends
1918 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1919 (cond
1920 ((tramp-find-executable
1921 v vc-git-program (tramp-get-remote-path v))
1922 '(Git))
1923 ((tramp-find-executable
1924 v vc-hg-program (tramp-get-remote-path v))
1925 '(Hg))
1926 ((tramp-find-executable
1927 v vc-bzr-program (tramp-get-remote-path v))
1928 (setq tramp-remote-process-environment
1929 (cons (format "BZR_HOME=%s"
1930 (file-remote-p tmp-name1 'localname))
1931 tramp-remote-process-environment))
1932 ;; We must force a reconnect, in order to activate $BZR_HOME.
1933 (tramp-cleanup-connection
1934 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1935 nil 'keep-password)
1936 '(Bzr))
1937 (t nil)))))
1938 (skip-unless vc-handled-backends)
1939 (message "%s" vc-handled-backends)
1941 (unwind-protect
1942 (progn
1943 (make-directory tmp-name1)
1944 (write-region "foo" nil tmp-name2)
1945 (should (file-directory-p tmp-name1))
1946 (should (file-exists-p tmp-name2))
1947 (should-not (vc-registered tmp-name1))
1948 (should-not (vc-registered tmp-name2))
1950 (let ((default-directory tmp-name1))
1951 ;; Create empty repository, and register the file.
1952 ;; Sometimes, creation of repository fails (bzr!); we
1953 ;; skip the test then.
1954 (condition-case nil
1955 (vc-create-repo (car vc-handled-backends))
1956 (error (skip-unless nil)))
1957 ;; The structure of VC-FILESET is not documented. Let's
1958 ;; hope it won't change.
1959 (condition-case nil
1960 (vc-register
1961 (list (car vc-handled-backends)
1962 (list (file-name-nondirectory tmp-name2))))
1963 ;; `vc-register' has changed its arguments in Emacs 25.1.
1964 (error
1965 (vc-register
1966 nil (list (car vc-handled-backends)
1967 (list (file-name-nondirectory tmp-name2))))))
1968 ;; vc-git uses an own process sentinel, Tramp's sentinel
1969 ;; for flushing the cache isn't used.
1970 (dired-uncache (concat (file-remote-p default-directory) "/"))
1971 (should (vc-registered (file-name-nondirectory tmp-name2)))))
1973 ;; Cleanup.
1974 (ignore-errors (delete-directory tmp-name1 'recursive))))))
1976 (ert-deftest tramp-test31-make-auto-save-file-name ()
1977 "Check `make-auto-save-file-name'."
1978 (skip-unless (tramp--test-enabled))
1980 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1981 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1982 (tmp-name2 (tramp--test-make-temp-name nil quoted)))
1984 (unwind-protect
1985 (progn
1986 ;; Use default `auto-save-file-name-transforms' mechanism.
1987 (let (tramp-auto-save-directory)
1988 (with-temp-buffer
1989 (setq buffer-file-name tmp-name1)
1990 (should
1991 (string-equal
1992 (make-auto-save-file-name)
1993 ;; This is taken from original `make-auto-save-file-name'.
1994 (expand-file-name
1995 (format
1996 "#%s#"
1997 (subst-char-in-string
1998 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
1999 temporary-file-directory)))))
2001 ;; No mapping.
2002 (let (tramp-auto-save-directory auto-save-file-name-transforms)
2003 (with-temp-buffer
2004 (setq buffer-file-name tmp-name1)
2005 (should
2006 (string-equal
2007 (make-auto-save-file-name)
2008 (funcall
2009 (if quoted 'tramp-compat-file-name-quote 'identity)
2010 (expand-file-name
2011 (format "#%s#" (file-name-nondirectory tmp-name1))
2012 tramp-test-temporary-file-directory))))))
2014 ;; Use default `tramp-auto-save-directory' mechanism.
2015 (let ((tramp-auto-save-directory tmp-name2))
2016 (with-temp-buffer
2017 (setq buffer-file-name tmp-name1)
2018 (should
2019 (string-equal
2020 (make-auto-save-file-name)
2021 ;; This is taken from Tramp.
2022 (expand-file-name
2023 (format
2024 "#%s#"
2025 (tramp-subst-strs-in-string
2026 '(("_" . "|")
2027 ("/" . "_a")
2028 (":" . "_b")
2029 ("|" . "__")
2030 ("[" . "_l")
2031 ("]" . "_r"))
2032 (tramp-compat-file-name-unquote tmp-name1)))
2033 tmp-name2)))
2034 (should (file-directory-p tmp-name2))))
2036 ;; Relative file names shall work, too.
2037 (let ((tramp-auto-save-directory "."))
2038 (with-temp-buffer
2039 (setq buffer-file-name tmp-name1
2040 default-directory tmp-name2)
2041 (should
2042 (string-equal
2043 (make-auto-save-file-name)
2044 ;; This is taken from Tramp.
2045 (expand-file-name
2046 (format
2047 "#%s#"
2048 (tramp-subst-strs-in-string
2049 '(("_" . "|")
2050 ("/" . "_a")
2051 (":" . "_b")
2052 ("|" . "__")
2053 ("[" . "_l")
2054 ("]" . "_r"))
2055 (tramp-compat-file-name-unquote tmp-name1)))
2056 tmp-name2)))
2057 (should (file-directory-p tmp-name2)))))
2059 ;; Cleanup.
2060 (ignore-errors (delete-file tmp-name1))
2061 (ignore-errors (delete-directory tmp-name2 'recursive))))))
2063 ;; The functions were introduced in Emacs 26.1.
2064 (ert-deftest tramp-test32-make-nearby-temp-file ()
2065 "Check `make-nearby-temp-file' and `temporary-file-directory'."
2066 (skip-unless (tramp--test-enabled))
2067 (skip-unless
2068 (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
2070 (let ((default-directory tramp-test-temporary-file-directory)
2071 tmp-file)
2072 ;; The remote host shall know a temporary file directory.
2073 (should (stringp (temporary-file-directory)))
2074 (should
2075 (string-equal
2076 (file-remote-p default-directory)
2077 (file-remote-p (temporary-file-directory))))
2079 ;; The temporary file shall be located on the remote host.
2080 (setq tmp-file (make-nearby-temp-file "tramp-test"))
2081 (should (file-exists-p tmp-file))
2082 (should (file-regular-p tmp-file))
2083 (should
2084 (string-equal
2085 (file-remote-p default-directory)
2086 (file-remote-p tmp-file)))
2087 (delete-file tmp-file)
2088 (should-not (file-exists-p tmp-file))
2090 (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
2091 (should (file-exists-p tmp-file))
2092 (should (file-directory-p tmp-file))
2093 (delete-directory tmp-file)
2094 (should-not (file-exists-p tmp-file))))
2096 (defun tramp--test-adb-p ()
2097 "Check, whether the remote host runs Android.
2098 This requires restrictions of file name syntax."
2099 (tramp-adb-file-name-p tramp-test-temporary-file-directory))
2101 (defun tramp--test-docker-p ()
2102 "Check, whether the docker method is used.
2103 This does not support some special file names."
2104 (string-equal
2105 "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
2107 (defun tramp--test-ftp-p ()
2108 "Check, whether an FTP-like method is used.
2109 This does not support globbing characters in file names (yet)."
2110 ;; Globbing characters are ??, ?* and ?\[.
2111 (string-match
2112 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
2114 (defun tramp--test-gvfs-p ()
2115 "Check, whether the remote host runs a GVFS based method.
2116 This requires restrictions of file name syntax."
2117 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
2119 (defun tramp--test-hpux-p ()
2120 "Check, whether the remote host runs HP-UX.
2121 Several special characters do not work properly there."
2122 ;; We must refill the cache. `file-truename' does it.
2123 (with-parsed-tramp-file-name
2124 (file-truename tramp-test-temporary-file-directory) nil
2125 (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
2127 (defun tramp--test-rsync-p ()
2128 "Check, whether the rsync method is used.
2129 This does not support special file names."
2130 (string-equal
2131 "rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
2133 (defun tramp--test-sh-p ()
2134 "Check, whether the remote host runs a based method from tramp-sh.el."
2136 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
2137 'tramp-sh-file-name-handler))
2139 (defun tramp--test-windows-nt-and-batch ()
2140 "Check, whether the locale host runs MS Windows in batch mode.
2141 This does not support special characters."
2142 (and (eq system-type 'windows-nt) noninteractive))
2144 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
2145 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
2146 This does not support utf8 based file transfer."
2147 (and (eq system-type 'windows-nt)
2148 (string-match
2149 (regexp-opt '("pscp" "psftp"))
2150 (file-remote-p tramp-test-temporary-file-directory 'method))))
2152 (defun tramp--test-windows-nt-or-smb-p ()
2153 "Check, whether the locale or remote host runs MS Windows.
2154 This requires restrictions of file name syntax."
2155 (or (eq system-type 'windows-nt)
2156 (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
2158 (defun tramp--test-check-files (&rest files)
2159 "Run a simple but comprehensive test over every file in FILES."
2160 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2161 ;; We must use `file-truename' for the temporary directory,
2162 ;; because it could be located on a symlinked directory. This
2163 ;; would let the test fail.
2164 (let* ((tramp-test-temporary-file-directory
2165 (file-truename tramp-test-temporary-file-directory))
2166 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2167 (tmp-name2 (tramp--test-make-temp-name 'local quoted))
2168 (files (delq nil files))
2169 (process-environment process-environment))
2170 (unwind-protect
2171 (progn
2172 ;; Add environment variables.
2173 (dolist (elt files)
2174 ;; The check command (heredoc file) does not support
2175 ;; environment variables with leading spaces.
2176 (let* ((elt (replace-regexp-in-string "^\\s-+" "" elt))
2177 (envvar (concat "VAR_" (upcase (md5 elt)))))
2178 (setenv envvar elt)))
2180 ;; We force a reconnect, in order to have a clean environment.
2181 (tramp-cleanup-connection
2182 (tramp-dissect-file-name tramp-test-temporary-file-directory)
2183 'keep-debug 'keep-password)
2184 (make-directory tmp-name1)
2185 (make-directory tmp-name2)
2187 (dolist (elt files)
2188 (let* ((file1 (expand-file-name elt tmp-name1))
2189 (file2 (expand-file-name elt tmp-name2))
2190 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
2191 (write-region elt nil file1)
2192 (should (file-exists-p file1))
2194 ;; Check file contents.
2195 (with-temp-buffer
2196 (insert-file-contents file1)
2197 (should (string-equal (buffer-string) elt)))
2199 ;; Copy file both directions.
2200 (copy-file file1 tmp-name2)
2201 (should (file-exists-p file2))
2202 (delete-file file1)
2203 (should-not (file-exists-p file1))
2204 (copy-file file2 tmp-name1)
2205 (should (file-exists-p file1))
2207 ;; Method "smb" supports `make-symbolic-link' only if the
2208 ;; remote host has CIFS capabilities. tramp-adb.el and
2209 ;; tramp-gvfs.el do not support symbolic links at all.
2210 (condition-case err
2211 (progn
2212 (make-symbolic-link file1 file3)
2213 (should (file-symlink-p file3))
2214 (should
2215 (string-equal
2216 (expand-file-name file1) (file-truename file3)))
2217 (should
2218 (string-equal
2219 (funcall
2220 (if quoted 'tramp-compat-file-name-quote 'identity)
2221 (car (file-attributes file3)))
2222 (file-remote-p (file-truename file1) 'localname)))
2223 ;; Check file contents.
2224 (with-temp-buffer
2225 (insert-file-contents file3)
2226 (should (string-equal (buffer-string) elt)))
2227 (delete-file file3))
2228 (file-error
2229 (should
2230 (string-equal (error-message-string err)
2231 "make-symbolic-link not supported"))))))
2233 ;; Check file names.
2234 (should (equal (directory-files
2235 tmp-name1 nil directory-files-no-dot-files-regexp)
2236 (sort (copy-sequence files) 'string-lessp)))
2237 (should (equal (directory-files
2238 tmp-name2 nil directory-files-no-dot-files-regexp)
2239 (sort (copy-sequence files) 'string-lessp)))
2241 ;; `substitute-in-file-name' could return different
2242 ;; values. For `adb', there could be strange file
2243 ;; permissions preventing overwriting a file. We don't
2244 ;; care in this testcase.
2245 (dolist (elt files)
2246 (let ((file1
2247 (substitute-in-file-name (expand-file-name elt tmp-name1)))
2248 (file2
2249 (substitute-in-file-name
2250 (expand-file-name elt tmp-name2))))
2251 (ignore-errors (write-region elt nil file1))
2252 (should (file-exists-p file1))
2253 (ignore-errors (write-region elt nil file2 nil 'nomessage))
2254 (should (file-exists-p file2))))
2256 (should (equal (directory-files
2257 tmp-name1 nil directory-files-no-dot-files-regexp)
2258 (directory-files
2259 tmp-name2 nil directory-files-no-dot-files-regexp)))
2261 ;; Check directory creation. We use a subdirectory "foo"
2262 ;; in order to avoid conflicts with previous file name tests.
2263 (dolist (elt files)
2264 (let* ((elt1 (concat elt "foo"))
2265 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
2266 (file2 (expand-file-name elt file1))
2267 (file3 (expand-file-name elt1 file1)))
2268 (make-directory file1 'parents)
2269 (should (file-directory-p file1))
2270 (write-region elt nil file2)
2271 (should (file-exists-p file2))
2272 (should
2273 (equal
2274 (directory-files
2275 file1 nil directory-files-no-dot-files-regexp)
2276 `(,elt)))
2277 (should
2278 (equal
2279 (caar (directory-files-and-attributes
2280 file1 nil directory-files-no-dot-files-regexp))
2281 elt))
2283 ;; Check symlink in `directory-files-and-attributes'.
2284 (condition-case err
2285 (progn
2286 (make-symbolic-link file2 file3)
2287 (should (file-symlink-p file3))
2288 (should
2289 (string-equal
2290 (caar (directory-files-and-attributes
2291 file1 nil (regexp-quote elt1)))
2292 elt1))
2293 (should
2294 (string-equal
2295 (funcall
2296 (if quoted 'tramp-compat-file-name-quote 'identity)
2297 (cadr (car (directory-files-and-attributes
2298 file1 nil (regexp-quote elt1)))))
2299 (file-remote-p (file-truename file2) 'localname)))
2300 (delete-file file3)
2301 (should-not (file-exists-p file3)))
2302 (file-error
2303 (should (string-equal (error-message-string err)
2304 "make-symbolic-link not supported"))))
2306 (delete-file file2)
2307 (should-not (file-exists-p file2))
2308 (delete-directory file1)
2309 (should-not (file-exists-p file1))))
2311 ;; Check, that environment variables are set correctly.
2312 (when (and tramp--test-expensive-test (tramp--test-sh-p))
2313 (dolist (elt process-environment)
2314 (when (string-match "^VAR_" elt)
2315 (let* ((default-directory tramp-test-temporary-file-directory)
2316 (shell-file-name "/bin/sh")
2317 (heredoc (md5 (current-time-string)))
2318 (envvar (car (split-string elt "=" t)))
2319 (file1 (tramp-compat-file-name-unquote
2320 (expand-file-name "bar" tmp-name1))))
2321 ;; Cleanup.
2322 (ignore-errors (delete-file file1))
2323 ;; Save the variable in a file. The echo command
2324 ;; does not work properly, it suppresses leading/
2325 ;; trailing spaces as well as tabs.
2326 (shell-command-to-string
2327 (format
2328 "cat <<%s >%s\n$%s\n%s"
2329 heredoc (file-remote-p file1 'localname) envvar heredoc))
2330 (with-temp-buffer
2331 (insert-file-contents file1)
2332 (should
2333 (string-equal
2334 (buffer-string) (concat (getenv envvar) "\n"))))
2335 (delete-file file1)
2336 (should-not (file-exists-p file1)))))))
2338 ;; Cleanup.
2339 (ignore-errors (delete-directory tmp-name1 'recursive))
2340 (ignore-errors (delete-directory tmp-name2 'recursive))))))
2342 (defun tramp--test-special-characters ()
2343 "Perform the test in `tramp-test33-special-characters*'."
2344 ;; Newlines, slashes and backslashes in file names are not
2345 ;; supported. So we don't test. And we don't test the tab
2346 ;; character on Windows or Cygwin, because the backslash is
2347 ;; interpreted as a path separator, preventing "\t" from being
2348 ;; expanded to <TAB>.
2349 (tramp--test-check-files
2350 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2351 "foo bar baz"
2352 (if (or (tramp--test-adb-p)
2353 (tramp--test-docker-p)
2354 (eq system-type 'cygwin))
2355 " foo bar baz "
2356 " foo\tbar baz\t"))
2357 "$foo$bar$$baz$"
2358 "-foo-bar-baz-"
2359 "%foo%bar%baz%"
2360 "&foo&bar&baz&"
2361 (unless (or (tramp--test-ftp-p)
2362 (tramp--test-gvfs-p)
2363 (tramp--test-windows-nt-or-smb-p))
2364 "?foo?bar?baz?")
2365 (unless (or (tramp--test-ftp-p)
2366 (tramp--test-gvfs-p)
2367 (tramp--test-windows-nt-or-smb-p))
2368 "*foo*bar*baz*")
2369 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2370 "'foo'bar'baz'"
2371 "'foo\"bar'baz\"")
2372 "#foo~bar#baz~"
2373 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2374 "!foo!bar!baz!"
2375 "!foo|bar!baz|")
2376 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2377 ";foo;bar;baz;"
2378 ":foo;bar:baz;")
2379 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2380 "<foo>bar<baz>")
2381 "(foo)bar(baz)"
2382 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
2383 "{foo}bar{baz}"))
2385 ;; These tests are inspired by Bug#17238.
2386 (ert-deftest tramp-test33-special-characters ()
2387 "Check special characters in file names."
2388 (skip-unless (tramp--test-enabled))
2389 (skip-unless (not (tramp--test-rsync-p)))
2390 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2392 (tramp--test-special-characters))
2394 (ert-deftest tramp-test33-special-characters-with-stat ()
2395 "Check special characters in file names.
2396 Use the `stat' command."
2397 :tags '(:expensive-test)
2398 (skip-unless (tramp--test-enabled))
2399 (skip-unless (tramp--test-sh-p))
2400 (skip-unless (not (tramp--test-rsync-p)))
2401 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2402 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2403 (skip-unless (tramp-get-remote-stat v)))
2405 (let ((tramp-connection-properties
2406 (append
2407 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2408 "perl" nil))
2409 tramp-connection-properties)))
2410 (tramp--test-special-characters)))
2412 (ert-deftest tramp-test33-special-characters-with-perl ()
2413 "Check special characters in file names.
2414 Use the `perl' command."
2415 :tags '(:expensive-test)
2416 (skip-unless (tramp--test-enabled))
2417 (skip-unless (tramp--test-sh-p))
2418 (skip-unless (not (tramp--test-rsync-p)))
2419 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2420 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2421 (skip-unless (tramp-get-remote-perl v)))
2423 (let ((tramp-connection-properties
2424 (append
2425 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2426 "stat" nil)
2427 ;; See `tramp-sh-handle-file-truename'.
2428 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2429 "readlink" nil))
2430 tramp-connection-properties)))
2431 (tramp--test-special-characters)))
2433 (ert-deftest tramp-test33-special-characters-with-ls ()
2434 "Check special characters in file names.
2435 Use the `ls' command."
2436 :tags '(:expensive-test)
2437 (skip-unless (tramp--test-enabled))
2438 (skip-unless (tramp--test-sh-p))
2439 (skip-unless (not (tramp--test-rsync-p)))
2440 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2441 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2443 (let ((tramp-connection-properties
2444 (append
2445 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2446 "perl" nil)
2447 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2448 "stat" nil)
2449 ;; See `tramp-sh-handle-file-truename'.
2450 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2451 "readlink" nil))
2452 tramp-connection-properties)))
2453 (tramp--test-special-characters)))
2455 (defun tramp--test-utf8 ()
2456 "Perform the test in `tramp-test34-utf8*'."
2457 (let* ((utf8 (if (and (eq system-type 'darwin)
2458 (memq 'utf-8-hfs (coding-system-list)))
2459 'utf-8-hfs 'utf-8))
2460 (coding-system-for-read utf8)
2461 (coding-system-for-write utf8)
2462 (file-name-coding-system utf8))
2463 (tramp--test-check-files
2464 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
2465 (unless (tramp--test-hpux-p)
2466 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
2467 "银河系漫游指南系列"
2468 "Автостопом по гала́ктике")))
2470 (ert-deftest tramp-test34-utf8 ()
2471 "Check UTF8 encoding in file names and file contents."
2472 (skip-unless (tramp--test-enabled))
2473 (skip-unless (not (tramp--test-docker-p)))
2474 (skip-unless (not (tramp--test-rsync-p)))
2475 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2476 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2478 (tramp--test-utf8))
2480 (ert-deftest tramp-test34-utf8-with-stat ()
2481 "Check UTF8 encoding in file names and file contents.
2482 Use the `stat' command."
2483 :tags '(:expensive-test)
2484 (skip-unless (tramp--test-enabled))
2485 (skip-unless (tramp--test-sh-p))
2486 (skip-unless (not (tramp--test-docker-p)))
2487 (skip-unless (not (tramp--test-rsync-p)))
2488 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2489 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2490 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2491 (skip-unless (tramp-get-remote-stat v)))
2493 (let ((tramp-connection-properties
2494 (append
2495 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2496 "perl" nil))
2497 tramp-connection-properties)))
2498 (tramp--test-utf8)))
2500 (ert-deftest tramp-test34-utf8-with-perl ()
2501 "Check UTF8 encoding in file names and file contents.
2502 Use the `perl' command."
2503 :tags '(:expensive-test)
2504 (skip-unless (tramp--test-enabled))
2505 (skip-unless (tramp--test-sh-p))
2506 (skip-unless (not (tramp--test-docker-p)))
2507 (skip-unless (not (tramp--test-rsync-p)))
2508 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2509 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2510 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2511 (skip-unless (tramp-get-remote-perl v)))
2513 (let ((tramp-connection-properties
2514 (append
2515 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2516 "stat" nil)
2517 ;; See `tramp-sh-handle-file-truename'.
2518 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2519 "readlink" nil))
2520 tramp-connection-properties)))
2521 (tramp--test-utf8)))
2523 (ert-deftest tramp-test34-utf8-with-ls ()
2524 "Check UTF8 encoding in file names and file contents.
2525 Use the `ls' command."
2526 :tags '(:expensive-test)
2527 (skip-unless (tramp--test-enabled))
2528 (skip-unless (tramp--test-sh-p))
2529 (skip-unless (not (tramp--test-docker-p)))
2530 (skip-unless (not (tramp--test-rsync-p)))
2531 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2532 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2534 (let ((tramp-connection-properties
2535 (append
2536 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2537 "perl" nil)
2538 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2539 "stat" nil)
2540 ;; See `tramp-sh-handle-file-truename'.
2541 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
2542 "readlink" nil))
2543 tramp-connection-properties)))
2544 (tramp--test-utf8)))
2546 ;; This test is inspired by Bug#16928.
2547 (ert-deftest tramp-test35-asynchronous-requests ()
2548 "Check parallel asynchronous requests.
2549 Such requests could arrive from timers, process filters and
2550 process sentinels. They shall not disturb each other."
2551 ;; Mark as failed until bug has been fixed.
2552 :expected-result :failed
2553 :tags '(:expensive-test)
2554 (skip-unless (tramp--test-enabled))
2555 (skip-unless (tramp--test-sh-p))
2557 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2558 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
2559 ;; This has the side effect, that this test fails instead to
2560 ;; abort. Good for hydra.
2561 (tramp--instrument-test-case 0
2562 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
2563 (default-directory tmp-name)
2564 (remote-file-name-inhibit-cache t)
2565 timer buffers kill-buffer-query-functions)
2567 (unwind-protect
2568 (progn
2569 (make-directory tmp-name)
2571 ;; Setup a timer in order to raise an ordinary command
2572 ;; again and again. `vc-registered' is well suited,
2573 ;; because there are many checks.
2574 (setq
2575 timer
2576 (run-at-time
2578 (lambda ()
2579 (when buffers
2580 (vc-registered
2581 (buffer-name (nth (random (length buffers)) buffers)))))))
2583 ;; Create temporary buffers. The number of buffers
2584 ;; corresponds to the number of processes; it could be
2585 ;; increased in order to make pressure on Tramp.
2586 (dotimes (i 5)
2587 (add-to-list 'buffers (generate-new-buffer "*temp*")))
2589 ;; Open asynchronous processes. Set process sentinel.
2590 (dolist (buf buffers)
2591 (async-shell-command "read line; touch $line; echo $line" buf)
2592 (set-process-sentinel
2593 (get-buffer-process buf)
2594 (lambda (proc _state)
2595 (delete-file (buffer-name (process-buffer proc))))))
2597 ;; Send a string. Use a random order of the buffers. Mix
2598 ;; with regular operation.
2599 (let ((buffers (copy-sequence buffers))
2600 buf)
2601 (while buffers
2602 (setq buf (nth (random (length buffers)) buffers))
2603 (process-send-string
2604 (get-buffer-process buf) (format "'%s'\n" buf))
2605 (file-attributes (buffer-name buf))
2606 (setq buffers (delq buf buffers))))
2608 ;; Wait until the whole output has been read.
2609 (with-timeout ((* 10 (length buffers))
2610 (ert-fail "`async-shell-command' timed out"))
2611 (let ((buffers (copy-sequence buffers))
2612 buf)
2613 (while buffers
2614 (setq buf (nth (random (length buffers)) buffers))
2615 (if (ignore-errors
2616 (memq (process-status (get-buffer-process buf))
2617 '(run open)))
2618 (accept-process-output (get-buffer-process buf) 0.1)
2619 (setq buffers (delq buf buffers))))))
2621 ;; Check.
2622 (dolist (buf buffers)
2623 (with-current-buffer buf
2624 (should
2625 (string-equal (format "'%s'\n" buf) (buffer-string)))))
2626 (should-not
2627 (directory-files
2628 tmp-name nil directory-files-no-dot-files-regexp)))
2630 ;; Cleanup.
2631 (ignore-errors (cancel-timer timer))
2632 (ignore-errors (delete-directory tmp-name 'recursive))
2633 (dolist (buf buffers)
2634 (ignore-errors (kill-buffer buf))))))))
2636 (ert-deftest tramp-test36-recursive-load ()
2637 "Check that Tramp does not fail due to recursive load."
2638 (skip-unless (tramp--test-enabled))
2640 (dolist (code
2641 (list
2642 (format "(expand-file-name %S)" tramp-test-temporary-file-directory)
2643 (format
2644 "(let ((default-directory %S)) (expand-file-name %S))"
2645 tramp-test-temporary-file-directory
2646 temporary-file-directory)))
2647 (should-not
2648 (string-match
2649 "Recursive load"
2650 (shell-command-to-string
2651 (format
2652 "%s -batch -Q -L %s --eval %s"
2653 (expand-file-name invocation-name invocation-directory)
2654 (mapconcat 'shell-quote-argument load-path " -L ")
2655 (shell-quote-argument code)))))))
2657 (ert-deftest tramp-test37-unload ()
2658 "Check that Tramp and its subpackages unload completely.
2659 Since it unloads Tramp, it shall be the last test to run."
2660 ;; Mark as failed until all symbols are unbound.
2661 :expected-result (if (featurep 'tramp) :failed :passed)
2662 :tags '(:expensive-test)
2663 (when (featurep 'tramp)
2664 (unload-feature 'tramp 'force)
2665 ;; No Tramp feature must be left.
2666 (should-not (featurep 'tramp))
2667 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
2668 ;; `file-name-handler-alist' must be clean.
2669 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
2670 ;; There shouldn't be left a bound symbol. We do not regard our
2671 ;; test symbols, and the Tramp unload hooks.
2672 (mapatoms
2673 (lambda (x)
2674 (and (or (boundp x) (functionp x))
2675 (string-match "^tramp" (symbol-name x))
2676 (not (string-match "^tramp--?test" (symbol-name x)))
2677 (not (string-match "unload-hook$" (symbol-name x)))
2678 (ert-fail (format "`%s' still bound" x)))))
2679 ;; There shouldn't be left a hook function containing a Tramp
2680 ;; function. We do not regard the Tramp unload hooks.
2681 (mapatoms
2682 (lambda (x)
2683 (and (boundp x)
2684 (string-match "-hooks?$" (symbol-name x))
2685 (not (string-match "unload-hook$" (symbol-name x)))
2686 (consp (symbol-value x))
2687 (ignore-errors (all-completions "tramp" (symbol-value x)))
2688 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
2690 ;; TODO:
2692 ;; * dired-compress-file
2693 ;; * dired-uncache
2694 ;; * file-acl
2695 ;; * file-name-case-insensitive-p
2696 ;; * file-selinux-context
2697 ;; * find-backup-file-name
2698 ;; * set-file-acl
2699 ;; * set-file-selinux-context
2701 ;; * Work on skipped tests. Make a comment, when it is impossible.
2702 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
2703 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
2704 ;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'.
2705 ;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set
2706 ;; expected error.
2708 (defun tramp-test-all (&optional interactive)
2709 "Run all tests for \\[tramp]."
2710 (interactive "p")
2711 (funcall
2712 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
2714 (provide 'tramp-tests)
2715 ;;; tramp-tests.el ends here