]> code.delx.au - gnu-emacs/blob - test/automated/tramp-tests.el
Sync with Tramp repository
[gnu-emacs] / test / automated / tramp-tests.el
1 ;;; tramp-tests.el --- Tests of remote file access
2
3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
4
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6
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.
11 ;;
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.
16 ;;
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/'.
19
20 ;;; Commentary:
21
22 ;; The tests require a recent ert.el from Emacs 24.4.
23
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.
29
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.
35
36 ;; A whole test run can be performed calling the command `tramp-test-all'.
37
38 ;;; Code:
39
40 (require 'ert)
41 (require 'tramp)
42 (require 'vc)
43 (require 'vc-bzr)
44 (require 'vc-git)
45 (require 'vc-hg)
46
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)
53
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.")
69
70 (setq password-cache-expiry nil
71 tramp-verbose 0
72 tramp-copy-size-limit nil
73 tramp-message-show-message nil)
74
75 ;; This shall happen on hydra only.
76 (when (getenv "NIX_STORE")
77 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
78
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.")
83
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))))))
95
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)))
102
103 ;; Return result.
104 (cdr tramp--test-enabled-checked))
105
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)))
111
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 (debug-ignored-errors
122 (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
123 (unwind-protect
124 (progn ,@body)
125 (when (> tramp-verbose 3)
126 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
127 (with-current-buffer (tramp-get-connection-buffer v)
128 (message "%s" (buffer-string)))
129 (with-current-buffer (tramp-get-debug-buffer v)
130 (message "%s" (buffer-string))))))))
131
132 (ert-deftest tramp-test00-availability ()
133 "Test availability of Tramp functions."
134 :expected-result (if (tramp--test-enabled) :passed :failed)
135 (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
136 (should (ignore-errors
137 (and
138 (file-remote-p tramp-test-temporary-file-directory)
139 (file-directory-p tramp-test-temporary-file-directory)
140 (file-writable-p tramp-test-temporary-file-directory)))))
141
142 (ert-deftest tramp-test01-file-name-syntax ()
143 "Check remote file name syntax."
144 ;; Simple cases.
145 (should (tramp-tramp-file-p "/method::"))
146 (should (tramp-tramp-file-p "/host:"))
147 (should (tramp-tramp-file-p "/user@:"))
148 (should (tramp-tramp-file-p "/user@host:"))
149 (should (tramp-tramp-file-p "/method:host:"))
150 (should (tramp-tramp-file-p "/method:user@:"))
151 (should (tramp-tramp-file-p "/method:user@host:"))
152 (should (tramp-tramp-file-p "/method:user@email@host:"))
153
154 ;; Using a port.
155 (should (tramp-tramp-file-p "/host#1234:"))
156 (should (tramp-tramp-file-p "/user@host#1234:"))
157 (should (tramp-tramp-file-p "/method:host#1234:"))
158 (should (tramp-tramp-file-p "/method:user@host#1234:"))
159
160 ;; Using an IPv4 address.
161 (should (tramp-tramp-file-p "/1.2.3.4:"))
162 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
163 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
164 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
165
166 ;; Using an IPv6 address.
167 (should (tramp-tramp-file-p "/[]:"))
168 (should (tramp-tramp-file-p "/[::1]:"))
169 (should (tramp-tramp-file-p "/user@[::1]:"))
170 (should (tramp-tramp-file-p "/method:[::1]:"))
171 (should (tramp-tramp-file-p "/method:user@[::1]:"))
172
173 ;; Local file name part.
174 (should (tramp-tramp-file-p "/host:/:"))
175 (should (tramp-tramp-file-p "/method:::"))
176 (should (tramp-tramp-file-p "/method::/path/to/file"))
177 (should (tramp-tramp-file-p "/method::file"))
178
179 ;; Multihop.
180 (should (tramp-tramp-file-p "/method1:|method2::"))
181 (should (tramp-tramp-file-p "/method1:host1|host2:"))
182 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
183 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
184 (should (tramp-tramp-file-p
185 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
186
187 ;; No strings.
188 (should-not (tramp-tramp-file-p nil))
189 (should-not (tramp-tramp-file-p 'symbol))
190 ;; "/:" suppresses file name handlers.
191 (should-not (tramp-tramp-file-p "/::"))
192 (should-not (tramp-tramp-file-p "/:@:"))
193 (should-not (tramp-tramp-file-p "/:[]:"))
194 ;; Multihops require a method.
195 (should-not (tramp-tramp-file-p "/host1|host2:"))
196 ;; Methods or hostnames shall be at least two characters on MS Windows.
197 (when (memq system-type '(cygwin windows-nt))
198 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
199 (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
200
201 (ert-deftest tramp-test02-file-name-dissect ()
202 "Check remote file name components."
203 (let ((tramp-default-method "default-method")
204 (tramp-default-user "default-user")
205 (tramp-default-host "default-host"))
206 ;; Expand `tramp-default-user' and `tramp-default-host'.
207 (should (string-equal
208 (file-remote-p "/method::")
209 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
210 (should (string-equal (file-remote-p "/method::" 'method) "method"))
211 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
212 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
213 (should (string-equal (file-remote-p "/method::" 'localname) ""))
214
215 ;; Expand `tramp-default-method' and `tramp-default-user'.
216 (should (string-equal
217 (file-remote-p "/host:")
218 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
219 (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
220 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
221 (should (string-equal (file-remote-p "/host:" 'host) "host"))
222 (should (string-equal (file-remote-p "/host:" 'localname) ""))
223
224 ;; Expand `tramp-default-method' and `tramp-default-host'.
225 (should (string-equal
226 (file-remote-p "/user@:")
227 (format "/%s:%s@%s:" "default-method""user" "default-host")))
228 (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
229 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
230 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
231 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
232
233 ;; Expand `tramp-default-method'.
234 (should (string-equal
235 (file-remote-p "/user@host:")
236 (format "/%s:%s@%s:" "default-method" "user" "host")))
237 (should (string-equal
238 (file-remote-p "/user@host:" 'method) "default-method"))
239 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
240 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
241 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
242
243 ;; Expand `tramp-default-user'.
244 (should (string-equal
245 (file-remote-p "/method:host:")
246 (format "/%s:%s@%s:" "method" "default-user" "host")))
247 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
248 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
249 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
250 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
251
252 ;; Expand `tramp-default-host'.
253 (should (string-equal
254 (file-remote-p "/method:user@:")
255 (format "/%s:%s@%s:" "method" "user" "default-host")))
256 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
257 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
258 (should (string-equal (file-remote-p "/method:user@:" 'host)
259 "default-host"))
260 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
261
262 ;; No expansion.
263 (should (string-equal
264 (file-remote-p "/method:user@host:")
265 (format "/%s:%s@%s:" "method" "user" "host")))
266 (should (string-equal
267 (file-remote-p "/method:user@host:" 'method) "method"))
268 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
269 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
270 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
271
272 ;; No expansion.
273 (should (string-equal
274 (file-remote-p "/method:user@email@host:")
275 (format "/%s:%s@%s:" "method" "user@email" "host")))
276 (should (string-equal
277 (file-remote-p "/method:user@email@host:" 'method) "method"))
278 (should (string-equal
279 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
280 (should (string-equal
281 (file-remote-p "/method:user@email@host:" 'host) "host"))
282 (should (string-equal
283 (file-remote-p "/method:user@email@host:" 'localname) ""))
284
285 ;; Expand `tramp-default-method' and `tramp-default-user'.
286 (should (string-equal
287 (file-remote-p "/host#1234:")
288 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
289 (should (string-equal
290 (file-remote-p "/host#1234:" 'method) "default-method"))
291 (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
292 (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
293 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
294
295 ;; Expand `tramp-default-method'.
296 (should (string-equal
297 (file-remote-p "/user@host#1234:")
298 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
299 (should (string-equal
300 (file-remote-p "/user@host#1234:" 'method) "default-method"))
301 (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
302 (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
303 (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
304
305 ;; Expand `tramp-default-user'.
306 (should (string-equal
307 (file-remote-p "/method:host#1234:")
308 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
309 (should (string-equal
310 (file-remote-p "/method:host#1234:" 'method) "method"))
311 (should (string-equal
312 (file-remote-p "/method:host#1234:" 'user) "default-user"))
313 (should (string-equal
314 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
315 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
316
317 ;; No expansion.
318 (should (string-equal
319 (file-remote-p "/method:user@host#1234:")
320 (format "/%s:%s@%s:" "method" "user" "host#1234")))
321 (should (string-equal
322 (file-remote-p "/method:user@host#1234:" 'method) "method"))
323 (should (string-equal
324 (file-remote-p "/method:user@host#1234:" 'user) "user"))
325 (should (string-equal
326 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
327 (should (string-equal
328 (file-remote-p "/method:user@host#1234:" 'localname) ""))
329
330 ;; Expand `tramp-default-method' and `tramp-default-user'.
331 (should (string-equal
332 (file-remote-p "/1.2.3.4:")
333 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
334 (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
335 (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
336 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
337 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
338
339 ;; Expand `tramp-default-method'.
340 (should (string-equal
341 (file-remote-p "/user@1.2.3.4:")
342 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
343 (should (string-equal
344 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
345 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
346 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
347 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
348
349 ;; Expand `tramp-default-user'.
350 (should (string-equal
351 (file-remote-p "/method:1.2.3.4:")
352 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
353 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
354 (should (string-equal
355 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
356 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
357 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
358
359 ;; No expansion.
360 (should (string-equal
361 (file-remote-p "/method:user@1.2.3.4:")
362 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
363 (should (string-equal
364 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
365 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
366 (should (string-equal
367 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
368 (should (string-equal
369 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
370
371 ;; Expand `tramp-default-method', `tramp-default-user' and
372 ;; `tramp-default-host'.
373 (should (string-equal
374 (file-remote-p "/[]:")
375 (format
376 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
377 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
378 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
379 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
380 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
381
382 ;; Expand `tramp-default-method' and `tramp-default-user'.
383 (let ((tramp-default-host "::1"))
384 (should (string-equal
385 (file-remote-p "/[]:")
386 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
387 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
388 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
389 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
390 (should (string-equal (file-remote-p "/[]:" 'localname) "")))
391
392 ;; Expand `tramp-default-method' and `tramp-default-user'.
393 (should (string-equal
394 (file-remote-p "/[::1]:")
395 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
396 (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
397 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
398 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
399 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
400
401 ;; Expand `tramp-default-method'.
402 (should (string-equal
403 (file-remote-p "/user@[::1]:")
404 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
405 (should (string-equal
406 (file-remote-p "/user@[::1]:" 'method) "default-method"))
407 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
408 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
409 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
410
411 ;; Expand `tramp-default-user'.
412 (should (string-equal
413 (file-remote-p "/method:[::1]:")
414 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
415 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
416 (should (string-equal
417 (file-remote-p "/method:[::1]:" 'user) "default-user"))
418 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
419 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
420
421 ;; No expansion.
422 (should (string-equal
423 (file-remote-p "/method:user@[::1]:")
424 (format "/%s:%s@%s:" "method" "user" "[::1]")))
425 (should (string-equal
426 (file-remote-p "/method:user@[::1]:" 'method) "method"))
427 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
428 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
429 (should (string-equal
430 (file-remote-p "/method:user@[::1]:" 'localname) ""))
431
432 ;; Local file name part.
433 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
434 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
435 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
436 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
437 (should (string-equal
438 (file-remote-p "/method::/path/to/file" 'localname)
439 "/path/to/file"))
440
441 ;; Multihop.
442 (should
443 (string-equal
444 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
445 (format "/%s:%s@%s:" "method2" "user2" "host2")))
446 (should
447 (string-equal
448 (file-remote-p
449 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
450 "method2"))
451 (should
452 (string-equal
453 (file-remote-p
454 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
455 "user2"))
456 (should
457 (string-equal
458 (file-remote-p
459 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
460 "host2"))
461 (should
462 (string-equal
463 (file-remote-p
464 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
465 "/path/to/file"))
466
467 (should
468 (string-equal
469 (file-remote-p
470 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
471 (format "/%s:%s@%s:" "method3" "user3" "host3")))
472 (should
473 (string-equal
474 (file-remote-p
475 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
476 'method)
477 "method3"))
478 (should
479 (string-equal
480 (file-remote-p
481 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
482 'user)
483 "user3"))
484 (should
485 (string-equal
486 (file-remote-p
487 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
488 'host)
489 "host3"))
490 (should
491 (string-equal
492 (file-remote-p
493 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
494 'localname)
495 "/path/to/file"))))
496
497 (ert-deftest tramp-test03-file-name-defaults ()
498 "Check default values for some methods."
499 ;; Default values in tramp-adb.el.
500 (should (string-equal (file-remote-p "/adb::" 'host) ""))
501 ;; Default values in tramp-ftp.el.
502 (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
503 (dolist (u '("ftp" "anonymous"))
504 (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
505 ;; Default values in tramp-gvfs.el.
506 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
507 (symbol-value 'tramp-gvfs-enabled))
508 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
509 ;; Default values in tramp-gw.el.
510 (dolist (m '("tunnel" "socks"))
511 (should
512 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
513 ;; Default values in tramp-sh.el.
514 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
515 (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
516 (dolist (m '("su" "sudo" "ksu"))
517 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
518 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
519 (should
520 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
521 ;; Default values in tramp-smb.el.
522 (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
523 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
524
525 (ert-deftest tramp-test04-substitute-in-file-name ()
526 "Check `substitute-in-file-name'."
527 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
528 (should
529 (string-equal
530 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
531 (should
532 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
533 (should
534 (string-equal
535 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
536 (should
537 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
538 (let (process-environment)
539 (should
540 (string-equal
541 (substitute-in-file-name "/method:host:/path/$FOO")
542 "/method:host:/path/$FOO"))
543 (setenv "FOO" "bla")
544 (should
545 (string-equal
546 (substitute-in-file-name "/method:host:/path/$FOO")
547 "/method:host:/path/bla"))
548 (should
549 (string-equal
550 (substitute-in-file-name "/method:host:/path/$$FOO")
551 "/method:host:/path/$FOO"))))
552
553 (ert-deftest tramp-test05-expand-file-name ()
554 "Check `expand-file-name'."
555 (should
556 (string-equal
557 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
558 (should
559 (string-equal
560 (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
561
562 (ert-deftest tramp-test06-directory-file-name ()
563 "Check `directory-file-name'.
564 This checks also `file-name-as-directory', `file-name-directory',
565 `file-name-nondirectory' and `unhandled-file-name-directory'."
566 (should
567 (string-equal
568 (directory-file-name "/method:host:/path/to/file")
569 "/method:host:/path/to/file"))
570 (should
571 (string-equal
572 (directory-file-name "/method:host:/path/to/file/")
573 "/method:host:/path/to/file"))
574 (should
575 (string-equal
576 (file-name-as-directory "/method:host:/path/to/file")
577 "/method:host:/path/to/file/"))
578 (should
579 (string-equal
580 (file-name-as-directory "/method:host:/path/to/file/")
581 "/method:host:/path/to/file/"))
582 (should
583 (string-equal
584 (file-name-directory "/method:host:/path/to/file")
585 "/method:host:/path/to/"))
586 (should
587 (string-equal
588 (file-name-directory "/method:host:/path/to/file/")
589 "/method:host:/path/to/file/"))
590 (should
591 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
592 (should
593 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
594 (should-not
595 (unhandled-file-name-directory "/method:host:/path/to/file")))
596
597 (ert-deftest tramp-test07-file-exists-p ()
598 "Check `file-exist-p', `write-region' and `delete-file'."
599 (skip-unless (tramp--test-enabled))
600
601 (let ((tmp-name (tramp--test-make-temp-name)))
602 (should-not (file-exists-p tmp-name))
603 (write-region "foo" nil tmp-name)
604 (should (file-exists-p tmp-name))
605 (delete-file tmp-name)
606 (should-not (file-exists-p tmp-name))))
607
608 (ert-deftest tramp-test08-file-local-copy ()
609 "Check `file-local-copy'."
610 (skip-unless (tramp--test-enabled))
611
612 (let ((tmp-name1 (tramp--test-make-temp-name))
613 tmp-name2)
614 (unwind-protect
615 (progn
616 (write-region "foo" nil tmp-name1)
617 (should (setq tmp-name2 (file-local-copy tmp-name1)))
618 (with-temp-buffer
619 (insert-file-contents tmp-name2)
620 (should (string-equal (buffer-string) "foo")))
621 ;; Check also that a file transfer with compression works.
622 (let ((default-directory tramp-test-temporary-file-directory)
623 (tramp-copy-size-limit 4)
624 (tramp-inline-compress-start-size 2))
625 (delete-file tmp-name2)
626 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
627
628 ;; Cleanup.
629 (ignore-errors
630 (delete-file tmp-name1)
631 (delete-file tmp-name2)))))
632
633 (ert-deftest tramp-test09-insert-file-contents ()
634 "Check `insert-file-contents'."
635 (skip-unless (tramp--test-enabled))
636
637 (let ((tmp-name (tramp--test-make-temp-name)))
638 (unwind-protect
639 (progn
640 (write-region "foo" nil tmp-name)
641 (with-temp-buffer
642 (insert-file-contents tmp-name)
643 (should (string-equal (buffer-string) "foo"))
644 (insert-file-contents tmp-name)
645 (should (string-equal (buffer-string) "foofoo"))
646 ;; Insert partly.
647 (insert-file-contents tmp-name nil 1 3)
648 (should (string-equal (buffer-string) "oofoofoo"))
649 ;; Replace.
650 (insert-file-contents tmp-name nil nil nil 'replace)
651 (should (string-equal (buffer-string) "foo"))))
652
653 ;; Cleanup.
654 (ignore-errors (delete-file tmp-name)))))
655
656 (ert-deftest tramp-test10-write-region ()
657 "Check `write-region'."
658 (skip-unless (tramp--test-enabled))
659
660 (let ((tmp-name (tramp--test-make-temp-name)))
661 (unwind-protect
662 (progn
663 (with-temp-buffer
664 (insert "foo")
665 (write-region nil nil tmp-name))
666 (with-temp-buffer
667 (insert-file-contents tmp-name)
668 (should (string-equal (buffer-string) "foo")))
669 ;; Append.
670 (with-temp-buffer
671 (insert "bla")
672 (write-region nil nil tmp-name 'append))
673 (with-temp-buffer
674 (insert-file-contents tmp-name)
675 (should (string-equal (buffer-string) "foobla")))
676 ;; Write string.
677 (write-region "foo" nil tmp-name)
678 (with-temp-buffer
679 (insert-file-contents tmp-name)
680 (should (string-equal (buffer-string) "foo")))
681 ;; Write partly.
682 (with-temp-buffer
683 (insert "123456789")
684 (write-region 3 5 tmp-name))
685 (with-temp-buffer
686 (insert-file-contents tmp-name)
687 (should (string-equal (buffer-string) "34"))))
688
689 ;; Cleanup.
690 (ignore-errors (delete-file tmp-name)))))
691
692 (ert-deftest tramp-test11-copy-file ()
693 "Check `copy-file'."
694 (skip-unless (tramp--test-enabled))
695
696 (let ((tmp-name1 (tramp--test-make-temp-name))
697 (tmp-name2 (tramp--test-make-temp-name))
698 (tmp-name3 (tramp--test-make-temp-name))
699 (tmp-name4 (tramp--test-make-temp-name 'local))
700 (tmp-name5 (tramp--test-make-temp-name 'local)))
701
702 ;; Copy on remote side.
703 (unwind-protect
704 (progn
705 (write-region "foo" nil tmp-name1)
706 (copy-file tmp-name1 tmp-name2)
707 (should (file-exists-p tmp-name2))
708 (with-temp-buffer
709 (insert-file-contents tmp-name2)
710 (should (string-equal (buffer-string) "foo")))
711 (should-error (copy-file tmp-name1 tmp-name2))
712 (copy-file tmp-name1 tmp-name2 'ok)
713 (make-directory tmp-name3)
714 (copy-file tmp-name1 tmp-name3)
715 (should
716 (file-exists-p
717 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
718
719 ;; Cleanup.
720 (ignore-errors (delete-file tmp-name1))
721 (ignore-errors (delete-file tmp-name2))
722 (ignore-errors (delete-directory tmp-name3 'recursive)))
723
724 ;; Copy from remote side to local side.
725 (unwind-protect
726 (progn
727 (write-region "foo" nil tmp-name1)
728 (copy-file tmp-name1 tmp-name4)
729 (should (file-exists-p tmp-name4))
730 (with-temp-buffer
731 (insert-file-contents tmp-name4)
732 (should (string-equal (buffer-string) "foo")))
733 (should-error (copy-file tmp-name1 tmp-name4))
734 (copy-file tmp-name1 tmp-name4 'ok)
735 (make-directory tmp-name5)
736 (copy-file tmp-name1 tmp-name5)
737 (should
738 (file-exists-p
739 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
740
741 ;; Cleanup.
742 (ignore-errors (delete-file tmp-name1))
743 (ignore-errors (delete-file tmp-name4))
744 (ignore-errors (delete-directory tmp-name5 'recursive)))
745
746 ;; Copy from local side to remote side.
747 (unwind-protect
748 (progn
749 (write-region "foo" nil tmp-name4 nil 'nomessage)
750 (copy-file tmp-name4 tmp-name1)
751 (should (file-exists-p tmp-name1))
752 (with-temp-buffer
753 (insert-file-contents tmp-name1)
754 (should (string-equal (buffer-string) "foo")))
755 (should-error (copy-file tmp-name4 tmp-name1))
756 (copy-file tmp-name4 tmp-name1 'ok)
757 (make-directory tmp-name3)
758 (copy-file tmp-name4 tmp-name3)
759 (should
760 (file-exists-p
761 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
762
763 ;; Cleanup.
764 (ignore-errors (delete-file tmp-name1))
765 (ignore-errors (delete-file tmp-name4))
766 (ignore-errors (delete-directory tmp-name3 'recursive)))))
767
768 (ert-deftest tramp-test12-rename-file ()
769 "Check `rename-file'."
770 (skip-unless (tramp--test-enabled))
771
772 (let ((tmp-name1 (tramp--test-make-temp-name))
773 (tmp-name2 (tramp--test-make-temp-name))
774 (tmp-name3 (tramp--test-make-temp-name))
775 (tmp-name4 (tramp--test-make-temp-name 'local))
776 (tmp-name5 (tramp--test-make-temp-name 'local)))
777
778 ;; Rename on remote side.
779 (unwind-protect
780 (progn
781 (write-region "foo" nil tmp-name1)
782 (rename-file tmp-name1 tmp-name2)
783 (should-not (file-exists-p tmp-name1))
784 (should (file-exists-p tmp-name2))
785 (with-temp-buffer
786 (insert-file-contents tmp-name2)
787 (should (string-equal (buffer-string) "foo")))
788 (write-region "foo" nil tmp-name1)
789 (should-error (rename-file tmp-name1 tmp-name2))
790 (rename-file tmp-name1 tmp-name2 'ok)
791 (should-not (file-exists-p tmp-name1))
792 (write-region "foo" nil tmp-name1)
793 (make-directory tmp-name3)
794 (rename-file tmp-name1 tmp-name3)
795 (should-not (file-exists-p tmp-name1))
796 (should
797 (file-exists-p
798 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
799
800 ;; Cleanup.
801 (ignore-errors (delete-file tmp-name1))
802 (ignore-errors (delete-file tmp-name2))
803 (ignore-errors (delete-directory tmp-name3 'recursive)))
804
805 ;; Rename from remote side to local side.
806 (unwind-protect
807 (progn
808 (write-region "foo" nil tmp-name1)
809 (rename-file tmp-name1 tmp-name4)
810 (should-not (file-exists-p tmp-name1))
811 (should (file-exists-p tmp-name4))
812 (with-temp-buffer
813 (insert-file-contents tmp-name4)
814 (should (string-equal (buffer-string) "foo")))
815 (write-region "foo" nil tmp-name1)
816 (should-error (rename-file tmp-name1 tmp-name4))
817 (rename-file tmp-name1 tmp-name4 'ok)
818 (should-not (file-exists-p tmp-name1))
819 (write-region "foo" nil tmp-name1)
820 (make-directory tmp-name5)
821 (rename-file tmp-name1 tmp-name5)
822 (should-not (file-exists-p tmp-name1))
823 (should
824 (file-exists-p
825 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
826
827 ;; Cleanup.
828 (ignore-errors (delete-file tmp-name1))
829 (ignore-errors (delete-file tmp-name4))
830 (ignore-errors (delete-directory tmp-name5 'recursive)))
831
832 ;; Rename from local side to remote side.
833 (unwind-protect
834 (progn
835 (write-region "foo" nil tmp-name4 nil 'nomessage)
836 (rename-file tmp-name4 tmp-name1)
837 (should-not (file-exists-p tmp-name4))
838 (should (file-exists-p tmp-name1))
839 (with-temp-buffer
840 (insert-file-contents tmp-name1)
841 (should (string-equal (buffer-string) "foo")))
842 (write-region "foo" nil tmp-name4 nil 'nomessage)
843 (should-error (rename-file tmp-name4 tmp-name1))
844 (rename-file tmp-name4 tmp-name1 'ok)
845 (should-not (file-exists-p tmp-name4))
846 (write-region "foo" nil tmp-name4 nil 'nomessage)
847 (make-directory tmp-name3)
848 (rename-file tmp-name4 tmp-name3)
849 (should-not (file-exists-p tmp-name4))
850 (should
851 (file-exists-p
852 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
853
854 ;; Cleanup.
855 (ignore-errors (delete-file tmp-name1))
856 (ignore-errors (delete-file tmp-name4))
857 (ignore-errors (delete-directory tmp-name3 'recursive)))))
858
859 (ert-deftest tramp-test13-make-directory ()
860 "Check `make-directory'.
861 This tests also `file-directory-p' and `file-accessible-directory-p'."
862 (skip-unless (tramp--test-enabled))
863
864 (let* ((tmp-name1 (tramp--test-make-temp-name))
865 (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
866 (unwind-protect
867 (progn
868 (make-directory tmp-name1)
869 (should (file-directory-p tmp-name1))
870 (should (file-accessible-directory-p tmp-name1))
871 (should-error (make-directory tmp-name2) :type 'file-error)
872 (make-directory tmp-name2 'parents)
873 (should (file-directory-p tmp-name2))
874 (should (file-accessible-directory-p tmp-name2)))
875
876 ;; Cleanup.
877 (ignore-errors (delete-directory tmp-name1 'recursive)))))
878
879 (ert-deftest tramp-test14-delete-directory ()
880 "Check `delete-directory'."
881 (skip-unless (tramp--test-enabled))
882
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))))
895
896 (ert-deftest tramp-test15-copy-directory ()
897 "Check `copy-directory'."
898 (skip-unless (tramp--test-enabled))
899 (skip-unless
900 (not
901 (eq
902 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
903 'tramp-smb-file-name-handler)))
904
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)))
926
927 ;; Cleanup.
928 (ignore-errors
929 (delete-directory tmp-name1 'recursive)
930 (delete-directory tmp-name2 'recursive)))))
931
932 (ert-deftest tramp-test16-directory-files ()
933 "Check `directory-files'."
934 (skip-unless (tramp--test-enabled))
935
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))))
958
959 ;; Cleanup.
960 (ignore-errors (delete-directory tmp-name1 'recursive)))))
961
962 (ert-deftest tramp-test17-insert-directory ()
963 "Check `insert-directory'."
964 (skip-unless (tramp--test-enabled))
965
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\\}")))))
1001
1002 ;; Cleanup.
1003 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1004
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))
1009
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.
1040
1041 (setq attr (file-attributes tmp-name1 'string))
1042 (should (stringp (nth 2 attr))) ;; Uid.
1043 (should (stringp (nth 3 attr))) ;; Gid.
1044
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)
1059
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)))
1066
1067 ;; Cleanup.
1068 (ignore-errors (delete-directory tmp-name1)))))
1069
1070 (ert-deftest tramp-test19-directory-files-and-attributes ()
1071 "Check `directory-files-and-attributes'."
1072 (skip-unless (tramp--test-enabled))
1073
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"))))
1109
1110 ;; Cleanup.
1111 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1112
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))))
1124
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))))
1140
1141 ;; Cleanup.
1142 (ignore-errors (delete-file tmp-name)))))
1143
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))
1148
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)))
1176
1177 ;; Cleanup.
1178 (ignore-errors
1179 (delete-file tmp-name1)
1180 (delete-file tmp-name2)))
1181
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)))
1193
1194 ;; Cleanup.
1195 (ignore-errors
1196 (delete-file tmp-name1)
1197 (delete-file tmp-name2)))
1198
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)))
1212
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)))))))
1219
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))))
1228
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))))
1252
1253 ;; Cleanup.
1254 (ignore-errors
1255 (delete-file tmp-name1)
1256 (delete-file tmp-name2)))))
1257
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))
1261
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)))))
1273
1274 ;; Cleanup.
1275 (ignore-errors (delete-file tmp-name)))))
1276
1277 (ert-deftest tramp-test24-file-name-completion ()
1278 "Check `file-name-completion' and `file-name-all-completions'."
1279 (skip-unless (tramp--test-enabled))
1280
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/"))))
1297
1298 ;; Cleanup.
1299 (ignore-errors (delete-directory tmp-name 'recursive)))))
1300
1301 (ert-deftest tramp-test25-load ()
1302 "Check `load'."
1303 (skip-unless (tramp--test-enabled))
1304
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)))
1315
1316 ;; Cleanup.
1317 (ignore-errors
1318 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1319 (delete-file tmp-name)))))
1320
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))))
1329
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))
1351
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))))
1362
1363 ;; Cleanup.
1364 (ignore-errors (delete-file tmp-name)))))
1365
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))))
1376
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")))
1392
1393 ;; Cleanup.
1394 (ignore-errors (delete-process proc)))
1395
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")))
1410
1411 ;; Cleanup.
1412 (ignore-errors
1413 (delete-process proc)
1414 (delete-file tmp-name)))
1415
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")))
1431
1432 ;; Cleanup.
1433 (ignore-errors (delete-process proc)))))
1434
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))))
1445
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))))
1462
1463 ;; Cleanup.
1464 (ignore-errors (delete-file tmp-name)))
1465
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))))
1489
1490 ;; Cleanup.
1491 (ignore-errors (delete-file tmp-name)))
1492
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))))
1518
1519 ;; Cleanup.
1520 (ignore-errors (delete-file tmp-name)))))
1521
1522 (ert-deftest tramp-test29-vc-registered ()
1523 "Check `vc-registered'."
1524 (skip-unless (tramp--test-enabled))
1525 (skip-unless
1526 (eq
1527 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1528 'tramp-sh-file-name-handler))
1529
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)
1554
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))
1563
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)))
1579
1580 ;; Cleanup.
1581 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1582
1583 (ert-deftest tramp-test30-make-auto-save-file-name ()
1584 "Check `make-auto-save-file-name'."
1585 (skip-unless (tramp--test-enabled))
1586
1587 (let ((tmp-name1 (tramp--test-make-temp-name))
1588 (tmp-name2 (tramp--test-make-temp-name)))
1589
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)))))
1606
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)))))
1617
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))))
1639
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)))))
1662
1663 ;; Cleanup.
1664 (ignore-errors (delete-file tmp-name1))
1665 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1666
1667 (defun tramp--test-adb-p ()
1668 "Check, whether the remote host runs Android.
1669 This requires restrictions of file name syntax."
1670 (tramp-adb-file-name-p tramp-test-temporary-file-directory))
1671
1672 (defun tramp--test-ftp-p ()
1673 "Check, whether an FTP-like method is used.
1674 This does not support globbing characters in file names (yet)."
1675 ;; Globbing characters are ??, ?* and ?\[.
1676 (and (eq (tramp-find-foreign-file-name-handler
1677 tramp-test-temporary-file-directory)
1678 'tramp-sh-file-name-handler)
1679 (string-match
1680 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))))
1681
1682 (defun tramp--test-gvfs-p ()
1683 "Check, whether the remote host runs a GVFS based method.
1684 This requires restrictions of file name syntax."
1685 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
1686
1687 (defun tramp--test-smb-or-windows-nt-p ()
1688 "Check, whether the locale or remote host runs MS Windows.
1689 This requires restrictions of file name syntax."
1690 (or (eq system-type 'windows-nt)
1691 (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
1692
1693 (defun tramp--test-check-files (&rest files)
1694 "Run a simple but comprehensive test over every file in FILES."
1695 ;; We must use `file-truename' for the temporary directory, because
1696 ;; it could be located on a symlinked directory. This would let the
1697 ;; test fail.
1698 (let* ((tramp-test-temporary-file-directory
1699 (file-truename tramp-test-temporary-file-directory))
1700 (tmp-name1 (tramp--test-make-temp-name))
1701 (tmp-name2 (tramp--test-make-temp-name 'local))
1702 (files (delq nil files)))
1703 (unwind-protect
1704 (progn
1705 (make-directory tmp-name1)
1706 (make-directory tmp-name2)
1707 (dolist (elt files)
1708 (let* ((file1 (expand-file-name elt tmp-name1))
1709 (file2 (expand-file-name elt tmp-name2))
1710 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
1711 (write-region elt nil file1)
1712 (should (file-exists-p file1))
1713
1714 ;; Check file contents.
1715 (with-temp-buffer
1716 (insert-file-contents file1)
1717 (should (string-equal (buffer-string) elt)))
1718
1719 ;; Copy file both directions.
1720 (copy-file file1 tmp-name2)
1721 (should (file-exists-p file2))
1722 (delete-file file1)
1723 (should-not (file-exists-p file1))
1724 (copy-file file2 tmp-name1)
1725 (should (file-exists-p file1))
1726
1727 ;; Method "smb" supports `make-symbolic-link' only if the
1728 ;; remote host has CIFS capabilities. tramp-adb.el and
1729 ;; tramp-gvfs.el do not support symbolic links at all.
1730 (condition-case err
1731 (progn
1732 (make-symbolic-link file1 file3)
1733 (should (file-symlink-p file3))
1734 (should
1735 (string-equal
1736 (expand-file-name file1) (file-truename file3)))
1737 (should
1738 (string-equal
1739 (car (file-attributes file3))
1740 (file-remote-p (file-truename file1) 'localname)))
1741 ;; Check file contents.
1742 (with-temp-buffer
1743 (insert-file-contents file3)
1744 (should (string-equal (buffer-string) elt)))
1745 (delete-file file3))
1746 (file-error
1747 (should (string-equal (error-message-string err)
1748 "make-symbolic-link not supported"))))))
1749
1750 ;; Check file names.
1751 (should (equal (directory-files
1752 tmp-name1 nil directory-files-no-dot-files-regexp)
1753 (sort (copy-sequence files) 'string-lessp)))
1754 (should (equal (directory-files
1755 tmp-name2 nil directory-files-no-dot-files-regexp)
1756 (sort (copy-sequence files) 'string-lessp)))
1757
1758 ;; `substitute-in-file-name' could return different values.
1759 ;; For `adb', there could be strange file permissions
1760 ;; preventing overwriting a file. We don't care in this
1761 ;; testcase.
1762 (dolist (elt files)
1763 (let ((file1
1764 (substitute-in-file-name (expand-file-name elt tmp-name1)))
1765 (file2
1766 (substitute-in-file-name (expand-file-name elt tmp-name2))))
1767 (ignore-errors (write-region elt nil file1))
1768 (should (file-exists-p file1))
1769 (ignore-errors (write-region elt nil file2 nil 'nomessage))
1770 (should (file-exists-p file2))))
1771
1772 (should (equal (directory-files
1773 tmp-name1 nil directory-files-no-dot-files-regexp)
1774 (directory-files
1775 tmp-name2 nil directory-files-no-dot-files-regexp)))
1776
1777 ;; Check directory creation. We use a subdirectory "foo"
1778 ;; in order to avoid conflicts with previous file name tests.
1779 (dolist (elt files)
1780 (let* ((elt1 (concat elt "foo"))
1781 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1782 (file2 (expand-file-name elt file1))
1783 (file3 (expand-file-name elt1 file1)))
1784 (make-directory file1 'parents)
1785 (should (file-directory-p file1))
1786 (write-region elt nil file2)
1787 (should (file-exists-p file2))
1788 (should
1789 (equal
1790 (directory-files file1 nil directory-files-no-dot-files-regexp)
1791 `(,elt)))
1792 (should
1793 (equal
1794 (caar (directory-files-and-attributes
1795 file1 nil directory-files-no-dot-files-regexp))
1796 elt))
1797
1798 ;; Check symlink in `directory-files-and-attributes'.
1799 (condition-case err
1800 (progn
1801 (make-symbolic-link file2 file3)
1802 (should (file-symlink-p file3))
1803 (should
1804 (string-equal
1805 (caar (directory-files-and-attributes
1806 file1 nil (regexp-quote elt1)))
1807 elt1))
1808 (should
1809 (string-equal
1810 (cadr (car (directory-files-and-attributes
1811 file1 nil (regexp-quote elt1))))
1812 (file-remote-p (file-truename file2) 'localname)))
1813 (delete-file file3)
1814 (should-not (file-exists-p file3)))
1815 (file-error
1816 (should (string-equal (error-message-string err)
1817 "make-symbolic-link not supported"))))
1818
1819 (delete-file file2)
1820 (should-not (file-exists-p file2))
1821 (delete-directory file1)
1822 (should-not (file-exists-p file1)))))
1823
1824 ;; Cleanup.
1825 (ignore-errors (delete-directory tmp-name1 'recursive))
1826 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1827
1828 (defun tramp--test-special-characters ()
1829 "Perform the test in `tramp-test31-special-characters*'."
1830 ;; Newlines, slashes and backslashes in file names are not
1831 ;; supported. So we don't test. And we don't test the tab
1832 ;; character on Windows or Cygwin, because the backslash is
1833 ;; interpreted as a path separator, preventing "\t" from being
1834 ;; expanded to <TAB>.
1835 (tramp--test-check-files
1836 (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
1837 "foo bar baz"
1838 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1839 " foo bar baz "
1840 " foo\tbar baz\t"))
1841 "$foo$bar$$baz$"
1842 "-foo-bar-baz-"
1843 "%foo%bar%baz%"
1844 "&foo&bar&baz&"
1845 (unless (or (tramp--test-ftp-p)
1846 (tramp--test-gvfs-p)
1847 (tramp--test-smb-or-windows-nt-p))
1848 "?foo?bar?baz?")
1849 (unless (or (tramp--test-ftp-p)
1850 (tramp--test-gvfs-p)
1851 (tramp--test-smb-or-windows-nt-p))
1852 "*foo*bar*baz*")
1853 (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
1854 "'foo'bar'baz'"
1855 "'foo\"bar'baz\"")
1856 "#foo~bar#baz~"
1857 (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
1858 "!foo!bar!baz!"
1859 "!foo|bar!baz|")
1860 (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
1861 ";foo;bar;baz;"
1862 ":foo;bar:baz;")
1863 (unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
1864 "<foo>bar<baz>")
1865 "(foo)bar(baz)"
1866 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
1867 "{foo}bar{baz}"))
1868
1869 ;; These tests are inspired by Bug#17238.
1870 (ert-deftest tramp-test31-special-characters ()
1871 "Check special characters in file names."
1872 (skip-unless (tramp--test-enabled))
1873
1874 (tramp--test-special-characters))
1875
1876 (ert-deftest tramp-test31-special-characters-with-stat ()
1877 "Check special characters in file names.
1878 Use the `stat' command."
1879 (skip-unless (tramp--test-enabled))
1880 (skip-unless
1881 (eq
1882 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1883 'tramp-sh-file-name-handler))
1884 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1885 (skip-unless (tramp-get-remote-stat v)))
1886
1887 (unwind-protect
1888 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1889 (tramp-set-connection-property v "perl" nil)
1890 (tramp--test-special-characters))
1891
1892 ;; Reset suppressed properties.
1893 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1894 (tramp-set-connection-property v "perl" 'undef))))
1895
1896 (ert-deftest tramp-test31-special-characters-with-perl ()
1897 "Check special characters in file names.
1898 Use the `perl' command."
1899 (skip-unless (tramp--test-enabled))
1900 (skip-unless
1901 (eq
1902 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1903 'tramp-sh-file-name-handler))
1904 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1905 (skip-unless (tramp-get-remote-perl v)))
1906
1907 (unwind-protect
1908 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1909 (tramp-set-connection-property v "stat" nil)
1910 (tramp--test-special-characters))
1911
1912 ;; Reset suppressed properties.
1913 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1914 (tramp-set-connection-property v "stat" 'undef))))
1915
1916 (ert-deftest tramp-test31-special-characters-with-ls ()
1917 "Check special characters in file names.
1918 Use the `ls' command."
1919 (skip-unless (tramp--test-enabled))
1920 (skip-unless
1921 (eq
1922 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1923 'tramp-sh-file-name-handler))
1924
1925 (unwind-protect
1926 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1927 (tramp-set-connection-property v "stat" nil)
1928 (tramp-set-connection-property v "perl" nil)
1929 (tramp--test-special-characters))
1930
1931 ;; Reset suppressed properties.
1932 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1933 (tramp-set-connection-property v "stat" 'undef)
1934 (tramp-set-connection-property v "perl" 'undef))))
1935
1936 (defun tramp--test-utf8 ()
1937 "Perform the test in `tramp-test32-utf8*'."
1938 (let ((coding-system-for-read 'utf-8)
1939 (coding-system-for-write 'utf-8)
1940 (file-name-coding-system 'utf-8))
1941 (tramp--test-check-files
1942 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1943 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1944 "银河系漫游指南系列"
1945 "Автостопом по гала́ктике")))
1946
1947 (ert-deftest tramp-test32-utf8 ()
1948 "Check UTF8 encoding in file names and file contents."
1949 (skip-unless (tramp--test-enabled))
1950
1951 (tramp--test-utf8))
1952
1953 (ert-deftest tramp-test32-utf8-with-stat ()
1954 "Check UTF8 encoding in file names and file contents.
1955 Use the `stat' command."
1956 (skip-unless (tramp--test-enabled))
1957 (skip-unless
1958 (eq
1959 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1960 'tramp-sh-file-name-handler))
1961 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1962 (skip-unless (tramp-get-remote-stat v)))
1963
1964 (unwind-protect
1965 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1966 (tramp-set-connection-property v "perl" nil)
1967 (tramp--test-utf8))
1968
1969 ;; Reset suppressed properties.
1970 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1971 (tramp-set-connection-property v "perl" 'undef))))
1972
1973 (ert-deftest tramp-test32-utf8-with-perl ()
1974 "Check UTF8 encoding in file names and file contents.
1975 Use the `perl' command."
1976 (skip-unless (tramp--test-enabled))
1977 (skip-unless
1978 (eq
1979 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1980 'tramp-sh-file-name-handler))
1981 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1982 (skip-unless (tramp-get-remote-perl v)))
1983
1984 (unwind-protect
1985 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1986 (tramp-set-connection-property v "stat" nil)
1987 (tramp--test-utf8))
1988
1989 ;; Reset suppressed properties.
1990 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1991 (tramp-set-connection-property v "stat" 'undef))))
1992
1993 (ert-deftest tramp-test32-utf8-with-ls ()
1994 "Check UTF8 encoding in file names and file contents.
1995 Use the `ls' command."
1996 (skip-unless (tramp--test-enabled))
1997 (skip-unless
1998 (eq
1999 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
2000 'tramp-sh-file-name-handler))
2001
2002 (unwind-protect
2003 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2004 (tramp-set-connection-property v "stat" nil)
2005 (tramp-set-connection-property v "perl" nil)
2006 (tramp--test-utf8))
2007
2008 ;; Reset suppressed properties.
2009 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2010 (tramp-set-connection-property v "stat" 'undef)
2011 (tramp-set-connection-property v "perl" 'undef))))
2012
2013 ;; This test is inspired by Bug#16928.
2014 (ert-deftest tramp-test33-asynchronous-requests ()
2015 "Check parallel asynchronous requests.
2016 Such requests could arrive from timers, process filters and
2017 process sentinels. They shall not disturb each other."
2018 ;; Mark as failed until bug has been fixed.
2019 :expected-result :failed
2020 (skip-unless (tramp--test-enabled))
2021 (skip-unless
2022 (eq
2023 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
2024 'tramp-sh-file-name-handler))
2025
2026 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
2027 ;; has the side effect, that this test fails instead to abort. Good
2028 ;; for hydra.
2029 (tramp--instrument-test-case 0
2030 (let* ((tmp-name (tramp--test-make-temp-name))
2031 (default-directory tmp-name)
2032 (remote-file-name-inhibit-cache t)
2033 timer buffers kill-buffer-query-functions)
2034
2035 (unwind-protect
2036 (progn
2037 (make-directory tmp-name)
2038
2039 ;; Setup a timer in order to raise an ordinary command again
2040 ;; and again. `vc-registered' is well suited, because there
2041 ;; are many checks.
2042 (setq
2043 timer
2044 (run-at-time
2045 0 1
2046 (lambda ()
2047 (when buffers
2048 (vc-registered
2049 (buffer-name (nth (random (length buffers)) buffers)))))))
2050
2051 ;; Create temporary buffers. The number of buffers
2052 ;; corresponds to the number of processes; it could be
2053 ;; increased in order to make pressure on Tramp.
2054 (dotimes (i 5)
2055 (add-to-list 'buffers (generate-new-buffer "*temp*")))
2056
2057 ;; Open asynchronous processes. Set process sentinel.
2058 (dolist (buf buffers)
2059 (async-shell-command "read line; touch $line; echo $line" buf)
2060 (set-process-sentinel
2061 (get-buffer-process buf)
2062 (lambda (proc _state)
2063 (delete-file (buffer-name (process-buffer proc))))))
2064
2065 ;; Send a string. Use a random order of the buffers. Mix
2066 ;; with regular operation.
2067 (let ((buffers (copy-sequence buffers))
2068 buf)
2069 (while buffers
2070 (setq buf (nth (random (length buffers)) buffers))
2071 (process-send-string
2072 (get-buffer-process buf) (format "'%s'\n" buf))
2073 (file-attributes (buffer-name buf))
2074 (setq buffers (delq buf buffers))))
2075
2076 ;; Wait until the whole output has been read.
2077 (with-timeout ((* 10 (length buffers))
2078 (ert-fail "`async-shell-command' timed out"))
2079 (let ((buffers (copy-sequence buffers))
2080 buf)
2081 (while buffers
2082 (setq buf (nth (random (length buffers)) buffers))
2083 (if (ignore-errors
2084 (memq (process-status (get-buffer-process buf))
2085 '(run open)))
2086 (accept-process-output (get-buffer-process buf) 0.1)
2087 (setq buffers (delq buf buffers))))))
2088
2089 ;; Check.
2090 (dolist (buf buffers)
2091 (with-current-buffer buf
2092 (should
2093 (string-equal (format "'%s'\n" buf) (buffer-string)))))
2094 (should-not
2095 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
2096
2097 ;; Cleanup.
2098 (ignore-errors (cancel-timer timer))
2099 (ignore-errors (delete-directory tmp-name 'recursive))
2100 (dolist (buf buffers)
2101 (ignore-errors (kill-buffer buf)))))))
2102
2103 (ert-deftest tramp-test34-recursive-load ()
2104 "Check that Tramp does not fail due to recursive load."
2105 (skip-unless (tramp--test-enabled))
2106
2107 (dolist (code
2108 (list
2109 (format
2110 "(expand-file-name %S)"
2111 tramp-test-temporary-file-directory)
2112 (format
2113 "(let ((default-directory %S)) (expand-file-name %S))"
2114 tramp-test-temporary-file-directory
2115 temporary-file-directory)))
2116 (should-not
2117 (string-match
2118 "Recursive load"
2119 (shell-command-to-string
2120 (format
2121 "%s -batch -Q -L %s --eval %s"
2122 (expand-file-name invocation-name invocation-directory)
2123 (mapconcat 'shell-quote-argument load-path " -L ")
2124 (shell-quote-argument code)))))))
2125
2126 (ert-deftest tramp-test35-unload ()
2127 "Check that Tramp and its subpackages unload completely.
2128 Since it unloads Tramp, it shall be the last test to run."
2129 ;; Mark as failed until all symbols are unbound.
2130 :expected-result (if (featurep 'tramp) :failed :passed)
2131 (when (featurep 'tramp)
2132 (unload-feature 'tramp 'force)
2133 ;; No Tramp feature must be left.
2134 (should-not (featurep 'tramp))
2135 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
2136 ;; `file-name-handler-alist' must be clean.
2137 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
2138 ;; There shouldn't be left a bound symbol. We do not regard our
2139 ;; test symbols, and the Tramp unload hooks.
2140 (mapatoms
2141 (lambda (x)
2142 (and (or (boundp x) (functionp x))
2143 (string-match "^tramp" (symbol-name x))
2144 (not (string-match "^tramp--?test" (symbol-name x)))
2145 (not (string-match "unload-hook$" (symbol-name x)))
2146 (ert-fail (format "`%s' still bound" x)))))
2147 ;; There shouldn't be left a hook function containing a Tramp
2148 ;; function. We do not regard the Tramp unload hooks.
2149 (mapatoms
2150 (lambda (x)
2151 (and (boundp x)
2152 (string-match "-hooks?$" (symbol-name x))
2153 (not (string-match "unload-hook$" (symbol-name x)))
2154 (consp (symbol-value x))
2155 (ignore-errors (all-completions "tramp" (symbol-value x)))
2156 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
2157
2158 ;; TODO:
2159
2160 ;; * dired-compress-file
2161 ;; * dired-uncache
2162 ;; * file-acl
2163 ;; * file-ownership-preserved-p
2164 ;; * file-selinux-context
2165 ;; * find-backup-file-name
2166 ;; * set-file-acl
2167 ;; * set-file-selinux-context
2168
2169 ;; * Work on skipped tests. Make a comment, when it is impossible.
2170 ;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe
2171 ;; doesn't work well when an interactive password must be provided.
2172 ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
2173 ;; Windows (`process-send-eof'?).
2174 ;; * Fix `tramp-test31-special-characters' for `nc'.
2175 ;; * Fix `tramp-test32-utf8' for `nc'/`telnet' (when target is a dumb
2176 ;; busybox). Seems to be in `directory-files'.
2177 ;; * Fix Bug#16928. Set expected error of `tramp-test33-asynchronous-requests'.
2178 ;; * Fix `tramp-test35-unload' (Not all symbols are unbound). Set
2179 ;; expected error.
2180
2181 (defun tramp-test-all (&optional interactive)
2182 "Run all tests for \\[tramp]."
2183 (interactive "p")
2184 (funcall
2185 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
2186
2187 (provide 'tramp-tests)
2188 ;;; tramp-tests.el ends here