Port to stricter C99
[emacs.git] / test / automated / tramp-tests.el
blobe1039392ea77b8e6030e737c60343d38161b09e0
1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2015 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 (declare-function tramp-find-executable "tramp-sh")
48 (declare-function tramp-get-remote-path "tramp-sh")
49 (declare-function tramp-get-remote-stat "tramp-sh")
50 (declare-function tramp-get-remote-perl "tramp-sh")
51 (defvar tramp-copy-size-limit)
52 (defvar tramp-remote-process-environment)
54 ;; There is no default value on w32 systems, which could work out of the box.
55 (defconst tramp-test-temporary-file-directory
56 (cond
57 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
58 ((eq system-type 'windows-nt) null-device)
59 (t (add-to-list
60 'tramp-methods
61 '("mock"
62 (tramp-login-program "sh")
63 (tramp-login-args (("-i")))
64 (tramp-remote-shell "/bin/sh")
65 (tramp-remote-shell-args ("-c"))
66 (tramp-connection-timeout 10)))
67 (format "/mock::%s" temporary-file-directory)))
68 "Temporary directory for Tramp tests.")
70 (setq password-cache-expiry nil
71 tramp-verbose 0
72 tramp-copy-size-limit nil
73 tramp-message-show-message nil)
75 ;; This shall happen on hydra only.
76 (when (getenv "NIX_STORE")
77 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
79 (defvar tramp--test-enabled-checked nil
80 "Cached result of `tramp--test-enabled'.
81 If the function did run, the value is a cons cell, the `cdr'
82 being the result.")
84 (defun tramp--test-enabled ()
85 "Whether remote file access is enabled."
86 (unless (consp tramp--test-enabled-checked)
87 (setq
88 tramp--test-enabled-checked
89 (cons
90 t (ignore-errors
91 (and
92 (file-remote-p tramp-test-temporary-file-directory)
93 (file-directory-p tramp-test-temporary-file-directory)
94 (file-writable-p tramp-test-temporary-file-directory))))))
96 (when (cdr tramp--test-enabled-checked)
97 ;; Cleanup connection.
98 (ignore-errors
99 (tramp-cleanup-connection
100 (tramp-dissect-file-name tramp-test-temporary-file-directory)
101 nil 'keep-password)))
103 ;; Return result.
104 (cdr tramp--test-enabled-checked))
106 (defun tramp--test-make-temp-name (&optional local)
107 "Create a temporary file name for test."
108 (expand-file-name
109 (make-temp-name "tramp-test")
110 (if local temporary-file-directory tramp-test-temporary-file-directory)))
112 (defmacro tramp--instrument-test-case (verbose &rest body)
113 "Run BODY with `tramp-verbose' equal VERBOSE.
114 Print the the content of the Tramp debug buffer, if BODY does not
115 eval properly in `should', `should-not' or `should-error'. BODY
116 shall not contain a timeout."
117 (declare (indent 1) (debug (natnump body)))
118 `(let ((tramp-verbose ,verbose)
119 (tramp-message-show-message t)
120 (tramp-debug-on-error t))
121 (unwind-protect
122 (progn ,@body)
123 (when (> tramp-verbose 3)
124 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
125 (with-current-buffer (tramp-get-connection-buffer v)
126 (message "%s" (buffer-string)))
127 (with-current-buffer (tramp-get-debug-buffer v)
128 (message "%s" (buffer-string))))))))
130 (ert-deftest tramp-test00-availability ()
131 "Test availability of Tramp functions."
132 :expected-result (if (tramp--test-enabled) :passed :failed)
133 (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
134 (should (ignore-errors
135 (and
136 (file-remote-p tramp-test-temporary-file-directory)
137 (file-directory-p tramp-test-temporary-file-directory)
138 (file-writable-p tramp-test-temporary-file-directory)))))
140 (ert-deftest tramp-test01-file-name-syntax ()
141 "Check remote file name syntax."
142 ;; Simple cases.
143 (should (tramp-tramp-file-p "/method::"))
144 (should (tramp-tramp-file-p "/host:"))
145 (should (tramp-tramp-file-p "/user@:"))
146 (should (tramp-tramp-file-p "/user@host:"))
147 (should (tramp-tramp-file-p "/method:host:"))
148 (should (tramp-tramp-file-p "/method:user@:"))
149 (should (tramp-tramp-file-p "/method:user@host:"))
150 (should (tramp-tramp-file-p "/method:user@email@host:"))
152 ;; Using a port.
153 (should (tramp-tramp-file-p "/host#1234:"))
154 (should (tramp-tramp-file-p "/user@host#1234:"))
155 (should (tramp-tramp-file-p "/method:host#1234:"))
156 (should (tramp-tramp-file-p "/method:user@host#1234:"))
158 ;; Using an IPv4 address.
159 (should (tramp-tramp-file-p "/1.2.3.4:"))
160 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
161 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
162 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
164 ;; Using an IPv6 address.
165 (should (tramp-tramp-file-p "/[]:"))
166 (should (tramp-tramp-file-p "/[::1]:"))
167 (should (tramp-tramp-file-p "/user@[::1]:"))
168 (should (tramp-tramp-file-p "/method:[::1]:"))
169 (should (tramp-tramp-file-p "/method:user@[::1]:"))
171 ;; Local file name part.
172 (should (tramp-tramp-file-p "/host:/:"))
173 (should (tramp-tramp-file-p "/method:::"))
174 (should (tramp-tramp-file-p "/method::/path/to/file"))
175 (should (tramp-tramp-file-p "/method::file"))
177 ;; Multihop.
178 (should (tramp-tramp-file-p "/method1:|method2::"))
179 (should (tramp-tramp-file-p "/method1:host1|host2:"))
180 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
181 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
182 (should (tramp-tramp-file-p
183 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
185 ;; No strings.
186 (should-not (tramp-tramp-file-p nil))
187 (should-not (tramp-tramp-file-p 'symbol))
188 ;; "/:" suppresses file name handlers.
189 (should-not (tramp-tramp-file-p "/::"))
190 (should-not (tramp-tramp-file-p "/:@:"))
191 (should-not (tramp-tramp-file-p "/:[]:"))
192 ;; Multihops require a method.
193 (should-not (tramp-tramp-file-p "/host1|host2:"))
194 ;; Methods or hostnames shall be at least two characters on MS Windows.
195 (when (memq system-type '(cygwin windows-nt))
196 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
197 (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
199 (ert-deftest tramp-test02-file-name-dissect ()
200 "Check remote file name components."
201 (let ((tramp-default-method "default-method")
202 (tramp-default-user "default-user")
203 (tramp-default-host "default-host"))
204 ;; Expand `tramp-default-user' and `tramp-default-host'.
205 (should (string-equal
206 (file-remote-p "/method::")
207 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
208 (should (string-equal (file-remote-p "/method::" 'method) "method"))
209 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
210 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
211 (should (string-equal (file-remote-p "/method::" 'localname) ""))
213 ;; Expand `tramp-default-method' and `tramp-default-user'.
214 (should (string-equal
215 (file-remote-p "/host:")
216 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
217 (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
218 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
219 (should (string-equal (file-remote-p "/host:" 'host) "host"))
220 (should (string-equal (file-remote-p "/host:" 'localname) ""))
222 ;; Expand `tramp-default-method' and `tramp-default-host'.
223 (should (string-equal
224 (file-remote-p "/user@:")
225 (format "/%s:%s@%s:" "default-method""user" "default-host")))
226 (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
227 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
228 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
229 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
231 ;; Expand `tramp-default-method'.
232 (should (string-equal
233 (file-remote-p "/user@host:")
234 (format "/%s:%s@%s:" "default-method" "user" "host")))
235 (should (string-equal
236 (file-remote-p "/user@host:" 'method) "default-method"))
237 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
238 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
239 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
241 ;; Expand `tramp-default-user'.
242 (should (string-equal
243 (file-remote-p "/method:host:")
244 (format "/%s:%s@%s:" "method" "default-user" "host")))
245 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
246 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
247 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
248 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
250 ;; Expand `tramp-default-host'.
251 (should (string-equal
252 (file-remote-p "/method:user@:")
253 (format "/%s:%s@%s:" "method" "user" "default-host")))
254 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
255 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
256 (should (string-equal (file-remote-p "/method:user@:" 'host)
257 "default-host"))
258 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
260 ;; No expansion.
261 (should (string-equal
262 (file-remote-p "/method:user@host:")
263 (format "/%s:%s@%s:" "method" "user" "host")))
264 (should (string-equal
265 (file-remote-p "/method:user@host:" 'method) "method"))
266 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
267 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
268 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
270 ;; No expansion.
271 (should (string-equal
272 (file-remote-p "/method:user@email@host:")
273 (format "/%s:%s@%s:" "method" "user@email" "host")))
274 (should (string-equal
275 (file-remote-p "/method:user@email@host:" 'method) "method"))
276 (should (string-equal
277 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
278 (should (string-equal
279 (file-remote-p "/method:user@email@host:" 'host) "host"))
280 (should (string-equal
281 (file-remote-p "/method:user@email@host:" 'localname) ""))
283 ;; Expand `tramp-default-method' and `tramp-default-user'.
284 (should (string-equal
285 (file-remote-p "/host#1234:")
286 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
287 (should (string-equal
288 (file-remote-p "/host#1234:" 'method) "default-method"))
289 (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
290 (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
291 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
293 ;; Expand `tramp-default-method'.
294 (should (string-equal
295 (file-remote-p "/user@host#1234:")
296 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
297 (should (string-equal
298 (file-remote-p "/user@host#1234:" 'method) "default-method"))
299 (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
300 (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
301 (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
303 ;; Expand `tramp-default-user'.
304 (should (string-equal
305 (file-remote-p "/method:host#1234:")
306 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
307 (should (string-equal
308 (file-remote-p "/method:host#1234:" 'method) "method"))
309 (should (string-equal
310 (file-remote-p "/method:host#1234:" 'user) "default-user"))
311 (should (string-equal
312 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
313 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
315 ;; No expansion.
316 (should (string-equal
317 (file-remote-p "/method:user@host#1234:")
318 (format "/%s:%s@%s:" "method" "user" "host#1234")))
319 (should (string-equal
320 (file-remote-p "/method:user@host#1234:" 'method) "method"))
321 (should (string-equal
322 (file-remote-p "/method:user@host#1234:" 'user) "user"))
323 (should (string-equal
324 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
325 (should (string-equal
326 (file-remote-p "/method:user@host#1234:" 'localname) ""))
328 ;; Expand `tramp-default-method' and `tramp-default-user'.
329 (should (string-equal
330 (file-remote-p "/1.2.3.4:")
331 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
332 (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
333 (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
334 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
335 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
337 ;; Expand `tramp-default-method'.
338 (should (string-equal
339 (file-remote-p "/user@1.2.3.4:")
340 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
341 (should (string-equal
342 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
343 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
344 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
345 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
347 ;; Expand `tramp-default-user'.
348 (should (string-equal
349 (file-remote-p "/method:1.2.3.4:")
350 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
351 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
352 (should (string-equal
353 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
354 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
355 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
357 ;; No expansion.
358 (should (string-equal
359 (file-remote-p "/method:user@1.2.3.4:")
360 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
361 (should (string-equal
362 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
363 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
364 (should (string-equal
365 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
366 (should (string-equal
367 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
369 ;; Expand `tramp-default-method', `tramp-default-user' and
370 ;; `tramp-default-host'.
371 (should (string-equal
372 (file-remote-p "/[]:")
373 (format
374 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
375 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
376 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
377 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
378 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
380 ;; Expand `tramp-default-method' and `tramp-default-user'.
381 (let ((tramp-default-host "::1"))
382 (should (string-equal
383 (file-remote-p "/[]:")
384 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
385 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
386 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
387 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
388 (should (string-equal (file-remote-p "/[]:" 'localname) "")))
390 ;; Expand `tramp-default-method' and `tramp-default-user'.
391 (should (string-equal
392 (file-remote-p "/[::1]:")
393 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
394 (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
395 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
396 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
397 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
399 ;; Expand `tramp-default-method'.
400 (should (string-equal
401 (file-remote-p "/user@[::1]:")
402 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
403 (should (string-equal
404 (file-remote-p "/user@[::1]:" 'method) "default-method"))
405 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
406 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
407 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
409 ;; Expand `tramp-default-user'.
410 (should (string-equal
411 (file-remote-p "/method:[::1]:")
412 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
413 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
414 (should (string-equal
415 (file-remote-p "/method:[::1]:" 'user) "default-user"))
416 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
417 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
419 ;; No expansion.
420 (should (string-equal
421 (file-remote-p "/method:user@[::1]:")
422 (format "/%s:%s@%s:" "method" "user" "[::1]")))
423 (should (string-equal
424 (file-remote-p "/method:user@[::1]:" 'method) "method"))
425 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
426 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
427 (should (string-equal
428 (file-remote-p "/method:user@[::1]:" 'localname) ""))
430 ;; Local file name part.
431 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
432 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
433 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
434 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
435 (should (string-equal
436 (file-remote-p "/method::/path/to/file" 'localname)
437 "/path/to/file"))
439 ;; Multihop.
440 (should
441 (string-equal
442 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
443 (format "/%s:%s@%s:" "method2" "user2" "host2")))
444 (should
445 (string-equal
446 (file-remote-p
447 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
448 "method2"))
449 (should
450 (string-equal
451 (file-remote-p
452 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
453 "user2"))
454 (should
455 (string-equal
456 (file-remote-p
457 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
458 "host2"))
459 (should
460 (string-equal
461 (file-remote-p
462 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
463 "/path/to/file"))
465 (should
466 (string-equal
467 (file-remote-p
468 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
469 (format "/%s:%s@%s:" "method3" "user3" "host3")))
470 (should
471 (string-equal
472 (file-remote-p
473 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
474 'method)
475 "method3"))
476 (should
477 (string-equal
478 (file-remote-p
479 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
480 'user)
481 "user3"))
482 (should
483 (string-equal
484 (file-remote-p
485 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
486 'host)
487 "host3"))
488 (should
489 (string-equal
490 (file-remote-p
491 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
492 'localname)
493 "/path/to/file"))))
495 (ert-deftest tramp-test03-file-name-defaults ()
496 "Check default values for some methods."
497 ;; Default values in tramp-adb.el.
498 (should (string-equal (file-remote-p "/adb::" 'host) ""))
499 ;; Default values in tramp-ftp.el.
500 (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
501 (dolist (u '("ftp" "anonymous"))
502 (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
503 ;; Default values in tramp-gvfs.el.
504 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
505 (symbol-value 'tramp-gvfs-enabled))
506 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
507 ;; Default values in tramp-gw.el.
508 (dolist (m '("tunnel" "socks"))
509 (should
510 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
511 ;; Default values in tramp-sh.el.
512 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
513 (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
514 (dolist (m '("su" "sudo" "ksu"))
515 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
516 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
517 (should
518 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
519 ;; Default values in tramp-smb.el.
520 (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
521 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
523 (ert-deftest tramp-test04-substitute-in-file-name ()
524 "Check `substitute-in-file-name'."
525 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
526 (should
527 (string-equal
528 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
529 (should
530 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
531 (should
532 (string-equal
533 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
534 (should
535 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
536 (let (process-environment)
537 (should
538 (string-equal
539 (substitute-in-file-name "/method:host:/path/$FOO")
540 "/method:host:/path/$FOO"))
541 (setenv "FOO" "bla")
542 (should
543 (string-equal
544 (substitute-in-file-name "/method:host:/path/$FOO")
545 "/method:host:/path/bla"))
546 (should
547 (string-equal
548 (substitute-in-file-name "/method:host:/path/$$FOO")
549 "/method:host:/path/$FOO"))))
551 (ert-deftest tramp-test05-expand-file-name ()
552 "Check `expand-file-name'."
553 (should
554 (string-equal
555 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
556 (should
557 (string-equal
558 (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
560 (ert-deftest tramp-test06-directory-file-name ()
561 "Check `directory-file-name'.
562 This checks also `file-name-as-directory', `file-name-directory',
563 `file-name-nondirectory' and `unhandled-file-name-directory'."
564 (should
565 (string-equal
566 (directory-file-name "/method:host:/path/to/file")
567 "/method:host:/path/to/file"))
568 (should
569 (string-equal
570 (directory-file-name "/method:host:/path/to/file/")
571 "/method:host:/path/to/file"))
572 (should
573 (string-equal
574 (file-name-as-directory "/method:host:/path/to/file")
575 "/method:host:/path/to/file/"))
576 (should
577 (string-equal
578 (file-name-as-directory "/method:host:/path/to/file/")
579 "/method:host:/path/to/file/"))
580 (should
581 (string-equal
582 (file-name-directory "/method:host:/path/to/file")
583 "/method:host:/path/to/"))
584 (should
585 (string-equal
586 (file-name-directory "/method:host:/path/to/file/")
587 "/method:host:/path/to/file/"))
588 (should
589 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
590 (should
591 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
592 (should-not
593 (unhandled-file-name-directory "/method:host:/path/to/file")))
595 (ert-deftest tramp-test07-file-exists-p ()
596 "Check `file-exist-p', `write-region' and `delete-file'."
597 (skip-unless (tramp--test-enabled))
599 (let ((tmp-name (tramp--test-make-temp-name)))
600 (should-not (file-exists-p tmp-name))
601 (write-region "foo" nil tmp-name)
602 (should (file-exists-p tmp-name))
603 (delete-file tmp-name)
604 (should-not (file-exists-p tmp-name))))
606 (ert-deftest tramp-test08-file-local-copy ()
607 "Check `file-local-copy'."
608 (skip-unless (tramp--test-enabled))
610 (let ((tmp-name1 (tramp--test-make-temp-name))
611 tmp-name2)
612 (unwind-protect
613 (progn
614 (write-region "foo" nil tmp-name1)
615 (should (setq tmp-name2 (file-local-copy tmp-name1)))
616 (with-temp-buffer
617 (insert-file-contents tmp-name2)
618 (should (string-equal (buffer-string) "foo")))
619 ;; Check also that a file transfer with compression works.
620 (let ((default-directory tramp-test-temporary-file-directory)
621 (tramp-copy-size-limit 4)
622 (tramp-inline-compress-start-size 2))
623 (delete-file tmp-name2)
624 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
626 ;; Cleanup.
627 (ignore-errors
628 (delete-file tmp-name1)
629 (delete-file tmp-name2)))))
631 (ert-deftest tramp-test09-insert-file-contents ()
632 "Check `insert-file-contents'."
633 (skip-unless (tramp--test-enabled))
635 (let ((tmp-name (tramp--test-make-temp-name)))
636 (unwind-protect
637 (progn
638 (write-region "foo" nil tmp-name)
639 (with-temp-buffer
640 (insert-file-contents tmp-name)
641 (should (string-equal (buffer-string) "foo"))
642 (insert-file-contents tmp-name)
643 (should (string-equal (buffer-string) "foofoo"))
644 ;; Insert partly.
645 (insert-file-contents tmp-name nil 1 3)
646 (should (string-equal (buffer-string) "oofoofoo"))
647 ;; Replace.
648 (insert-file-contents tmp-name nil nil nil 'replace)
649 (should (string-equal (buffer-string) "foo"))))
651 ;; Cleanup.
652 (ignore-errors (delete-file tmp-name)))))
654 (ert-deftest tramp-test10-write-region ()
655 "Check `write-region'."
656 (skip-unless (tramp--test-enabled))
658 (let ((tmp-name (tramp--test-make-temp-name)))
659 (unwind-protect
660 (progn
661 (with-temp-buffer
662 (insert "foo")
663 (write-region nil nil tmp-name))
664 (with-temp-buffer
665 (insert-file-contents tmp-name)
666 (should (string-equal (buffer-string) "foo")))
667 ;; Append.
668 (with-temp-buffer
669 (insert "bla")
670 (write-region nil nil tmp-name 'append))
671 (with-temp-buffer
672 (insert-file-contents tmp-name)
673 (should (string-equal (buffer-string) "foobla")))
674 ;; Write string.
675 (write-region "foo" nil tmp-name)
676 (with-temp-buffer
677 (insert-file-contents tmp-name)
678 (should (string-equal (buffer-string) "foo")))
679 ;; Write partly.
680 (with-temp-buffer
681 (insert "123456789")
682 (write-region 3 5 tmp-name))
683 (with-temp-buffer
684 (insert-file-contents tmp-name)
685 (should (string-equal (buffer-string) "34"))))
687 ;; Cleanup.
688 (ignore-errors (delete-file tmp-name)))))
690 (ert-deftest tramp-test11-copy-file ()
691 "Check `copy-file'."
692 (skip-unless (tramp--test-enabled))
694 (let ((tmp-name1 (tramp--test-make-temp-name))
695 (tmp-name2 (tramp--test-make-temp-name))
696 (tmp-name3 (tramp--test-make-temp-name))
697 (tmp-name4 (tramp--test-make-temp-name 'local))
698 (tmp-name5 (tramp--test-make-temp-name 'local)))
700 ;; Copy on remote side.
701 (unwind-protect
702 (progn
703 (write-region "foo" nil tmp-name1)
704 (copy-file tmp-name1 tmp-name2)
705 (should (file-exists-p tmp-name2))
706 (with-temp-buffer
707 (insert-file-contents tmp-name2)
708 (should (string-equal (buffer-string) "foo")))
709 (should-error (copy-file tmp-name1 tmp-name2))
710 (copy-file tmp-name1 tmp-name2 'ok)
711 (make-directory tmp-name3)
712 (copy-file tmp-name1 tmp-name3)
713 (should
714 (file-exists-p
715 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
717 ;; Cleanup.
718 (ignore-errors (delete-file tmp-name1))
719 (ignore-errors (delete-file tmp-name2))
720 (ignore-errors (delete-directory tmp-name3 'recursive)))
722 ;; Copy from remote side to local side.
723 (unwind-protect
724 (progn
725 (write-region "foo" nil tmp-name1)
726 (copy-file tmp-name1 tmp-name4)
727 (should (file-exists-p tmp-name4))
728 (with-temp-buffer
729 (insert-file-contents tmp-name4)
730 (should (string-equal (buffer-string) "foo")))
731 (should-error (copy-file tmp-name1 tmp-name4))
732 (copy-file tmp-name1 tmp-name4 'ok)
733 (make-directory tmp-name5)
734 (copy-file tmp-name1 tmp-name5)
735 (should
736 (file-exists-p
737 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
739 ;; Cleanup.
740 (ignore-errors (delete-file tmp-name1))
741 (ignore-errors (delete-file tmp-name4))
742 (ignore-errors (delete-directory tmp-name5 'recursive)))
744 ;; Copy from local side to remote side.
745 (unwind-protect
746 (progn
747 (write-region "foo" nil tmp-name4 nil 'nomessage)
748 (copy-file tmp-name4 tmp-name1)
749 (should (file-exists-p tmp-name1))
750 (with-temp-buffer
751 (insert-file-contents tmp-name1)
752 (should (string-equal (buffer-string) "foo")))
753 (should-error (copy-file tmp-name4 tmp-name1))
754 (copy-file tmp-name4 tmp-name1 'ok)
755 (make-directory tmp-name3)
756 (copy-file tmp-name4 tmp-name3)
757 (should
758 (file-exists-p
759 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
761 ;; Cleanup.
762 (ignore-errors (delete-file tmp-name1))
763 (ignore-errors (delete-file tmp-name4))
764 (ignore-errors (delete-directory tmp-name3 'recursive)))))
766 (ert-deftest tramp-test12-rename-file ()
767 "Check `rename-file'."
768 (skip-unless (tramp--test-enabled))
770 (let ((tmp-name1 (tramp--test-make-temp-name))
771 (tmp-name2 (tramp--test-make-temp-name))
772 (tmp-name3 (tramp--test-make-temp-name))
773 (tmp-name4 (tramp--test-make-temp-name 'local))
774 (tmp-name5 (tramp--test-make-temp-name 'local)))
776 ;; Rename on remote side.
777 (unwind-protect
778 (progn
779 (write-region "foo" nil tmp-name1)
780 (rename-file tmp-name1 tmp-name2)
781 (should-not (file-exists-p tmp-name1))
782 (should (file-exists-p tmp-name2))
783 (with-temp-buffer
784 (insert-file-contents tmp-name2)
785 (should (string-equal (buffer-string) "foo")))
786 (write-region "foo" nil tmp-name1)
787 (should-error (rename-file tmp-name1 tmp-name2))
788 (rename-file tmp-name1 tmp-name2 'ok)
789 (should-not (file-exists-p tmp-name1))
790 (write-region "foo" nil tmp-name1)
791 (make-directory tmp-name3)
792 (rename-file tmp-name1 tmp-name3)
793 (should-not (file-exists-p tmp-name1))
794 (should
795 (file-exists-p
796 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
798 ;; Cleanup.
799 (ignore-errors (delete-file tmp-name1))
800 (ignore-errors (delete-file tmp-name2))
801 (ignore-errors (delete-directory tmp-name3 'recursive)))
803 ;; Rename from remote side to local side.
804 (unwind-protect
805 (progn
806 (write-region "foo" nil tmp-name1)
807 (rename-file tmp-name1 tmp-name4)
808 (should-not (file-exists-p tmp-name1))
809 (should (file-exists-p tmp-name4))
810 (with-temp-buffer
811 (insert-file-contents tmp-name4)
812 (should (string-equal (buffer-string) "foo")))
813 (write-region "foo" nil tmp-name1)
814 (should-error (rename-file tmp-name1 tmp-name4))
815 (rename-file tmp-name1 tmp-name4 'ok)
816 (should-not (file-exists-p tmp-name1))
817 (write-region "foo" nil tmp-name1)
818 (make-directory tmp-name5)
819 (rename-file tmp-name1 tmp-name5)
820 (should-not (file-exists-p tmp-name1))
821 (should
822 (file-exists-p
823 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
825 ;; Cleanup.
826 (ignore-errors (delete-file tmp-name1))
827 (ignore-errors (delete-file tmp-name4))
828 (ignore-errors (delete-directory tmp-name5 'recursive)))
830 ;; Rename from local side to remote side.
831 (unwind-protect
832 (progn
833 (write-region "foo" nil tmp-name4 nil 'nomessage)
834 (rename-file tmp-name4 tmp-name1)
835 (should-not (file-exists-p tmp-name4))
836 (should (file-exists-p tmp-name1))
837 (with-temp-buffer
838 (insert-file-contents tmp-name1)
839 (should (string-equal (buffer-string) "foo")))
840 (write-region "foo" nil tmp-name4 nil 'nomessage)
841 (should-error (rename-file tmp-name4 tmp-name1))
842 (rename-file tmp-name4 tmp-name1 'ok)
843 (should-not (file-exists-p tmp-name4))
844 (write-region "foo" nil tmp-name4 nil 'nomessage)
845 (make-directory tmp-name3)
846 (rename-file tmp-name4 tmp-name3)
847 (should-not (file-exists-p tmp-name4))
848 (should
849 (file-exists-p
850 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
852 ;; Cleanup.
853 (ignore-errors (delete-file tmp-name1))
854 (ignore-errors (delete-file tmp-name4))
855 (ignore-errors (delete-directory tmp-name3 'recursive)))))
857 (ert-deftest tramp-test13-make-directory ()
858 "Check `make-directory'.
859 This tests also `file-directory-p' and `file-accessible-directory-p'."
860 (skip-unless (tramp--test-enabled))
862 (let ((tmp-name (tramp--test-make-temp-name)))
863 (unwind-protect
864 (progn
865 (make-directory tmp-name)
866 (should (file-directory-p tmp-name))
867 (should (file-accessible-directory-p tmp-name))
868 (should-error
869 (make-directory (expand-file-name "foo/bar" tmp-name))
870 :type 'file-error)
871 (make-directory (expand-file-name "foo/bar" tmp-name) 'parents)
872 (should (file-directory-p (expand-file-name "foo/bar" tmp-name)))
873 (should
874 (file-accessible-directory-p (expand-file-name "foo/bar" tmp-name))))
876 ;; Cleanup.
877 (ignore-errors (delete-directory tmp-name 'recursive)))))
879 (ert-deftest tramp-test14-delete-directory ()
880 "Check `delete-directory'."
881 (skip-unless (tramp--test-enabled))
883 (let ((tmp-name (tramp--test-make-temp-name)))
884 ;; Delete empty directory.
885 (make-directory tmp-name)
886 (should (file-directory-p tmp-name))
887 (delete-directory tmp-name)
888 (should-not (file-directory-p tmp-name))
889 ;; Delete non-empty directory.
890 (make-directory tmp-name)
891 (write-region "foo" nil (expand-file-name "bla" tmp-name))
892 (should-error (delete-directory tmp-name) :type 'file-error)
893 (delete-directory tmp-name 'recursive)
894 (should-not (file-directory-p tmp-name))))
896 (ert-deftest tramp-test15-copy-directory ()
897 "Check `copy-directory'."
898 (skip-unless (tramp--test-enabled))
899 (skip-unless
900 (not
902 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
903 'tramp-smb-file-name-handler)))
905 (let* ((tmp-name1 (tramp--test-make-temp-name))
906 (tmp-name2 (tramp--test-make-temp-name))
907 (tmp-name3 (expand-file-name
908 (file-name-nondirectory tmp-name1) tmp-name2))
909 (tmp-name4 (expand-file-name "foo" tmp-name1))
910 (tmp-name5 (expand-file-name "foo" tmp-name2))
911 (tmp-name6 (expand-file-name "foo" tmp-name3)))
912 (unwind-protect
913 (progn
914 ;; Copy empty directory.
915 (make-directory tmp-name1)
916 (write-region "foo" nil tmp-name4)
917 (should (file-directory-p tmp-name1))
918 (should (file-exists-p tmp-name4))
919 (copy-directory tmp-name1 tmp-name2)
920 (should (file-directory-p tmp-name2))
921 (should (file-exists-p tmp-name5))
922 ;; Target directory does exist already.
923 (copy-directory tmp-name1 tmp-name2)
924 (should (file-directory-p tmp-name3))
925 (should (file-exists-p tmp-name6)))
927 ;; Cleanup.
928 (ignore-errors
929 (delete-directory tmp-name1 'recursive)
930 (delete-directory tmp-name2 'recursive)))))
932 (ert-deftest tramp-test16-directory-files ()
933 "Check `directory-files'."
934 (skip-unless (tramp--test-enabled))
936 (let* ((tmp-name1 (tramp--test-make-temp-name))
937 (tmp-name2 (expand-file-name "bla" tmp-name1))
938 (tmp-name3 (expand-file-name "foo" tmp-name1)))
939 (unwind-protect
940 (progn
941 (make-directory tmp-name1)
942 (write-region "foo" nil tmp-name2)
943 (write-region "bla" nil tmp-name3)
944 (should (file-directory-p tmp-name1))
945 (should (file-exists-p tmp-name2))
946 (should (file-exists-p tmp-name3))
947 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
948 (should (equal (directory-files tmp-name1 'full)
949 `(,(concat tmp-name1 "/.")
950 ,(concat tmp-name1 "/..")
951 ,tmp-name2 ,tmp-name3)))
952 (should (equal (directory-files
953 tmp-name1 nil directory-files-no-dot-files-regexp)
954 '("bla" "foo")))
955 (should (equal (directory-files
956 tmp-name1 'full directory-files-no-dot-files-regexp)
957 `(,tmp-name2 ,tmp-name3))))
959 ;; Cleanup.
960 (ignore-errors (delete-directory tmp-name1 'recursive)))))
962 (ert-deftest tramp-test17-insert-directory ()
963 "Check `insert-directory'."
964 (skip-unless (tramp--test-enabled))
966 (let* ((tmp-name1 (tramp--test-make-temp-name))
967 (tmp-name2 (expand-file-name "foo" tmp-name1))
968 ;; We test for the summary line. Keyword "total" could be localized.
969 (process-environment
970 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
971 (unwind-protect
972 (progn
973 (make-directory tmp-name1)
974 (write-region "foo" nil tmp-name2)
975 (should (file-directory-p tmp-name1))
976 (should (file-exists-p tmp-name2))
977 (with-temp-buffer
978 (insert-directory tmp-name1 nil)
979 (goto-char (point-min))
980 (should (looking-at-p (regexp-quote tmp-name1))))
981 (with-temp-buffer
982 (insert-directory tmp-name1 "-al")
983 (goto-char (point-min))
984 (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
985 (with-temp-buffer
986 (insert-directory (file-name-as-directory tmp-name1) "-al")
987 (goto-char (point-min))
988 (should
989 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
990 (with-temp-buffer
991 (insert-directory
992 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
993 (goto-char (point-min))
994 (should
995 (looking-at-p
996 (concat
997 ;; There might be a summary line.
998 "\\(total.+[[:digit:]]+\n\\)?"
999 ;; We don't know in which order ".", ".." and "foo" appear.
1000 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
1002 ;; Cleanup.
1003 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1005 (ert-deftest tramp-test18-file-attributes ()
1006 "Check `file-attributes'.
1007 This tests also `file-readable-p' and `file-regular-p'."
1008 (skip-unless (tramp--test-enabled))
1010 ;; We must use `file-truename' for the temporary directory, because
1011 ;; it could be located on a symlinked directory. This would let the
1012 ;; test fail.
1013 (let* ((tramp-test-temporary-file-directory
1014 (file-truename tramp-test-temporary-file-directory))
1015 (tmp-name1 (tramp--test-make-temp-name))
1016 (tmp-name2 (tramp--test-make-temp-name))
1017 attr)
1018 (unwind-protect
1019 (progn
1020 (write-region "foo" nil tmp-name1)
1021 (should (file-exists-p tmp-name1))
1022 (setq attr (file-attributes tmp-name1))
1023 (should (consp attr))
1024 (should (file-exists-p tmp-name1))
1025 (should (file-readable-p tmp-name1))
1026 (should (file-regular-p tmp-name1))
1027 ;; We do not test inodes and device numbers.
1028 (should (null (car attr)))
1029 (should (numberp (nth 1 attr))) ;; Link.
1030 (should (numberp (nth 2 attr))) ;; Uid.
1031 (should (numberp (nth 3 attr))) ;; Gid.
1032 ;; Last access time.
1033 (should (stringp (current-time-string (nth 4 attr))))
1034 ;; Last modification time.
1035 (should (stringp (current-time-string (nth 5 attr))))
1036 ;; Last status change time.
1037 (should (stringp (current-time-string (nth 6 attr))))
1038 (should (numberp (nth 7 attr))) ;; Size.
1039 (should (stringp (nth 8 attr))) ;; Modes.
1041 (setq attr (file-attributes tmp-name1 'string))
1042 (should (stringp (nth 2 attr))) ;; Uid.
1043 (should (stringp (nth 3 attr))) ;; Gid.
1045 (condition-case err
1046 (progn
1047 (make-symbolic-link tmp-name1 tmp-name2)
1048 (should (file-exists-p tmp-name2))
1049 (should (file-symlink-p tmp-name2))
1050 (setq attr (file-attributes tmp-name2))
1051 (should (string-equal
1052 (car attr)
1053 (file-remote-p (file-truename tmp-name1) 'localname)))
1054 (delete-file tmp-name2))
1055 (file-error
1056 (should (string-equal (error-message-string err)
1057 "make-symbolic-link not supported"))))
1058 (delete-file tmp-name1)
1060 (make-directory tmp-name1)
1061 (should (file-exists-p tmp-name1))
1062 (should (file-readable-p tmp-name1))
1063 (should-not (file-regular-p tmp-name1))
1064 (setq attr (file-attributes tmp-name1))
1065 (should (eq (car attr) t)))
1067 ;; Cleanup.
1068 (ignore-errors (delete-directory tmp-name1)))))
1070 (ert-deftest tramp-test19-directory-files-and-attributes ()
1071 "Check `directory-files-and-attributes'."
1072 (skip-unless (tramp--test-enabled))
1074 ;; `directory-files-and-attributes' contains also values for "../".
1075 ;; Ensure that this doesn't change during tests, for
1076 ;; example due to handling temporary files.
1077 (let* ((tmp-name1 (tramp--test-make-temp-name))
1078 (tmp-name2 (expand-file-name "bla" tmp-name1))
1079 attr)
1080 (unwind-protect
1081 (progn
1082 (make-directory tmp-name1)
1083 (should (file-directory-p tmp-name1))
1084 (make-directory tmp-name2)
1085 (should (file-directory-p tmp-name2))
1086 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
1087 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
1088 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
1089 (setq attr (directory-files-and-attributes tmp-name2))
1090 (should (consp attr))
1091 ;; Dumb remote shells without perl(1) or stat(1) are not
1092 ;; able to return the date correctly. They say "don't know".
1093 (dolist (elt attr)
1094 (unless
1095 (equal
1096 (nth 5
1097 (file-attributes (expand-file-name (car elt) tmp-name2)))
1098 '(0 0))
1099 (should
1100 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
1101 (cdr elt)))))
1102 (setq attr (directory-files-and-attributes tmp-name2 'full))
1103 (dolist (elt attr)
1104 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
1105 (should
1106 (equal (file-attributes (car elt)) (cdr elt)))))
1107 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
1108 (should (equal (mapcar 'car attr) '("bar" "boz"))))
1110 ;; Cleanup.
1111 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1113 (ert-deftest tramp-test20-file-modes ()
1114 "Check `file-modes'.
1115 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1116 (skip-unless (tramp--test-enabled))
1117 (skip-unless
1118 (not
1119 (memq
1120 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1121 '(tramp-adb-file-name-handler
1122 tramp-gvfs-file-name-handler
1123 tramp-smb-file-name-handler))))
1125 (let ((tmp-name (tramp--test-make-temp-name)))
1126 (unwind-protect
1127 (progn
1128 (write-region "foo" nil tmp-name)
1129 (should (file-exists-p tmp-name))
1130 (set-file-modes tmp-name #o777)
1131 (should (= (file-modes tmp-name) #o777))
1132 (should (file-executable-p tmp-name))
1133 (should (file-writable-p tmp-name))
1134 (set-file-modes tmp-name #o444)
1135 (should (= (file-modes tmp-name) #o444))
1136 (should-not (file-executable-p tmp-name))
1137 ;; A file is always writable for user "root".
1138 (unless (zerop (nth 2 (file-attributes tmp-name)))
1139 (should-not (file-writable-p tmp-name))))
1141 ;; Cleanup.
1142 (ignore-errors (delete-file tmp-name)))))
1144 (ert-deftest tramp-test21-file-links ()
1145 "Check `file-symlink-p'.
1146 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1147 (skip-unless (tramp--test-enabled))
1149 ;; We must use `file-truename' for the temporary directory, because
1150 ;; it could be located on a symlinked directory. This would let the
1151 ;; test fail.
1152 (let* ((tramp-test-temporary-file-directory
1153 (file-truename tramp-test-temporary-file-directory))
1154 (tmp-name1 (tramp--test-make-temp-name))
1155 (tmp-name2 (tramp--test-make-temp-name))
1156 (tmp-name3 (tramp--test-make-temp-name 'local)))
1157 (unwind-protect
1158 (progn
1159 (write-region "foo" nil tmp-name1)
1160 (should (file-exists-p tmp-name1))
1161 ;; Method "smb" supports `make-symbolic-link' only if the
1162 ;; remote host has CIFS capabilities. tramp-adb.el and
1163 ;; tramp-gvfs.el do not support symbolic links at all.
1164 (condition-case err
1165 (make-symbolic-link tmp-name1 tmp-name2)
1166 (file-error
1167 (skip-unless
1168 (not (string-equal (error-message-string err)
1169 "make-symbolic-link not supported")))))
1170 (should (file-symlink-p tmp-name2))
1171 (should-error (make-symbolic-link tmp-name1 tmp-name2))
1172 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
1173 (should (file-symlink-p tmp-name2))
1174 ;; `tmp-name3' is a local file name.
1175 (should-error (make-symbolic-link tmp-name1 tmp-name3)))
1177 ;; Cleanup.
1178 (ignore-errors
1179 (delete-file tmp-name1)
1180 (delete-file tmp-name2)))
1182 (unwind-protect
1183 (progn
1184 (write-region "foo" nil tmp-name1)
1185 (should (file-exists-p tmp-name1))
1186 (add-name-to-file tmp-name1 tmp-name2)
1187 (should-not (file-symlink-p tmp-name2))
1188 (should-error (add-name-to-file tmp-name1 tmp-name2))
1189 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
1190 (should-not (file-symlink-p tmp-name2))
1191 ;; `tmp-name3' is a local file name.
1192 (should-error (add-name-to-file tmp-name1 tmp-name3)))
1194 ;; Cleanup.
1195 (ignore-errors
1196 (delete-file tmp-name1)
1197 (delete-file tmp-name2)))
1199 (unwind-protect
1200 (progn
1201 (write-region "foo" nil tmp-name1)
1202 (should (file-exists-p tmp-name1))
1203 (make-symbolic-link tmp-name1 tmp-name2)
1204 (should (file-symlink-p tmp-name2))
1205 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
1206 (should
1207 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
1208 (should (file-equal-p tmp-name1 tmp-name2)))
1209 (ignore-errors
1210 (delete-file tmp-name1)
1211 (delete-file tmp-name2)))
1213 ;; `file-truename' shall preserve trailing link of directories.
1214 (unless (file-symlink-p tramp-test-temporary-file-directory)
1215 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
1216 (dir2 (file-name-as-directory dir1)))
1217 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
1218 (should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
1220 (ert-deftest tramp-test22-file-times ()
1221 "Check `set-file-times' and `file-newer-than-file-p'."
1222 (skip-unless (tramp--test-enabled))
1223 (skip-unless
1224 (not
1225 (memq
1226 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1227 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1229 (let ((tmp-name1 (tramp--test-make-temp-name))
1230 (tmp-name2 (tramp--test-make-temp-name))
1231 (tmp-name3 (tramp--test-make-temp-name)))
1232 (unwind-protect
1233 (progn
1234 (write-region "foo" nil tmp-name1)
1235 (should (file-exists-p tmp-name1))
1236 (should (consp (nth 5 (file-attributes tmp-name1))))
1237 ;; '(0 0) means don't know, and will be replaced by
1238 ;; `current-time'. Therefore, we use '(0 1).
1239 ;; We skip the test, if the remote handler is not able to
1240 ;; set the correct time.
1241 (skip-unless (set-file-times tmp-name1 '(0 1)))
1242 ;; Dumb remote shells without perl(1) or stat(1) are not
1243 ;; able to return the date correctly. They say "don't know".
1244 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
1245 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1246 (write-region "bla" nil tmp-name2)
1247 (should (file-exists-p tmp-name2))
1248 (should (file-newer-than-file-p tmp-name2 tmp-name1))
1249 ;; `tmp-name3' does not exist.
1250 (should (file-newer-than-file-p tmp-name2 tmp-name3))
1251 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
1253 ;; Cleanup.
1254 (ignore-errors
1255 (delete-file tmp-name1)
1256 (delete-file tmp-name2)))))
1258 (ert-deftest tramp-test23-visited-file-modtime ()
1259 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1260 (skip-unless (tramp--test-enabled))
1262 (let ((tmp-name (tramp--test-make-temp-name)))
1263 (unwind-protect
1264 (progn
1265 (write-region "foo" nil tmp-name)
1266 (should (file-exists-p tmp-name))
1267 (with-temp-buffer
1268 (insert-file-contents tmp-name)
1269 (should (verify-visited-file-modtime))
1270 (set-visited-file-modtime '(0 1))
1271 (should (verify-visited-file-modtime))
1272 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1274 ;; Cleanup.
1275 (ignore-errors (delete-file tmp-name)))))
1277 (ert-deftest tramp-test24-file-name-completion ()
1278 "Check `file-name-completion' and `file-name-all-completions'."
1279 (skip-unless (tramp--test-enabled))
1281 (let ((tmp-name (tramp--test-make-temp-name)))
1282 (unwind-protect
1283 (progn
1284 (make-directory tmp-name)
1285 (should (file-directory-p tmp-name))
1286 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1287 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1288 (make-directory (expand-file-name "boz" tmp-name))
1289 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1290 (should (equal (file-name-completion "b" tmp-name) "bo"))
1291 (should
1292 (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1293 (should (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1294 (should
1295 (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1296 '("bold" "boz/"))))
1298 ;; Cleanup.
1299 (ignore-errors (delete-directory tmp-name 'recursive)))))
1301 (ert-deftest tramp-test25-load ()
1302 "Check `load'."
1303 (skip-unless (tramp--test-enabled))
1305 (let ((tmp-name (tramp--test-make-temp-name)))
1306 (unwind-protect
1307 (progn
1308 (load tmp-name 'noerror 'nomessage)
1309 (should-not (featurep 'tramp-test-load))
1310 (write-region "(provide 'tramp-test-load)" nil tmp-name)
1311 ;; `load' in lread.c does not pass `must-suffix'. Why?
1312 ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1313 (load tmp-name nil 'nomessage 'nosuffix)
1314 (should (featurep 'tramp-test-load)))
1316 ;; Cleanup.
1317 (ignore-errors
1318 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1319 (delete-file tmp-name)))))
1321 (ert-deftest tramp-test26-process-file ()
1322 "Check `process-file'."
1323 (skip-unless (tramp--test-enabled))
1324 (skip-unless
1325 (not
1326 (memq
1327 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1328 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1330 (let* ((tmp-name (tramp--test-make-temp-name))
1331 (fnnd (file-name-nondirectory tmp-name))
1332 (default-directory tramp-test-temporary-file-directory)
1333 kill-buffer-query-functions)
1334 (unwind-protect
1335 (progn
1336 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1337 ;; do not exist on hydra.
1338 (should (zerop (process-file "true")))
1339 (should-not (zerop (process-file "false")))
1340 (should-not (zerop (process-file "binary-does-not-exist")))
1341 (with-temp-buffer
1342 (write-region "foo" nil tmp-name)
1343 (should (file-exists-p tmp-name))
1344 (should (zerop (process-file "ls" nil t nil fnnd)))
1345 ;; `ls' could produce colorized output.
1346 (goto-char (point-min))
1347 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1348 (replace-match "" nil nil))
1349 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1350 (should-not (get-buffer-window (current-buffer) t))
1352 ;; Second run. The output must be appended.
1353 (should (zerop (process-file "ls" nil t t fnnd)))
1354 ;; `ls' could produce colorized output.
1355 (goto-char (point-min))
1356 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1357 (replace-match "" nil nil))
1358 (should
1359 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
1360 ;; A non-nil DISPLAY must not raise the buffer.
1361 (should-not (get-buffer-window (current-buffer) t))))
1363 ;; Cleanup.
1364 (ignore-errors (delete-file tmp-name)))))
1366 (ert-deftest tramp-test27-start-file-process ()
1367 "Check `start-file-process'."
1368 (skip-unless (tramp--test-enabled))
1369 (skip-unless
1370 (not
1371 (memq
1372 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1373 '(tramp-adb-file-name-handler
1374 tramp-gvfs-file-name-handler
1375 tramp-smb-file-name-handler))))
1377 (let ((default-directory tramp-test-temporary-file-directory)
1378 (tmp-name (tramp--test-make-temp-name))
1379 kill-buffer-query-functions proc)
1380 (unwind-protect
1381 (with-temp-buffer
1382 (setq proc (start-file-process "test1" (current-buffer) "cat"))
1383 (should (processp proc))
1384 (should (equal (process-status proc) 'run))
1385 (process-send-string proc "foo")
1386 (process-send-eof proc)
1387 ;; Read output.
1388 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1389 (while (< (- (point-max) (point-min)) (length "foo"))
1390 (accept-process-output proc 1)))
1391 (should (string-equal (buffer-string) "foo")))
1393 ;; Cleanup.
1394 (ignore-errors (delete-process proc)))
1396 (unwind-protect
1397 (with-temp-buffer
1398 (write-region "foo" nil tmp-name)
1399 (should (file-exists-p tmp-name))
1400 (setq proc
1401 (start-file-process
1402 "test2" (current-buffer)
1403 "cat" (file-name-nondirectory tmp-name)))
1404 (should (processp proc))
1405 ;; Read output.
1406 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1407 (while (< (- (point-max) (point-min)) (length "foo"))
1408 (accept-process-output proc 1)))
1409 (should (string-equal (buffer-string) "foo")))
1411 ;; Cleanup.
1412 (ignore-errors
1413 (delete-process proc)
1414 (delete-file tmp-name)))
1416 (unwind-protect
1417 (with-temp-buffer
1418 (setq proc (start-file-process "test3" (current-buffer) "cat"))
1419 (should (processp proc))
1420 (should (equal (process-status proc) 'run))
1421 (set-process-filter
1422 proc
1423 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
1424 (process-send-string proc "foo")
1425 (process-send-eof proc)
1426 ;; Read output.
1427 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1428 (while (< (- (point-max) (point-min)) (length "foo"))
1429 (accept-process-output proc 1)))
1430 (should (string-equal (buffer-string) "foo")))
1432 ;; Cleanup.
1433 (ignore-errors (delete-process proc)))))
1435 (ert-deftest tramp-test28-shell-command ()
1436 "Check `shell-command'."
1437 (skip-unless (tramp--test-enabled))
1438 (skip-unless
1439 (not
1440 (memq
1441 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1442 '(tramp-adb-file-name-handler
1443 tramp-gvfs-file-name-handler
1444 tramp-smb-file-name-handler))))
1446 (let ((tmp-name (tramp--test-make-temp-name))
1447 (default-directory tramp-test-temporary-file-directory)
1448 kill-buffer-query-functions)
1449 (unwind-protect
1450 (with-temp-buffer
1451 (write-region "foo" nil tmp-name)
1452 (should (file-exists-p tmp-name))
1453 (shell-command
1454 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1455 ;; `ls' could produce colorized output.
1456 (goto-char (point-min))
1457 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1458 (replace-match "" nil nil))
1459 (should
1460 (string-equal
1461 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1463 ;; Cleanup.
1464 (ignore-errors (delete-file tmp-name)))
1466 (unwind-protect
1467 (with-temp-buffer
1468 (write-region "foo" nil tmp-name)
1469 (should (file-exists-p tmp-name))
1470 (async-shell-command
1471 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1472 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1473 ;; Read output.
1474 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1475 (while (< (- (point-max) (point-min))
1476 (1+ (length (file-name-nondirectory tmp-name))))
1477 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1478 ;; `ls' could produce colorized output.
1479 (goto-char (point-min))
1480 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1481 (replace-match "" nil nil))
1482 ;; There might be a nasty "Process *Async Shell* finished" message.
1483 (goto-char (point-min))
1484 (forward-line)
1485 (narrow-to-region (point-min) (point))
1486 (should
1487 (string-equal
1488 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1490 ;; Cleanup.
1491 (ignore-errors (delete-file tmp-name)))
1493 (unwind-protect
1494 (with-temp-buffer
1495 (write-region "foo" nil tmp-name)
1496 (should (file-exists-p tmp-name))
1497 (async-shell-command "read line; ls $line" (current-buffer))
1498 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1499 (process-send-string
1500 (get-buffer-process (current-buffer))
1501 (format "%s\n" (file-name-nondirectory tmp-name)))
1502 ;; Read output.
1503 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1504 (while (< (- (point-max) (point-min))
1505 (1+ (length (file-name-nondirectory tmp-name))))
1506 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1507 ;; `ls' could produce colorized output.
1508 (goto-char (point-min))
1509 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1510 (replace-match "" nil nil))
1511 ;; There might be a nasty "Process *Async Shell* finished" message.
1512 (goto-char (point-min))
1513 (forward-line)
1514 (narrow-to-region (point-min) (point))
1515 (should
1516 (string-equal
1517 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1519 ;; Cleanup.
1520 (ignore-errors (delete-file tmp-name)))))
1522 (ert-deftest tramp-test29-vc-registered ()
1523 "Check `vc-registered'."
1524 (skip-unless (tramp--test-enabled))
1525 (skip-unless
1527 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1528 'tramp-sh-file-name-handler))
1530 (let* ((default-directory tramp-test-temporary-file-directory)
1531 (tmp-name1 (tramp--test-make-temp-name))
1532 (tmp-name2 (expand-file-name "foo" tmp-name1))
1533 (tramp-remote-process-environment tramp-remote-process-environment)
1534 (vc-handled-backends
1535 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1536 (cond
1537 ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
1538 (setq tramp-remote-process-environment
1539 (cons (format "BZR_HOME=%s"
1540 (file-remote-p tmp-name1 'localname))
1541 tramp-remote-process-environment))
1542 ;; We must force a reconnect, in order to activate $BZR_HOME.
1543 (tramp-cleanup-connection
1544 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1545 nil 'keep-password)
1546 '(Bzr))
1547 ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
1548 '(Git))
1549 ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
1550 '(Hg))
1551 (t nil)))))
1552 (skip-unless vc-handled-backends)
1553 (message "%s" vc-handled-backends)
1555 (unwind-protect
1556 (progn
1557 (make-directory tmp-name1)
1558 (write-region "foo" nil tmp-name2)
1559 (should (file-directory-p tmp-name1))
1560 (should (file-exists-p tmp-name2))
1561 (should-not (vc-registered tmp-name1))
1562 (should-not (vc-registered tmp-name2))
1564 (let ((default-directory tmp-name1))
1565 ;; Create empty repository, and register the file.
1566 (vc-create-repo (car vc-handled-backends))
1567 ;; The structure of VC-FILESET is not documented. Let's
1568 ;; hope it won't change.
1569 (condition-case nil
1570 (vc-register
1571 (list (car vc-handled-backends)
1572 (list (file-name-nondirectory tmp-name2))))
1573 ;; `vc-register' has changed its arguments in Emacs 25.1.
1574 (error
1575 (vc-register
1576 nil (list (car vc-handled-backends)
1577 (list (file-name-nondirectory tmp-name2)))))))
1578 (should (vc-registered tmp-name2)))
1580 ;; Cleanup.
1581 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1583 (ert-deftest tramp-test30-make-auto-save-file-name ()
1584 "Check `make-auto-save-file-name'."
1585 (skip-unless (tramp--test-enabled))
1587 (let ((tmp-name1 (tramp--test-make-temp-name))
1588 (tmp-name2 (tramp--test-make-temp-name)))
1590 (unwind-protect
1591 (progn
1592 ;; Use default `auto-save-file-name-transforms' mechanism.
1593 (let (tramp-auto-save-directory)
1594 (with-temp-buffer
1595 (setq buffer-file-name tmp-name1)
1596 (should
1597 (string-equal
1598 (make-auto-save-file-name)
1599 ;; This is taken from original `make-auto-save-file-name'.
1600 (expand-file-name
1601 (format
1602 "#%s#"
1603 (subst-char-in-string
1604 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
1605 temporary-file-directory)))))
1607 ;; No mapping.
1608 (let (tramp-auto-save-directory auto-save-file-name-transforms)
1609 (with-temp-buffer
1610 (setq buffer-file-name tmp-name1)
1611 (should
1612 (string-equal
1613 (make-auto-save-file-name)
1614 (expand-file-name
1615 (format "#%s#" (file-name-nondirectory tmp-name1))
1616 tramp-test-temporary-file-directory)))))
1618 ;; Use default `tramp-auto-save-directory' mechanism.
1619 (let ((tramp-auto-save-directory tmp-name2))
1620 (with-temp-buffer
1621 (setq buffer-file-name tmp-name1)
1622 (should
1623 (string-equal
1624 (make-auto-save-file-name)
1625 ;; This is taken from Tramp.
1626 (expand-file-name
1627 (format
1628 "#%s#"
1629 (tramp-subst-strs-in-string
1630 '(("_" . "|")
1631 ("/" . "_a")
1632 (":" . "_b")
1633 ("|" . "__")
1634 ("[" . "_l")
1635 ("]" . "_r"))
1636 tmp-name1))
1637 tmp-name2)))
1638 (should (file-directory-p tmp-name2))))
1640 ;; Relative file names shall work, too.
1641 (let ((tramp-auto-save-directory "."))
1642 (with-temp-buffer
1643 (setq buffer-file-name tmp-name1
1644 default-directory tmp-name2)
1645 (should
1646 (string-equal
1647 (make-auto-save-file-name)
1648 ;; This is taken from Tramp.
1649 (expand-file-name
1650 (format
1651 "#%s#"
1652 (tramp-subst-strs-in-string
1653 '(("_" . "|")
1654 ("/" . "_a")
1655 (":" . "_b")
1656 ("|" . "__")
1657 ("[" . "_l")
1658 ("]" . "_r"))
1659 tmp-name1))
1660 tmp-name2)))
1661 (should (file-directory-p tmp-name2)))))
1663 ;; Cleanup.
1664 (ignore-errors (delete-file tmp-name1))
1665 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1667 (defun tramp--test-adb-p ()
1668 "Check, whether the remote host runs Android.
1669 This requires restrictions of file name syntax."
1670 (eq (tramp-find-foreign-file-name-handler
1671 tramp-test-temporary-file-directory)
1672 'tramp-adb-file-name-handler))
1674 (defun tramp--test-smb-or-windows-nt-p ()
1675 "Check, whether the locale or remote host runs MS Windows.
1676 This requires restrictions of file name syntax."
1677 (or (eq system-type 'windows-nt)
1678 (eq (tramp-find-foreign-file-name-handler
1679 tramp-test-temporary-file-directory)
1680 'tramp-smb-file-name-handler)))
1682 (defun tramp--test-check-files (&rest files)
1683 "Run a simple but comprehensive test over every file in FILES."
1684 ;; We must use `file-truename' for the temporary directory, because
1685 ;; it could be located on a symlinked directory. This would let the
1686 ;; test fail.
1687 (let* ((tramp-test-temporary-file-directory
1688 (file-truename tramp-test-temporary-file-directory))
1689 (tmp-name1 (tramp--test-make-temp-name))
1690 (tmp-name2 (tramp--test-make-temp-name 'local))
1691 (files (delq nil files)))
1692 (unwind-protect
1693 (progn
1694 (make-directory tmp-name1)
1695 (make-directory tmp-name2)
1696 (dolist (elt files)
1697 (let* ((file1 (expand-file-name elt tmp-name1))
1698 (file2 (expand-file-name elt tmp-name2))
1699 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
1700 (write-region elt nil file1)
1701 (should (file-exists-p file1))
1703 ;; Check file contents.
1704 (with-temp-buffer
1705 (insert-file-contents file1)
1706 (should (string-equal (buffer-string) elt)))
1708 ;; Copy file both directions.
1709 (copy-file file1 tmp-name2)
1710 (should (file-exists-p file2))
1711 (delete-file file1)
1712 (should-not (file-exists-p file1))
1713 (copy-file file2 tmp-name1)
1714 (should (file-exists-p file1))
1716 ;; Method "smb" supports `make-symbolic-link' only if the
1717 ;; remote host has CIFS capabilities. tramp-adb.el and
1718 ;; tramp-gvfs.el do not support symbolic links at all.
1719 (condition-case err
1720 (progn
1721 (make-symbolic-link file1 file3)
1722 (should (file-symlink-p file3))
1723 (should
1724 (string-equal
1725 (expand-file-name file1) (file-truename file3)))
1726 (should
1727 (string-equal
1728 (car (file-attributes file3))
1729 (file-remote-p (file-truename file1) 'localname)))
1730 ;; Check file contents.
1731 (with-temp-buffer
1732 (insert-file-contents file3)
1733 (should (string-equal (buffer-string) elt)))
1734 (delete-file file3))
1735 (file-error
1736 (should (string-equal (error-message-string err)
1737 "make-symbolic-link not supported"))))))
1739 ;; Check file names.
1740 (should (equal (directory-files
1741 tmp-name1 nil directory-files-no-dot-files-regexp)
1742 (sort (copy-sequence files) 'string-lessp)))
1743 (should (equal (directory-files
1744 tmp-name2 nil directory-files-no-dot-files-regexp)
1745 (sort (copy-sequence files) 'string-lessp)))
1747 ;; `substitute-in-file-name' could return different values.
1748 ;; For `adb', there could be strange file permissions
1749 ;; preventing overwriting a file. We don't care in this
1750 ;; testcase.
1751 (dolist (elt files)
1752 (let ((file1
1753 (substitute-in-file-name (expand-file-name elt tmp-name1)))
1754 (file2
1755 (substitute-in-file-name (expand-file-name elt tmp-name2))))
1756 (ignore-errors (write-region elt nil file1))
1757 (should (file-exists-p file1))
1758 (ignore-errors (write-region elt nil file2 nil 'nomessage))
1759 (should (file-exists-p file2))))
1761 (should (equal (directory-files
1762 tmp-name1 nil directory-files-no-dot-files-regexp)
1763 (directory-files
1764 tmp-name2 nil directory-files-no-dot-files-regexp)))
1766 ;; Check directory creation. We use a subdirectory "foo"
1767 ;; in order to avoid conflicts with previous file name tests.
1768 (dolist (elt files)
1769 (let* ((elt1 (concat elt "foo"))
1770 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1771 (file2 (expand-file-name elt file1))
1772 (file3 (expand-file-name elt1 file1)))
1773 (make-directory file1 'parents)
1774 (should (file-directory-p file1))
1775 (write-region elt nil file2)
1776 (should (file-exists-p file2))
1777 (should
1778 (equal
1779 (directory-files file1 nil directory-files-no-dot-files-regexp)
1780 `(,elt)))
1781 (should
1782 (equal
1783 (caar (directory-files-and-attributes
1784 file1 nil directory-files-no-dot-files-regexp))
1785 elt))
1787 ;; Check symlink in `directory-files-and-attributes'.
1788 (condition-case err
1789 (progn
1790 (make-symbolic-link file2 file3)
1791 (should (file-symlink-p file3))
1792 (should
1793 (string-equal
1794 (caar (directory-files-and-attributes
1795 file1 nil (regexp-quote elt1)))
1796 elt1))
1797 (should
1798 (string-equal
1799 (cadr (car (directory-files-and-attributes
1800 file1 nil (regexp-quote elt1))))
1801 (file-remote-p (file-truename file2) 'localname)))
1802 (delete-file file3)
1803 (should-not (file-exists-p file3)))
1804 (file-error
1805 (should (string-equal (error-message-string err)
1806 "make-symbolic-link not supported"))))
1808 (delete-file file2)
1809 (should-not (file-exists-p file2))
1810 (delete-directory file1)
1811 (should-not (file-exists-p file1)))))
1813 ;; Cleanup.
1814 (ignore-errors (delete-directory tmp-name1 'recursive))
1815 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1817 (defun tramp--test-special-characters ()
1818 "Perform the test in `tramp-test30-special-characters*'."
1819 ;; Newlines, slashes and backslashes in file names are not
1820 ;; supported. So we don't test. And we don't test the tab
1821 ;; character on Windows or Cygwin, because the backslash is
1822 ;; interpreted as a path separator, preventing "\t" from being
1823 ;; expanded to <TAB>.
1824 (tramp--test-check-files
1825 (if (tramp--test-smb-or-windows-nt-p)
1826 "foo bar baz"
1827 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1828 " foo bar baz "
1829 " foo\tbar baz\t"))
1830 "$foo$bar$$baz$"
1831 "-foo-bar-baz-"
1832 "%foo%bar%baz%"
1833 "&foo&bar&baz&"
1834 (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?")
1835 (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*")
1836 (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"")
1837 "#foo~bar#baz~"
1838 (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|")
1839 (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;")
1840 (unless (tramp--test-smb-or-windows-nt-p) "<foo>bar<baz>")
1841 "(foo)bar(baz)"
1842 "[foo]bar[baz]"
1843 "{foo}bar{baz}"))
1845 ;; These tests are inspired by Bug#17238.
1846 (ert-deftest tramp-test31-special-characters ()
1847 "Check special characters in file names."
1848 (skip-unless (tramp--test-enabled))
1850 (tramp--test-special-characters))
1852 (ert-deftest tramp-test31-special-characters-with-stat ()
1853 "Check special characters in file names.
1854 Use the `stat' command."
1855 (skip-unless (tramp--test-enabled))
1856 (skip-unless
1858 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1859 'tramp-sh-file-name-handler))
1860 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1861 (skip-unless (tramp-get-remote-stat v)))
1863 (unwind-protect
1864 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1865 (tramp-set-connection-property v "perl" nil)
1866 (tramp--test-special-characters))
1868 ;; Reset suppressed properties.
1869 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1870 (tramp-set-connection-property v "perl" 'undef))))
1872 (ert-deftest tramp-test31-special-characters-with-perl ()
1873 "Check special characters in file names.
1874 Use the `perl' command."
1875 (skip-unless (tramp--test-enabled))
1876 (skip-unless
1878 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1879 'tramp-sh-file-name-handler))
1880 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1881 (skip-unless (tramp-get-remote-perl v)))
1883 (unwind-protect
1884 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1885 (tramp-set-connection-property v "stat" nil)
1886 (tramp--test-special-characters))
1888 ;; Reset suppressed properties.
1889 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1890 (tramp-set-connection-property v "stat" 'undef))))
1892 (ert-deftest tramp-test31-special-characters-with-ls ()
1893 "Check special characters in file names.
1894 Use the `ls' command."
1895 (skip-unless (tramp--test-enabled))
1896 (skip-unless
1898 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1899 'tramp-sh-file-name-handler))
1901 (unwind-protect
1902 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1903 (tramp-set-connection-property v "stat" nil)
1904 (tramp-set-connection-property v "perl" nil)
1905 (tramp--test-special-characters))
1907 ;; Reset suppressed properties.
1908 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1909 (tramp-set-connection-property v "stat" 'undef)
1910 (tramp-set-connection-property v "perl" 'undef))))
1912 (defun tramp--test-utf8 ()
1913 "Perform the test in `tramp-test31-utf8*'."
1914 (let ((coding-system-for-read 'utf-8)
1915 (coding-system-for-write 'utf-8)
1916 (file-name-coding-system 'utf-8))
1917 (tramp--test-check-files
1918 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1919 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1920 "银河系漫游指南系列"
1921 "Автостопом по гала́ктике")))
1923 (ert-deftest tramp-test32-utf8 ()
1924 "Check UTF8 encoding in file names and file contents."
1925 (skip-unless (tramp--test-enabled))
1927 (tramp--test-utf8))
1929 (ert-deftest tramp-test32-utf8-with-stat ()
1930 "Check UTF8 encoding in file names and file contents.
1931 Use the `stat' command."
1932 (skip-unless (tramp--test-enabled))
1933 (skip-unless
1935 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1936 'tramp-sh-file-name-handler))
1937 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1938 (skip-unless (tramp-get-remote-stat v)))
1940 (unwind-protect
1941 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1942 (tramp-set-connection-property v "perl" nil)
1943 (tramp--test-utf8))
1945 ;; Reset suppressed properties.
1946 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1947 (tramp-set-connection-property v "perl" 'undef))))
1949 (ert-deftest tramp-test32-utf8-with-perl ()
1950 "Check UTF8 encoding in file names and file contents.
1951 Use the `perl' command."
1952 (skip-unless (tramp--test-enabled))
1953 (skip-unless
1955 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1956 'tramp-sh-file-name-handler))
1957 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1958 (skip-unless (tramp-get-remote-perl v)))
1960 (unwind-protect
1961 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1962 (tramp-set-connection-property v "stat" nil)
1963 (tramp--test-utf8))
1965 ;; Reset suppressed properties.
1966 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1967 (tramp-set-connection-property v "stat" 'undef))))
1969 (ert-deftest tramp-test32-utf8-with-ls ()
1970 "Check UTF8 encoding in file names and file contents.
1971 Use the `ls' command."
1972 (skip-unless (tramp--test-enabled))
1973 (skip-unless
1975 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1976 'tramp-sh-file-name-handler))
1978 (unwind-protect
1979 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1980 (tramp-set-connection-property v "stat" nil)
1981 (tramp-set-connection-property v "perl" nil)
1982 (tramp--test-utf8))
1984 ;; Reset suppressed properties.
1985 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1986 (tramp-set-connection-property v "stat" 'undef)
1987 (tramp-set-connection-property v "perl" 'undef))))
1989 ;; This test is inspired by Bug#16928.
1990 (ert-deftest tramp-test33-asynchronous-requests ()
1991 "Check parallel asynchronous requests.
1992 Such requests could arrive from timers, process filters and
1993 process sentinels. They shall not disturb each other."
1994 ;; Mark as failed until bug has been fixed.
1995 :expected-result :failed
1996 (skip-unless (tramp--test-enabled))
1997 (skip-unless
1999 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
2000 'tramp-sh-file-name-handler))
2002 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
2003 ;; has the side effect, that this test fails instead to abort. Good
2004 ;; for hydra.
2005 (tramp--instrument-test-case 0
2006 (let* ((tmp-name (tramp--test-make-temp-name))
2007 (default-directory tmp-name)
2008 (remote-file-name-inhibit-cache t)
2009 timer buffers kill-buffer-query-functions)
2011 (unwind-protect
2012 (progn
2013 (make-directory tmp-name)
2015 ;; Setup a timer in order to raise an ordinary command again
2016 ;; and again. `vc-registered' is well suited, because there
2017 ;; are many checks.
2018 (setq
2019 timer
2020 (run-at-time
2022 (lambda ()
2023 (when buffers
2024 (vc-registered
2025 (buffer-name (nth (random (length buffers)) buffers)))))))
2027 ;; Create temporary buffers. The number of buffers
2028 ;; corresponds to the number of processes; it could be
2029 ;; increased in order to make pressure on Tramp.
2030 (dotimes (i 5)
2031 (add-to-list 'buffers (generate-new-buffer "*temp*")))
2033 ;; Open asynchronous processes. Set process sentinel.
2034 (dolist (buf buffers)
2035 (async-shell-command "read line; touch $line; echo $line" buf)
2036 (set-process-sentinel
2037 (get-buffer-process buf)
2038 (lambda (proc _state)
2039 (delete-file (buffer-name (process-buffer proc))))))
2041 ;; Send a string. Use a random order of the buffers. Mix
2042 ;; with regular operation.
2043 (let ((buffers (copy-sequence buffers))
2044 buf)
2045 (while buffers
2046 (setq buf (nth (random (length buffers)) buffers))
2047 (process-send-string
2048 (get-buffer-process buf) (format "'%s'\n" buf))
2049 (file-attributes (buffer-name buf))
2050 (setq buffers (delq buf buffers))))
2052 ;; Wait until the whole output has been read.
2053 (with-timeout ((* 10 (length buffers))
2054 (ert-fail "`async-shell-command' timed out"))
2055 (let ((buffers (copy-sequence buffers))
2056 buf)
2057 (while buffers
2058 (setq buf (nth (random (length buffers)) buffers))
2059 (if (ignore-errors
2060 (memq (process-status (get-buffer-process buf))
2061 '(run open)))
2062 (accept-process-output (get-buffer-process buf) 0.1)
2063 (setq buffers (delq buf buffers))))))
2065 ;; Check.
2066 (dolist (buf buffers)
2067 (with-current-buffer buf
2068 (should
2069 (string-equal (format "'%s'\n" buf) (buffer-string)))))
2070 (should-not
2071 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
2073 ;; Cleanup.
2074 (ignore-errors (cancel-timer timer))
2075 (ignore-errors (delete-directory tmp-name 'recursive))
2076 (dolist (buf buffers)
2077 (ignore-errors (kill-buffer buf)))))))
2079 (ert-deftest tramp-test34-recursive-load ()
2080 "Check that Tramp does not fail due to recursive load."
2081 (skip-unless (tramp--test-enabled))
2083 (dolist (code
2084 (list
2085 (format
2086 "(expand-file-name %S)"
2087 tramp-test-temporary-file-directory)
2088 (format
2089 "(let ((default-directory %S)) (expand-file-name %S))"
2090 tramp-test-temporary-file-directory
2091 temporary-file-directory)))
2092 (should-not
2093 (string-match
2094 "Recursive load"
2095 (shell-command-to-string
2096 (format
2097 "%s -batch -Q -L %s --eval %s"
2098 (expand-file-name invocation-name invocation-directory)
2099 (mapconcat 'shell-quote-argument load-path " -L ")
2100 (shell-quote-argument code)))))))
2102 (ert-deftest tramp-test35-unload ()
2103 "Check that Tramp and its subpackages unload completely.
2104 Since it unloads Tramp, it shall be the last test to run."
2105 ;; Mark as failed until all symbols are unbound.
2106 :expected-result (if (featurep 'tramp) :failed :passed)
2107 (when (featurep 'tramp)
2108 (unload-feature 'tramp 'force)
2109 ;; No Tramp feature must be left.
2110 (should-not (featurep 'tramp))
2111 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
2112 ;; `file-name-handler-alist' must be clean.
2113 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
2114 ;; There shouldn't be left a bound symbol. We do not regard our
2115 ;; test symbols, and the Tramp unload hooks.
2116 (mapatoms
2117 (lambda (x)
2118 (and (or (boundp x) (functionp x))
2119 (string-match "^tramp" (symbol-name x))
2120 (not (string-match "^tramp--?test" (symbol-name x)))
2121 (not (string-match "unload-hook$" (symbol-name x)))
2122 (ert-fail (format "`%s' still bound" x)))))
2123 ;; There shouldn't be left a hook function containing a Tramp
2124 ;; function. We do not regard the Tramp unload hooks.
2125 (mapatoms
2126 (lambda (x)
2127 (and (boundp x)
2128 (string-match "-hooks?$" (symbol-name x))
2129 (not (string-match "unload-hook$" (symbol-name x)))
2130 (consp (symbol-value x))
2131 (ignore-errors (all-completions "tramp" (symbol-value x)))
2132 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
2134 ;; TODO:
2136 ;; * dired-compress-file
2137 ;; * dired-uncache
2138 ;; * file-acl
2139 ;; * file-ownership-preserved-p
2140 ;; * file-selinux-context
2141 ;; * find-backup-file-name
2142 ;; * set-file-acl
2143 ;; * set-file-selinux-context
2145 ;; * Work on skipped tests. Make a comment, when it is impossible.
2146 ;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe
2147 ;; doesn't work well when an interactive password must be provided.
2148 ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
2149 ;; Windows (`process-send-eof'?).
2150 ;; * Fix `tramp-test30-special-characters' for `nc'.
2151 ;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
2152 ;; busybox). Seems to be in `directory-files'.
2153 ;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
2154 ;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
2155 ;; expected error.
2157 (defun tramp-test-all (&optional interactive)
2158 "Run all tests for \\[tramp]."
2159 (interactive "p")
2160 (funcall
2161 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
2163 (provide 'tramp-tests)
2164 ;;; tramp-tests.el ends here