]> code.delx.au - gnu-emacs/blob - test/automated/tramp-tests.el
Merge branch 'master' into cairo
[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 (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))))))))
129
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)))))
139
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:"))
151
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:"))
157
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:"))
163
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]:"))
170
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"))
176
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:"))
184
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"))))
198
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) ""))
212
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) ""))
221
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) ""))
230
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) ""))
240
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) ""))
249
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) ""))
259
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) ""))
269
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) ""))
282
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) ""))
292
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) ""))
302
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) ""))
314
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) ""))
327
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) ""))
336
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) ""))
346
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) ""))
356
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) ""))
368
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) ""))
379
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) "")))
389
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) ""))
398
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) ""))
408
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) ""))
418
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) ""))
429
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"))
438
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"))
464
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"))))
494
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)))
522
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"))))
550
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")))
559
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")))
594
595 (ert-deftest tramp-test07-file-exists-p ()
596 "Check `file-exist-p', `write-region' and `delete-file'."
597 (skip-unless (tramp--test-enabled))
598
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))))
605
606 (ert-deftest tramp-test08-file-local-copy ()
607 "Check `file-local-copy'."
608 (skip-unless (tramp--test-enabled))
609
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)))))
625 (ignore-errors
626 (delete-file tmp-name1)
627 (delete-file tmp-name2)))))
628
629 (ert-deftest tramp-test09-insert-file-contents ()
630 "Check `insert-file-contents'."
631 (skip-unless (tramp--test-enabled))
632
633 (let ((tmp-name (tramp--test-make-temp-name)))
634 (unwind-protect
635 (progn
636 (write-region "foo" nil tmp-name)
637 (with-temp-buffer
638 (insert-file-contents tmp-name)
639 (should (string-equal (buffer-string) "foo"))
640 (insert-file-contents tmp-name)
641 (should (string-equal (buffer-string) "foofoo"))
642 ;; Insert partly.
643 (insert-file-contents tmp-name nil 1 3)
644 (should (string-equal (buffer-string) "oofoofoo"))
645 ;; Replace.
646 (insert-file-contents tmp-name nil nil nil 'replace)
647 (should (string-equal (buffer-string) "foo"))))
648 (ignore-errors (delete-file tmp-name)))))
649
650 (ert-deftest tramp-test10-write-region ()
651 "Check `write-region'."
652 (skip-unless (tramp--test-enabled))
653
654 (let ((tmp-name (tramp--test-make-temp-name)))
655 (unwind-protect
656 (progn
657 (with-temp-buffer
658 (insert "foo")
659 (write-region nil nil tmp-name))
660 (with-temp-buffer
661 (insert-file-contents tmp-name)
662 (should (string-equal (buffer-string) "foo")))
663 ;; Append.
664 (with-temp-buffer
665 (insert "bla")
666 (write-region nil nil tmp-name 'append))
667 (with-temp-buffer
668 (insert-file-contents tmp-name)
669 (should (string-equal (buffer-string) "foobla")))
670 ;; Write string.
671 (write-region "foo" nil tmp-name)
672 (with-temp-buffer
673 (insert-file-contents tmp-name)
674 (should (string-equal (buffer-string) "foo")))
675 ;; Write partly.
676 (with-temp-buffer
677 (insert "123456789")
678 (write-region 3 5 tmp-name))
679 (with-temp-buffer
680 (insert-file-contents tmp-name)
681 (should (string-equal (buffer-string) "34"))))
682 (ignore-errors (delete-file tmp-name)))))
683
684 (ert-deftest tramp-test11-copy-file ()
685 "Check `copy-file'."
686 (skip-unless (tramp--test-enabled))
687
688 (let ((tmp-name1 (tramp--test-make-temp-name))
689 (tmp-name2 (tramp--test-make-temp-name))
690 (tmp-name3 (tramp--test-make-temp-name))
691 (tmp-name4 (tramp--test-make-temp-name 'local))
692 (tmp-name5 (tramp--test-make-temp-name 'local)))
693
694 ;; Copy on remote side.
695 (unwind-protect
696 (progn
697 (write-region "foo" nil tmp-name1)
698 (copy-file tmp-name1 tmp-name2)
699 (should (file-exists-p tmp-name2))
700 (with-temp-buffer
701 (insert-file-contents tmp-name2)
702 (should (string-equal (buffer-string) "foo")))
703 (should-error (copy-file tmp-name1 tmp-name2))
704 (copy-file tmp-name1 tmp-name2 'ok)
705 (make-directory tmp-name3)
706 (copy-file tmp-name1 tmp-name3)
707 (should
708 (file-exists-p
709 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
710 (ignore-errors (delete-file tmp-name1))
711 (ignore-errors (delete-file tmp-name2))
712 (ignore-errors (delete-directory tmp-name3 'recursive)))
713
714 ;; Copy from remote side to local side.
715 (unwind-protect
716 (progn
717 (write-region "foo" nil tmp-name1)
718 (copy-file tmp-name1 tmp-name4)
719 (should (file-exists-p tmp-name4))
720 (with-temp-buffer
721 (insert-file-contents tmp-name4)
722 (should (string-equal (buffer-string) "foo")))
723 (should-error (copy-file tmp-name1 tmp-name4))
724 (copy-file tmp-name1 tmp-name4 'ok)
725 (make-directory tmp-name5)
726 (copy-file tmp-name1 tmp-name5)
727 (should
728 (file-exists-p
729 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
730 (ignore-errors (delete-file tmp-name1))
731 (ignore-errors (delete-file tmp-name4))
732 (ignore-errors (delete-directory tmp-name5 'recursive)))
733
734 ;; Copy from local side to remote side.
735 (unwind-protect
736 (progn
737 (write-region "foo" nil tmp-name4 nil 'nomessage)
738 (copy-file tmp-name4 tmp-name1)
739 (should (file-exists-p tmp-name1))
740 (with-temp-buffer
741 (insert-file-contents tmp-name1)
742 (should (string-equal (buffer-string) "foo")))
743 (should-error (copy-file tmp-name4 tmp-name1))
744 (copy-file tmp-name4 tmp-name1 'ok)
745 (make-directory tmp-name3)
746 (copy-file tmp-name4 tmp-name3)
747 (should
748 (file-exists-p
749 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
750 (ignore-errors (delete-file tmp-name1))
751 (ignore-errors (delete-file tmp-name4))
752 (ignore-errors (delete-directory tmp-name3 'recursive)))))
753
754 (ert-deftest tramp-test12-rename-file ()
755 "Check `rename-file'."
756 (skip-unless (tramp--test-enabled))
757
758 (let ((tmp-name1 (tramp--test-make-temp-name))
759 (tmp-name2 (tramp--test-make-temp-name))
760 (tmp-name3 (tramp--test-make-temp-name))
761 (tmp-name4 (tramp--test-make-temp-name 'local))
762 (tmp-name5 (tramp--test-make-temp-name 'local)))
763
764 ;; Rename on remote side.
765 (unwind-protect
766 (progn
767 (write-region "foo" nil tmp-name1)
768 (rename-file tmp-name1 tmp-name2)
769 (should-not (file-exists-p tmp-name1))
770 (should (file-exists-p tmp-name2))
771 (with-temp-buffer
772 (insert-file-contents tmp-name2)
773 (should (string-equal (buffer-string) "foo")))
774 (write-region "foo" nil tmp-name1)
775 (should-error (rename-file tmp-name1 tmp-name2))
776 (rename-file tmp-name1 tmp-name2 'ok)
777 (should-not (file-exists-p tmp-name1))
778 (write-region "foo" nil tmp-name1)
779 (make-directory tmp-name3)
780 (rename-file tmp-name1 tmp-name3)
781 (should-not (file-exists-p tmp-name1))
782 (should
783 (file-exists-p
784 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
785 (ignore-errors (delete-file tmp-name1))
786 (ignore-errors (delete-file tmp-name2))
787 (ignore-errors (delete-directory tmp-name3 'recursive)))
788
789 ;; Rename from remote side to local side.
790 (unwind-protect
791 (progn
792 (write-region "foo" nil tmp-name1)
793 (rename-file tmp-name1 tmp-name4)
794 (should-not (file-exists-p tmp-name1))
795 (should (file-exists-p tmp-name4))
796 (with-temp-buffer
797 (insert-file-contents tmp-name4)
798 (should (string-equal (buffer-string) "foo")))
799 (write-region "foo" nil tmp-name1)
800 (should-error (rename-file tmp-name1 tmp-name4))
801 (rename-file tmp-name1 tmp-name4 'ok)
802 (should-not (file-exists-p tmp-name1))
803 (write-region "foo" nil tmp-name1)
804 (make-directory tmp-name5)
805 (rename-file tmp-name1 tmp-name5)
806 (should-not (file-exists-p tmp-name1))
807 (should
808 (file-exists-p
809 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
810 (ignore-errors (delete-file tmp-name1))
811 (ignore-errors (delete-file tmp-name4))
812 (ignore-errors (delete-directory tmp-name5 'recursive)))
813
814 ;; Rename from local side to remote side.
815 (unwind-protect
816 (progn
817 (write-region "foo" nil tmp-name4 nil 'nomessage)
818 (rename-file tmp-name4 tmp-name1)
819 (should-not (file-exists-p tmp-name4))
820 (should (file-exists-p tmp-name1))
821 (with-temp-buffer
822 (insert-file-contents tmp-name1)
823 (should (string-equal (buffer-string) "foo")))
824 (write-region "foo" nil tmp-name4 nil 'nomessage)
825 (should-error (rename-file tmp-name4 tmp-name1))
826 (rename-file tmp-name4 tmp-name1 'ok)
827 (should-not (file-exists-p tmp-name4))
828 (write-region "foo" nil tmp-name4 nil 'nomessage)
829 (make-directory tmp-name3)
830 (rename-file tmp-name4 tmp-name3)
831 (should-not (file-exists-p tmp-name4))
832 (should
833 (file-exists-p
834 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
835 (ignore-errors (delete-file tmp-name1))
836 (ignore-errors (delete-file tmp-name4))
837 (ignore-errors (delete-directory tmp-name3 'recursive)))))
838
839 (ert-deftest tramp-test13-make-directory ()
840 "Check `make-directory'.
841 This tests also `file-directory-p' and `file-accessible-directory-p'."
842 (skip-unless (tramp--test-enabled))
843
844 (let ((tmp-name (tramp--test-make-temp-name)))
845 (unwind-protect
846 (progn
847 (make-directory tmp-name)
848 (should (file-directory-p tmp-name))
849 (should (file-accessible-directory-p tmp-name))
850 (should-error
851 (make-directory (expand-file-name "foo/bar" tmp-name))
852 :type 'file-error)
853 (make-directory (expand-file-name "foo/bar" tmp-name) 'parents)
854 (should (file-directory-p (expand-file-name "foo/bar" tmp-name)))
855 (should
856 (file-accessible-directory-p (expand-file-name "foo/bar" tmp-name))))
857 (ignore-errors (delete-directory tmp-name)))))
858
859 (ert-deftest tramp-test14-delete-directory ()
860 "Check `delete-directory'."
861 (skip-unless (tramp--test-enabled))
862
863 (let ((tmp-name (tramp--test-make-temp-name)))
864 ;; Delete empty directory.
865 (make-directory tmp-name)
866 (should (file-directory-p tmp-name))
867 (delete-directory tmp-name)
868 (should-not (file-directory-p tmp-name))
869 ;; Delete non-empty directory.
870 (make-directory tmp-name)
871 (write-region "foo" nil (expand-file-name "bla" tmp-name))
872 (should-error (delete-directory tmp-name) :type 'file-error)
873 (delete-directory tmp-name 'recursive)
874 (should-not (file-directory-p tmp-name))))
875
876 (ert-deftest tramp-test15-copy-directory ()
877 "Check `copy-directory'."
878 (skip-unless (tramp--test-enabled))
879 (skip-unless
880 (not
881 (eq
882 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
883 'tramp-smb-file-name-handler)))
884
885 (let* ((tmp-name1 (tramp--test-make-temp-name))
886 (tmp-name2 (tramp--test-make-temp-name))
887 (tmp-name3 (expand-file-name
888 (file-name-nondirectory tmp-name1) tmp-name2))
889 (tmp-name4 (expand-file-name "foo" tmp-name1))
890 (tmp-name5 (expand-file-name "foo" tmp-name2))
891 (tmp-name6 (expand-file-name "foo" tmp-name3)))
892 (unwind-protect
893 (progn
894 ;; Copy empty directory.
895 (make-directory tmp-name1)
896 (write-region "foo" nil tmp-name4)
897 (should (file-directory-p tmp-name1))
898 (should (file-exists-p tmp-name4))
899 (copy-directory tmp-name1 tmp-name2)
900 (should (file-directory-p tmp-name2))
901 (should (file-exists-p tmp-name5))
902 ;; Target directory does exist already.
903 (copy-directory tmp-name1 tmp-name2)
904 (should (file-directory-p tmp-name3))
905 (should (file-exists-p tmp-name6)))
906 (ignore-errors
907 (delete-directory tmp-name1 'recursive)
908 (delete-directory tmp-name2 'recursive)))))
909
910 (ert-deftest tramp-test16-directory-files ()
911 "Check `directory-files'."
912 (skip-unless (tramp--test-enabled))
913
914 (let* ((tmp-name1 (tramp--test-make-temp-name))
915 (tmp-name2 (expand-file-name "bla" tmp-name1))
916 (tmp-name3 (expand-file-name "foo" tmp-name1)))
917 (unwind-protect
918 (progn
919 (make-directory tmp-name1)
920 (write-region "foo" nil tmp-name2)
921 (write-region "bla" nil tmp-name3)
922 (should (file-directory-p tmp-name1))
923 (should (file-exists-p tmp-name2))
924 (should (file-exists-p tmp-name3))
925 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
926 (should (equal (directory-files tmp-name1 'full)
927 `(,(concat tmp-name1 "/.")
928 ,(concat tmp-name1 "/..")
929 ,tmp-name2 ,tmp-name3)))
930 (should (equal (directory-files
931 tmp-name1 nil directory-files-no-dot-files-regexp)
932 '("bla" "foo")))
933 (should (equal (directory-files
934 tmp-name1 'full directory-files-no-dot-files-regexp)
935 `(,tmp-name2 ,tmp-name3))))
936 (ignore-errors (delete-directory tmp-name1 'recursive)))))
937
938 (ert-deftest tramp-test17-insert-directory ()
939 "Check `insert-directory'."
940 (skip-unless (tramp--test-enabled))
941
942 (let* ((tmp-name1 (tramp--test-make-temp-name))
943 (tmp-name2 (expand-file-name "foo" tmp-name1))
944 ;; We test for the summary line. Keyword "total" could be localized.
945 (process-environment
946 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
947 (unwind-protect
948 (progn
949 (make-directory tmp-name1)
950 (write-region "foo" nil tmp-name2)
951 (should (file-directory-p tmp-name1))
952 (should (file-exists-p tmp-name2))
953 (with-temp-buffer
954 (insert-directory tmp-name1 nil)
955 (goto-char (point-min))
956 (should (looking-at-p (regexp-quote tmp-name1))))
957 (with-temp-buffer
958 (insert-directory tmp-name1 "-al")
959 (goto-char (point-min))
960 (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
961 (with-temp-buffer
962 (insert-directory (file-name-as-directory tmp-name1) "-al")
963 (goto-char (point-min))
964 (should
965 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
966 (with-temp-buffer
967 (insert-directory
968 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
969 (goto-char (point-min))
970 (should
971 (looking-at-p
972 (concat
973 ;; There might be a summary line.
974 "\\(total.+[[:digit:]]+\n\\)?"
975 ;; We don't know in which order ".", ".." and "foo" appear.
976 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
977 (ignore-errors (delete-directory tmp-name1 'recursive)))))
978
979 (ert-deftest tramp-test18-file-attributes ()
980 "Check `file-attributes'.
981 This tests also `file-readable-p' and `file-regular-p'."
982 (skip-unless (tramp--test-enabled))
983
984 (let ((tmp-name1 (tramp--test-make-temp-name))
985 (tmp-name2 (tramp--test-make-temp-name))
986 attr)
987 (unwind-protect
988 (progn
989 (write-region "foo" nil tmp-name1)
990 (should (file-exists-p tmp-name1))
991 (setq attr (file-attributes tmp-name1))
992 (should (consp attr))
993 (should (file-exists-p tmp-name1))
994 (should (file-readable-p tmp-name1))
995 (should (file-regular-p tmp-name1))
996 ;; We do not test inodes and device numbers.
997 (should (null (car attr)))
998 (should (numberp (nth 1 attr))) ;; Link.
999 (should (numberp (nth 2 attr))) ;; Uid.
1000 (should (numberp (nth 3 attr))) ;; Gid.
1001 ;; Last access time.
1002 (should (stringp (current-time-string (nth 4 attr))))
1003 ;; Last modification time.
1004 (should (stringp (current-time-string (nth 5 attr))))
1005 ;; Last status change time.
1006 (should (stringp (current-time-string (nth 6 attr))))
1007 (should (numberp (nth 7 attr))) ;; Size.
1008 (should (stringp (nth 8 attr))) ;; Modes.
1009
1010 (setq attr (file-attributes tmp-name1 'string))
1011 (should (stringp (nth 2 attr))) ;; Uid.
1012 (should (stringp (nth 3 attr))) ;; Gid.
1013
1014 (condition-case err
1015 (progn
1016 (make-symbolic-link tmp-name1 tmp-name2)
1017 (should (file-exists-p tmp-name2))
1018 (should (file-symlink-p tmp-name2))
1019 (setq attr (file-attributes tmp-name2))
1020 (should (string-equal
1021 (car attr)
1022 (file-remote-p (file-truename tmp-name1) 'localname)))
1023 (delete-file tmp-name2))
1024 (file-error
1025 (should (string-equal (error-message-string err)
1026 "make-symbolic-link not supported"))))
1027 (delete-file tmp-name1)
1028
1029 (make-directory tmp-name1)
1030 (should (file-exists-p tmp-name1))
1031 (should (file-readable-p tmp-name1))
1032 (should-not (file-regular-p tmp-name1))
1033 (setq attr (file-attributes tmp-name1))
1034 (should (eq (car attr) t)))
1035
1036 (ignore-errors (delete-directory tmp-name1)))))
1037
1038 (ert-deftest tramp-test19-directory-files-and-attributes ()
1039 "Check `directory-files-and-attributes'."
1040 (skip-unless (tramp--test-enabled))
1041
1042 ;; `directory-files-and-attributes' contains also values for "../".
1043 ;; Ensure that this doesn't change during tests, for
1044 ;; example due to handling temporary files.
1045 (let* ((tmp-name1 (tramp--test-make-temp-name))
1046 (tmp-name2 (expand-file-name "bla" tmp-name1))
1047 attr)
1048 (unwind-protect
1049 (progn
1050 (make-directory tmp-name1)
1051 (should (file-directory-p tmp-name1))
1052 (make-directory tmp-name2)
1053 (should (file-directory-p tmp-name2))
1054 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
1055 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
1056 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
1057 (setq attr (directory-files-and-attributes tmp-name2))
1058 (should (consp attr))
1059 ;; Dumb remote shells without perl(1) or stat(1) are not
1060 ;; able to return the date correctly. They say "don't know".
1061 (dolist (elt attr)
1062 (unless
1063 (equal
1064 (nth 5
1065 (file-attributes (expand-file-name (car elt) tmp-name2)))
1066 '(0 0))
1067 (should
1068 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
1069 (cdr elt)))))
1070 (setq attr (directory-files-and-attributes tmp-name2 'full))
1071 (dolist (elt attr)
1072 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
1073 (should
1074 (equal (file-attributes (car elt)) (cdr elt)))))
1075 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
1076 (should (equal (mapcar 'car attr) '("bar" "boz"))))
1077 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1078
1079 (ert-deftest tramp-test20-file-modes ()
1080 "Check `file-modes'.
1081 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1082 (skip-unless (tramp--test-enabled))
1083 (skip-unless
1084 (not
1085 (memq
1086 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1087 '(tramp-adb-file-name-handler
1088 tramp-gvfs-file-name-handler
1089 tramp-smb-file-name-handler))))
1090
1091 (let ((tmp-name (tramp--test-make-temp-name)))
1092 (unwind-protect
1093 (progn
1094 (write-region "foo" nil tmp-name)
1095 (should (file-exists-p tmp-name))
1096 (set-file-modes tmp-name #o777)
1097 (should (= (file-modes tmp-name) #o777))
1098 (should (file-executable-p tmp-name))
1099 (should (file-writable-p tmp-name))
1100 (set-file-modes tmp-name #o444)
1101 (should (= (file-modes tmp-name) #o444))
1102 (should-not (file-executable-p tmp-name))
1103 ;; A file is always writable for user "root".
1104 (unless (zerop (nth 2 (file-attributes tmp-name)))
1105 (should-not (file-writable-p tmp-name))))
1106 (ignore-errors (delete-file tmp-name)))))
1107
1108 (ert-deftest tramp-test21-file-links ()
1109 "Check `file-symlink-p'.
1110 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1111 (skip-unless (tramp--test-enabled))
1112
1113 ;; We must use `file-truename' for the temporary directory, because
1114 ;; it could be located on a symlinked directory. This would let the
1115 ;; test fail.
1116 (let* ((tramp-test-temporary-file-directory
1117 (file-truename tramp-test-temporary-file-directory))
1118 (tmp-name1 (tramp--test-make-temp-name))
1119 (tmp-name2 (tramp--test-make-temp-name))
1120 (tmp-name3 (tramp--test-make-temp-name 'local)))
1121 (unwind-protect
1122 (progn
1123 (write-region "foo" nil tmp-name1)
1124 (should (file-exists-p tmp-name1))
1125 ;; Method "smb" supports `make-symbolic-link' only if the
1126 ;; remote host has CIFS capabilities. tramp-adb.el and
1127 ;; tramp-gvfs.el do not support symbolic links at all.
1128 (condition-case err
1129 (make-symbolic-link tmp-name1 tmp-name2)
1130 (file-error
1131 (skip-unless
1132 (not (string-equal (error-message-string err)
1133 "make-symbolic-link not supported")))))
1134 (should (file-symlink-p tmp-name2))
1135 (should-error (make-symbolic-link tmp-name1 tmp-name2))
1136 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
1137 (should (file-symlink-p tmp-name2))
1138 ;; `tmp-name3' is a local file name.
1139 (should-error (make-symbolic-link tmp-name1 tmp-name3)))
1140 (ignore-errors
1141 (delete-file tmp-name1)
1142 (delete-file tmp-name2)))
1143
1144 (unwind-protect
1145 (progn
1146 (write-region "foo" nil tmp-name1)
1147 (should (file-exists-p tmp-name1))
1148 (add-name-to-file tmp-name1 tmp-name2)
1149 (should-not (file-symlink-p tmp-name2))
1150 (should-error (add-name-to-file tmp-name1 tmp-name2))
1151 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
1152 (should-not (file-symlink-p tmp-name2))
1153 ;; `tmp-name3' is a local file name.
1154 (should-error (add-name-to-file tmp-name1 tmp-name3)))
1155 (ignore-errors
1156 (delete-file tmp-name1)
1157 (delete-file tmp-name2)))
1158
1159 (unwind-protect
1160 (progn
1161 (write-region "foo" nil tmp-name1)
1162 (should (file-exists-p tmp-name1))
1163 (make-symbolic-link tmp-name1 tmp-name2)
1164 (should (file-symlink-p tmp-name2))
1165 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
1166 (should
1167 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
1168 (should (file-equal-p tmp-name1 tmp-name2)))
1169 (ignore-errors
1170 (delete-file tmp-name1)
1171 (delete-file tmp-name2)))
1172
1173 ;; `file-truename' shall preserve trailing link of directories.
1174 (unless (file-symlink-p tramp-test-temporary-file-directory)
1175 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
1176 (dir2 (file-name-as-directory dir1)))
1177 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
1178 (should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
1179
1180 (ert-deftest tramp-test22-file-times ()
1181 "Check `set-file-times' and `file-newer-than-file-p'."
1182 (skip-unless (tramp--test-enabled))
1183 (skip-unless
1184 (not
1185 (memq
1186 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1187 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1188
1189 (let ((tmp-name1 (tramp--test-make-temp-name))
1190 (tmp-name2 (tramp--test-make-temp-name))
1191 (tmp-name3 (tramp--test-make-temp-name)))
1192 (unwind-protect
1193 (progn
1194 (write-region "foo" nil tmp-name1)
1195 (should (file-exists-p tmp-name1))
1196 (should (consp (nth 5 (file-attributes tmp-name1))))
1197 ;; '(0 0) means don't know, and will be replaced by
1198 ;; `current-time'. Therefore, we use '(0 1).
1199 ;; We skip the test, if the remote handler is not able to
1200 ;; set the correct time.
1201 (skip-unless (set-file-times tmp-name1 '(0 1)))
1202 ;; Dumb remote shells without perl(1) or stat(1) are not
1203 ;; able to return the date correctly. They say "don't know".
1204 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
1205 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1206 (write-region "bla" nil tmp-name2)
1207 (should (file-exists-p tmp-name2))
1208 (should (file-newer-than-file-p tmp-name2 tmp-name1))
1209 ;; `tmp-name3' does not exist.
1210 (should (file-newer-than-file-p tmp-name2 tmp-name3))
1211 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
1212 (ignore-errors
1213 (delete-file tmp-name1)
1214 (delete-file tmp-name2)))))
1215
1216 (ert-deftest tramp-test23-visited-file-modtime ()
1217 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1218 (skip-unless (tramp--test-enabled))
1219
1220 (let ((tmp-name (tramp--test-make-temp-name)))
1221 (unwind-protect
1222 (progn
1223 (write-region "foo" nil tmp-name)
1224 (should (file-exists-p tmp-name))
1225 (with-temp-buffer
1226 (insert-file-contents tmp-name)
1227 (should (verify-visited-file-modtime))
1228 (set-visited-file-modtime '(0 1))
1229 (should (verify-visited-file-modtime))
1230 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1231 (ignore-errors (delete-file tmp-name)))))
1232
1233 (ert-deftest tramp-test24-file-name-completion ()
1234 "Check `file-name-completion' and `file-name-all-completions'."
1235 (skip-unless (tramp--test-enabled))
1236
1237 (let ((tmp-name (tramp--test-make-temp-name)))
1238 (unwind-protect
1239 (progn
1240 (make-directory tmp-name)
1241 (should (file-directory-p tmp-name))
1242 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1243 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1244 (make-directory (expand-file-name "boz" tmp-name))
1245 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1246 (should (equal (file-name-completion "b" tmp-name) "bo"))
1247 (should
1248 (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1249 (should (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1250 (should
1251 (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1252 '("bold" "boz/"))))
1253 (ignore-errors (delete-directory tmp-name 'recursive)))))
1254
1255 (ert-deftest tramp-test25-load ()
1256 "Check `load'."
1257 (skip-unless (tramp--test-enabled))
1258
1259 (let ((tmp-name (tramp--test-make-temp-name)))
1260 (unwind-protect
1261 (progn
1262 (load tmp-name 'noerror 'nomessage)
1263 (should-not (featurep 'tramp-test-load))
1264 (write-region "(provide 'tramp-test-load)" nil tmp-name)
1265 ;; `load' in lread.c does not pass `must-suffix'. Why?
1266 ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1267 (load tmp-name nil 'nomessage 'nosuffix)
1268 (should (featurep 'tramp-test-load)))
1269 (ignore-errors
1270 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1271 (delete-file tmp-name)))))
1272
1273 (ert-deftest tramp-test26-process-file ()
1274 "Check `process-file'."
1275 (skip-unless (tramp--test-enabled))
1276 (skip-unless
1277 (not
1278 (memq
1279 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1280 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1281
1282 (let* ((tmp-name (tramp--test-make-temp-name))
1283 (fnnd (file-name-nondirectory tmp-name))
1284 (default-directory tramp-test-temporary-file-directory)
1285 kill-buffer-query-functions)
1286 (unwind-protect
1287 (progn
1288 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1289 ;; do not exist on hydra.
1290 (should (zerop (process-file "true")))
1291 (should-not (zerop (process-file "false")))
1292 (should-not (zerop (process-file "binary-does-not-exist")))
1293 (with-temp-buffer
1294 (write-region "foo" nil tmp-name)
1295 (should (file-exists-p tmp-name))
1296 (should (zerop (process-file "ls" nil t nil fnnd)))
1297 ;; `ls' could produce colorized output.
1298 (goto-char (point-min))
1299 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1300 (replace-match "" nil nil))
1301 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1302 (should-not (get-buffer-window (current-buffer) t))
1303
1304 ;; Second run. The output must be appended.
1305 (should (zerop (process-file "ls" nil t t fnnd)))
1306 ;; `ls' could produce colorized output.
1307 (goto-char (point-min))
1308 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1309 (replace-match "" nil nil))
1310 (should
1311 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
1312 ;; A non-nil DISPLAY must not raise the buffer.
1313 (should-not (get-buffer-window (current-buffer) t))))
1314
1315 (ignore-errors (delete-file tmp-name)))))
1316
1317 (ert-deftest tramp-test27-start-file-process ()
1318 "Check `start-file-process'."
1319 (skip-unless (tramp--test-enabled))
1320 (skip-unless
1321 (not
1322 (memq
1323 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1324 '(tramp-adb-file-name-handler
1325 tramp-gvfs-file-name-handler
1326 tramp-smb-file-name-handler))))
1327
1328 (let ((default-directory tramp-test-temporary-file-directory)
1329 (tmp-name (tramp--test-make-temp-name))
1330 kill-buffer-query-functions proc)
1331 (unwind-protect
1332 (with-temp-buffer
1333 (setq proc (start-file-process "test1" (current-buffer) "cat"))
1334 (should (processp proc))
1335 (should (equal (process-status proc) 'run))
1336 (process-send-string proc "foo")
1337 (process-send-eof proc)
1338 ;; Read output.
1339 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1340 (while (< (- (point-max) (point-min)) (length "foo"))
1341 (accept-process-output proc 1)))
1342 (should (string-equal (buffer-string) "foo")))
1343 (ignore-errors (delete-process proc)))
1344
1345 (unwind-protect
1346 (with-temp-buffer
1347 (write-region "foo" nil tmp-name)
1348 (should (file-exists-p tmp-name))
1349 (setq proc
1350 (start-file-process
1351 "test2" (current-buffer)
1352 "cat" (file-name-nondirectory tmp-name)))
1353 (should (processp proc))
1354 ;; Read output.
1355 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1356 (while (< (- (point-max) (point-min)) (length "foo"))
1357 (accept-process-output proc 1)))
1358 (should (string-equal (buffer-string) "foo")))
1359 (ignore-errors
1360 (delete-process proc)
1361 (delete-file tmp-name)))
1362
1363 (unwind-protect
1364 (with-temp-buffer
1365 (setq proc (start-file-process "test3" (current-buffer) "cat"))
1366 (should (processp proc))
1367 (should (equal (process-status proc) 'run))
1368 (set-process-filter
1369 proc
1370 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
1371 (process-send-string proc "foo")
1372 (process-send-eof proc)
1373 ;; Read output.
1374 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1375 (while (< (- (point-max) (point-min)) (length "foo"))
1376 (accept-process-output proc 1)))
1377 (should (string-equal (buffer-string) "foo")))
1378 (ignore-errors (delete-process proc)))))
1379
1380 (ert-deftest tramp-test28-shell-command ()
1381 "Check `shell-command'."
1382 (skip-unless (tramp--test-enabled))
1383 (skip-unless
1384 (not
1385 (memq
1386 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1387 '(tramp-adb-file-name-handler
1388 tramp-gvfs-file-name-handler
1389 tramp-smb-file-name-handler))))
1390
1391 (let ((tmp-name (tramp--test-make-temp-name))
1392 (default-directory tramp-test-temporary-file-directory)
1393 kill-buffer-query-functions)
1394 (unwind-protect
1395 (with-temp-buffer
1396 (write-region "foo" nil tmp-name)
1397 (should (file-exists-p tmp-name))
1398 (shell-command
1399 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1400 ;; `ls' could produce colorized output.
1401 (goto-char (point-min))
1402 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1403 (replace-match "" nil nil))
1404 (should
1405 (string-equal
1406 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1407 (ignore-errors (delete-file tmp-name)))
1408
1409 (unwind-protect
1410 (with-temp-buffer
1411 (write-region "foo" nil tmp-name)
1412 (should (file-exists-p tmp-name))
1413 (async-shell-command
1414 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1415 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1416 ;; Read output.
1417 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1418 (while (< (- (point-max) (point-min))
1419 (1+ (length (file-name-nondirectory tmp-name))))
1420 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1421 ;; `ls' could produce colorized output.
1422 (goto-char (point-min))
1423 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1424 (replace-match "" nil nil))
1425 ;; There might be a nasty "Process *Async Shell* finished" message.
1426 (goto-char (point-min))
1427 (forward-line)
1428 (narrow-to-region (point-min) (point))
1429 (should
1430 (string-equal
1431 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1432 (ignore-errors (delete-file tmp-name)))
1433
1434 (unwind-protect
1435 (with-temp-buffer
1436 (write-region "foo" nil tmp-name)
1437 (should (file-exists-p tmp-name))
1438 (async-shell-command "read line; ls $line" (current-buffer))
1439 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1440 (process-send-string
1441 (get-buffer-process (current-buffer))
1442 (format "%s\n" (file-name-nondirectory tmp-name)))
1443 ;; Read output.
1444 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1445 (while (< (- (point-max) (point-min))
1446 (1+ (length (file-name-nondirectory tmp-name))))
1447 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1448 ;; `ls' could produce colorized output.
1449 (goto-char (point-min))
1450 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1451 (replace-match "" nil nil))
1452 ;; There might be a nasty "Process *Async Shell* finished" message.
1453 (goto-char (point-min))
1454 (forward-line)
1455 (narrow-to-region (point-min) (point))
1456 (should
1457 (string-equal
1458 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1459 (ignore-errors (delete-file tmp-name)))))
1460
1461 (ert-deftest tramp-test29-vc-registered ()
1462 "Check `vc-registered'."
1463 (skip-unless (tramp--test-enabled))
1464 (skip-unless
1465 (eq
1466 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1467 'tramp-sh-file-name-handler))
1468
1469 (let* ((default-directory tramp-test-temporary-file-directory)
1470 (tmp-name1 (tramp--test-make-temp-name))
1471 (tmp-name2 (expand-file-name "foo" tmp-name1))
1472 (tramp-remote-process-environment tramp-remote-process-environment)
1473 (vc-handled-backends
1474 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1475 (cond
1476 ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
1477 (setq tramp-remote-process-environment
1478 (cons (format "BZR_HOME=%s"
1479 (file-remote-p tmp-name1 'localname))
1480 tramp-remote-process-environment))
1481 ;; We must force a reconnect, in order to activate $BZR_HOME.
1482 (tramp-cleanup-connection
1483 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1484 nil 'keep-password)
1485 '(Bzr))
1486 ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
1487 '(Git))
1488 ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
1489 '(Hg))
1490 (t nil)))))
1491 (skip-unless vc-handled-backends)
1492 (message "%s" vc-handled-backends)
1493
1494 (unwind-protect
1495 (progn
1496 (make-directory tmp-name1)
1497 (write-region "foo" nil tmp-name2)
1498 (should (file-directory-p tmp-name1))
1499 (should (file-exists-p tmp-name2))
1500 (should-not (vc-registered tmp-name1))
1501 (should-not (vc-registered tmp-name2))
1502
1503 (let ((default-directory tmp-name1))
1504 ;; Create empty repository, and register the file.
1505 (vc-create-repo (car vc-handled-backends))
1506 ;; The structure of VC-FILESET is not documented. Let's
1507 ;; hope it won't change.
1508 (condition-case nil
1509 (vc-register
1510 (list (car vc-handled-backends)
1511 (list (file-name-nondirectory tmp-name2))))
1512 ;; `vc-register' has changed its arguments in Emacs 25.1.
1513 (error
1514 (vc-register
1515 nil (list (car vc-handled-backends)
1516 (list (file-name-nondirectory tmp-name2)))))))
1517 (should (vc-registered tmp-name2)))
1518
1519 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1520
1521 (defun tramp--test-adb-p ()
1522 "Check, whether the remote host runs Android.
1523 This requires restrictions of file name syntax."
1524 (eq (tramp-find-foreign-file-name-handler
1525 tramp-test-temporary-file-directory)
1526 'tramp-adb-file-name-handler))
1527
1528 (defun tramp--test-smb-or-windows-nt-p ()
1529 "Check, whether the locale or remote host runs MS Windows.
1530 This requires restrictions of file name syntax."
1531 (or (eq system-type 'windows-nt)
1532 (eq (tramp-find-foreign-file-name-handler
1533 tramp-test-temporary-file-directory)
1534 'tramp-smb-file-name-handler)))
1535
1536 (defun tramp--test-check-files (&rest files)
1537 "Run a simple but comprehensive test over every file in FILES."
1538 (let ((tmp-name1 (tramp--test-make-temp-name))
1539 (tmp-name2 (tramp--test-make-temp-name 'local))
1540 (files (delq nil files)))
1541 (unwind-protect
1542 (progn
1543 (make-directory tmp-name1)
1544 (make-directory tmp-name2)
1545 (dolist (elt files)
1546 (let* ((file1 (expand-file-name elt tmp-name1))
1547 (file2 (expand-file-name elt tmp-name2))
1548 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
1549 (write-region elt nil file1)
1550 (should (file-exists-p file1))
1551
1552 ;; Check file contents.
1553 (with-temp-buffer
1554 (insert-file-contents file1)
1555 (should (string-equal (buffer-string) elt)))
1556
1557 ;; Copy file both directions.
1558 (copy-file file1 tmp-name2)
1559 (should (file-exists-p file2))
1560 (delete-file file1)
1561 (should-not (file-exists-p file1))
1562 (copy-file file2 tmp-name1)
1563 (should (file-exists-p file1))
1564
1565 ;; Method "smb" supports `make-symbolic-link' only if the
1566 ;; remote host has CIFS capabilities. tramp-adb.el and
1567 ;; tramp-gvfs.el do not support symbolic links at all.
1568 (condition-case err
1569 (progn
1570 (make-symbolic-link file1 file3)
1571 (should (file-symlink-p file3))
1572 (should
1573 (string-equal
1574 (expand-file-name file1) (file-truename file3)))
1575 (should
1576 (string-equal
1577 (car (file-attributes file3))
1578 (file-remote-p (file-truename file1) 'localname)))
1579 ;; Check file contents.
1580 (with-temp-buffer
1581 (insert-file-contents file3)
1582 (should (string-equal (buffer-string) elt)))
1583 (delete-file file3))
1584 (file-error
1585 (should (string-equal (error-message-string err)
1586 "make-symbolic-link not supported"))))))
1587
1588 ;; Check file names.
1589 (should (equal (directory-files
1590 tmp-name1 nil directory-files-no-dot-files-regexp)
1591 (sort (copy-sequence files) 'string-lessp)))
1592 (should (equal (directory-files
1593 tmp-name2 nil directory-files-no-dot-files-regexp)
1594 (sort (copy-sequence files) 'string-lessp)))
1595
1596 ;; `substitute-in-file-name' could return different values.
1597 ;; For `adb', there could be strange file permissions
1598 ;; preventing overwriting a file. We don't care in this
1599 ;; testcase.
1600 (dolist (elt files)
1601 (let ((file1
1602 (substitute-in-file-name (expand-file-name elt tmp-name1)))
1603 (file2
1604 (substitute-in-file-name (expand-file-name elt tmp-name2))))
1605 (ignore-errors (write-region elt nil file1))
1606 (should (file-exists-p file1))
1607 (ignore-errors (write-region elt nil file2 nil 'nomessage))
1608 (should (file-exists-p file2))))
1609
1610 (should (equal (directory-files
1611 tmp-name1 nil directory-files-no-dot-files-regexp)
1612 (directory-files
1613 tmp-name2 nil directory-files-no-dot-files-regexp)))
1614
1615 ;; Check directory creation. We use a subdirectory "foo"
1616 ;; in order to avoid conflicts with previous file name tests.
1617 (dolist (elt files)
1618 (let* ((elt1 (concat elt "foo"))
1619 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1620 (file2 (expand-file-name elt file1))
1621 (file3 (expand-file-name elt1 file1)))
1622 (make-directory file1 'parents)
1623 (should (file-directory-p file1))
1624 (write-region elt nil file2)
1625 (should (file-exists-p file2))
1626 (should
1627 (equal
1628 (directory-files file1 nil directory-files-no-dot-files-regexp)
1629 `(,elt)))
1630 (should
1631 (equal
1632 (caar (directory-files-and-attributes
1633 file1 nil directory-files-no-dot-files-regexp))
1634 elt))
1635
1636 ;; Check symlink in `directory-files-and-attributes'.
1637 (condition-case err
1638 (progn
1639 (make-symbolic-link file2 file3)
1640 (should (file-symlink-p file3))
1641 (should
1642 (string-equal
1643 (caar (directory-files-and-attributes
1644 file1 nil (regexp-quote elt1)))
1645 elt1))
1646 (should
1647 (string-equal
1648 (cadr (car (directory-files-and-attributes
1649 file1 nil (regexp-quote elt1))))
1650 (file-remote-p (file-truename file2) 'localname)))
1651 (delete-file file3)
1652 (should-not (file-exists-p file3)))
1653 (file-error
1654 (should (string-equal (error-message-string err)
1655 "make-symbolic-link not supported"))))
1656
1657 (delete-file file2)
1658 (should-not (file-exists-p file2))
1659 (delete-directory file1)
1660 (should-not (file-exists-p file1)))))
1661
1662 (ignore-errors (delete-directory tmp-name1 'recursive))
1663 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1664
1665 (defun tramp--test-special-characters ()
1666 "Perform the test in `tramp-test30-special-characters*'."
1667 ;; Newlines, slashes and backslashes in file names are not
1668 ;; supported. So we don't test. And we don't test the tab
1669 ;; character on Windows or Cygwin, because the backslash is
1670 ;; interpreted as a path separator, preventing "\t" from being
1671 ;; expanded to <TAB>.
1672 (tramp--test-check-files
1673 (if (tramp--test-smb-or-windows-nt-p)
1674 "foo bar baz"
1675 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1676 " foo bar baz "
1677 " foo\tbar baz\t"))
1678 "$foo$bar$$baz$"
1679 "-foo-bar-baz-"
1680 "%foo%bar%baz%"
1681 "&foo&bar&baz&"
1682 (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?")
1683 (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*")
1684 (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"")
1685 "#foo~bar#baz~"
1686 (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|")
1687 (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;")
1688 (unless (tramp--test-smb-or-windows-nt-p) "<foo>bar<baz>")
1689 "(foo)bar(baz)"
1690 "[foo]bar[baz]"
1691 "{foo}bar{baz}"))
1692
1693 ;; These tests are inspired by Bug#17238.
1694 (ert-deftest tramp-test30-special-characters ()
1695 "Check special characters in file names."
1696 (skip-unless (tramp--test-enabled))
1697
1698 (tramp--test-special-characters))
1699
1700 (ert-deftest tramp-test30-special-characters-with-stat ()
1701 "Check special characters in file names.
1702 Use the `stat' command."
1703 (skip-unless (tramp--test-enabled))
1704 (skip-unless
1705 (eq
1706 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1707 'tramp-sh-file-name-handler))
1708 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1709 (skip-unless (tramp-get-remote-stat v)))
1710
1711 (unwind-protect
1712 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1713 (tramp-set-connection-property v "perl" nil)
1714 (tramp--test-special-characters))
1715 ;; Reset suppressed properties.
1716 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1717 (tramp-set-connection-property v "perl" 'undef))))
1718
1719 (ert-deftest tramp-test30-special-characters-with-perl ()
1720 "Check special characters in file names.
1721 Use the `perl' command."
1722 (skip-unless (tramp--test-enabled))
1723 (skip-unless
1724 (eq
1725 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1726 'tramp-sh-file-name-handler))
1727 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1728 (skip-unless (tramp-get-remote-perl v)))
1729
1730 (unwind-protect
1731 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1732 (tramp-set-connection-property v "stat" nil)
1733 (tramp--test-special-characters))
1734 ;; Reset suppressed properties.
1735 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1736 (tramp-set-connection-property v "stat" 'undef))))
1737
1738 (ert-deftest tramp-test30-special-characters-with-ls ()
1739 "Check special characters in file names.
1740 Use the `ls' command."
1741 (skip-unless (tramp--test-enabled))
1742 (skip-unless
1743 (eq
1744 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1745 'tramp-sh-file-name-handler))
1746
1747 (unwind-protect
1748 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1749 (tramp-set-connection-property v "stat" nil)
1750 (tramp-set-connection-property v "perl" nil)
1751 (tramp--test-special-characters))
1752 ;; Reset suppressed properties.
1753 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1754 (tramp-set-connection-property v "stat" 'undef)
1755 (tramp-set-connection-property v "perl" 'undef))))
1756
1757 (defun tramp--test-utf8 ()
1758 "Perform the test in `tramp-test31-utf8*'."
1759 (let ((coding-system-for-read 'utf-8)
1760 (coding-system-for-write 'utf-8)
1761 (file-name-coding-system 'utf-8))
1762 (tramp--test-check-files
1763 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1764 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1765 "银河系漫游指南系列"
1766 "Автостопом по гала́ктике")))
1767
1768 (ert-deftest tramp-test31-utf8 ()
1769 "Check UTF8 encoding in file names and file contents."
1770 (skip-unless (tramp--test-enabled))
1771
1772 (tramp--test-utf8))
1773
1774 (ert-deftest tramp-test31-utf8-with-stat ()
1775 "Check UTF8 encoding in file names and file contents.
1776 Use the `stat' command."
1777 (skip-unless (tramp--test-enabled))
1778 (skip-unless
1779 (eq
1780 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1781 'tramp-sh-file-name-handler))
1782 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1783 (skip-unless (tramp-get-remote-stat v)))
1784
1785 (unwind-protect
1786 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1787 (tramp-set-connection-property v "perl" nil)
1788 (tramp--test-utf8))
1789 ;; Reset suppressed properties.
1790 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1791 (tramp-set-connection-property v "perl" 'undef))))
1792
1793 (ert-deftest tramp-test31-utf8-with-perl ()
1794 "Check UTF8 encoding in file names and file contents.
1795 Use the `perl' command."
1796 (skip-unless (tramp--test-enabled))
1797 (skip-unless
1798 (eq
1799 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1800 'tramp-sh-file-name-handler))
1801 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1802 (skip-unless (tramp-get-remote-perl v)))
1803
1804 (unwind-protect
1805 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1806 (tramp-set-connection-property v "stat" nil)
1807 (tramp--test-utf8))
1808 ;; Reset suppressed properties.
1809 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1810 (tramp-set-connection-property v "stat" 'undef))))
1811
1812 (ert-deftest tramp-test31-utf8-with-ls ()
1813 "Check UTF8 encoding in file names and file contents.
1814 Use the `ls' command."
1815 (skip-unless (tramp--test-enabled))
1816 (skip-unless
1817 (eq
1818 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1819 'tramp-sh-file-name-handler))
1820
1821 (unwind-protect
1822 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1823 (tramp-set-connection-property v "stat" nil)
1824 (tramp-set-connection-property v "perl" nil)
1825 (tramp--test-utf8))
1826 ;; Reset suppressed properties.
1827 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1828 (tramp-set-connection-property v "stat" 'undef)
1829 (tramp-set-connection-property v "perl" 'undef))))
1830
1831 ;; This test is inspired by Bug#16928.
1832 (ert-deftest tramp-test32-asynchronous-requests ()
1833 "Check parallel asynchronous requests.
1834 Such requests could arrive from timers, process filters and
1835 process sentinels. They shall not disturb each other."
1836 ;; Mark as failed until bug has been fixed.
1837 :expected-result :failed
1838 (skip-unless (tramp--test-enabled))
1839 (skip-unless
1840 (eq
1841 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1842 'tramp-sh-file-name-handler))
1843
1844 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
1845 ;; has the side effect, that this test fails instead to abort. Good
1846 ;; for hydra.
1847 (tramp--instrument-test-case 0
1848 (let* ((tmp-name (tramp--test-make-temp-name))
1849 (default-directory tmp-name)
1850 (remote-file-name-inhibit-cache t)
1851 timer buffers kill-buffer-query-functions)
1852
1853 (unwind-protect
1854 (progn
1855 (make-directory tmp-name)
1856
1857 ;; Setup a timer in order to raise an ordinary command again
1858 ;; and again. `vc-registered' is well suited, because there
1859 ;; are many checks.
1860 (setq
1861 timer
1862 (run-at-time
1863 0 1
1864 (lambda ()
1865 (when buffers
1866 (vc-registered
1867 (buffer-name (nth (random (length buffers)) buffers)))))))
1868
1869 ;; Create temporary buffers. The number of buffers
1870 ;; corresponds to the number of processes; it could be
1871 ;; increased in order to make pressure on Tramp.
1872 (dotimes (i 5)
1873 (add-to-list 'buffers (generate-new-buffer "*temp*")))
1874
1875 ;; Open asynchronous processes. Set process sentinel.
1876 (dolist (buf buffers)
1877 (async-shell-command "read line; touch $line; echo $line" buf)
1878 (set-process-sentinel
1879 (get-buffer-process buf)
1880 (lambda (proc _state)
1881 (delete-file (buffer-name (process-buffer proc))))))
1882
1883 ;; Send a string. Use a random order of the buffers. Mix
1884 ;; with regular operation.
1885 (let ((buffers (copy-sequence buffers))
1886 buf)
1887 (while buffers
1888 (setq buf (nth (random (length buffers)) buffers))
1889 (process-send-string
1890 (get-buffer-process buf) (format "'%s'\n" buf))
1891 (file-attributes (buffer-name buf))
1892 (setq buffers (delq buf buffers))))
1893
1894 ;; Wait until the whole output has been read.
1895 (with-timeout ((* 10 (length buffers))
1896 (ert-fail "`async-shell-command' timed out"))
1897 (let ((buffers (copy-sequence buffers))
1898 buf)
1899 (while buffers
1900 (setq buf (nth (random (length buffers)) buffers))
1901 (if (ignore-errors
1902 (memq (process-status (get-buffer-process buf))
1903 '(run open)))
1904 (accept-process-output (get-buffer-process buf) 0.1)
1905 (setq buffers (delq buf buffers))))))
1906
1907 ;; Check.
1908 (dolist (buf buffers)
1909 (with-current-buffer buf
1910 (should
1911 (string-equal (format "'%s'\n" buf) (buffer-string)))))
1912 (should-not
1913 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
1914
1915 ;; Cleanup.
1916 (ignore-errors (cancel-timer timer))
1917 (ignore-errors (delete-directory tmp-name 'recursive))
1918 (dolist (buf buffers)
1919 (ignore-errors (kill-buffer buf)))))))
1920
1921 (ert-deftest tramp-test33-recursive-load ()
1922 "Check that Tramp does not fail due to recursive load."
1923 (skip-unless (tramp--test-enabled))
1924
1925 (dolist (code
1926 (list
1927 (format
1928 "(expand-file-name %S)"
1929 tramp-test-temporary-file-directory)
1930 (format
1931 "(let ((default-directory %S)) (expand-file-name %S))"
1932 tramp-test-temporary-file-directory
1933 temporary-file-directory)))
1934 (should-not
1935 (string-match
1936 "Recursive load"
1937 (shell-command-to-string
1938 (format
1939 "%s -batch -Q -L %s --eval %s"
1940 (expand-file-name invocation-name invocation-directory)
1941 (mapconcat 'shell-quote-argument load-path " -L ")
1942 (shell-quote-argument code)))))))
1943
1944 (ert-deftest tramp-test34-unload ()
1945 "Check that Tramp and its subpackages unload completely.
1946 Since it unloads Tramp, it shall be the last test to run."
1947 ;; Mark as failed until all symbols are unbound.
1948 :expected-result (if (featurep 'tramp) :failed :passed)
1949 (when (featurep 'tramp)
1950 (unload-feature 'tramp 'force)
1951 ;; No Tramp feature must be left.
1952 (should-not (featurep 'tramp))
1953 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
1954 ;; `file-name-handler-alist' must be clean.
1955 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
1956 ;; There shouldn't be left a bound symbol. We do not regard our
1957 ;; test symbols, and the Tramp unload hooks.
1958 (mapatoms
1959 (lambda (x)
1960 (and (or (boundp x) (functionp x))
1961 (string-match "^tramp" (symbol-name x))
1962 (not (string-match "^tramp--?test" (symbol-name x)))
1963 (not (string-match "unload-hook$" (symbol-name x)))
1964 (ert-fail (format "`%s' still bound" x)))))
1965 ;; There shouldn't be left a hook function containing a Tramp
1966 ;; function. We do not regard the Tramp unload hooks.
1967 (mapatoms
1968 (lambda (x)
1969 (and (boundp x)
1970 (string-match "-hooks?$" (symbol-name x))
1971 (not (string-match "unload-hook$" (symbol-name x)))
1972 (consp (symbol-value x))
1973 (ignore-errors (all-completions "tramp" (symbol-value x)))
1974 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
1975
1976 ;; TODO:
1977
1978 ;; * dired-compress-file
1979 ;; * dired-uncache
1980 ;; * file-acl
1981 ;; * file-ownership-preserved-p
1982 ;; * file-selinux-context
1983 ;; * find-backup-file-name
1984 ;; * make-auto-save-file-name
1985 ;; * set-file-acl
1986 ;; * set-file-selinux-context
1987
1988 ;; * Work on skipped tests. Make a comment, when it is impossible.
1989 ;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe
1990 ;; doesn't work well when an interactive password must be provided.
1991 ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
1992 ;; Windows (`process-send-eof'?).
1993 ;; * Fix `tramp-test30-special-characters' for `nc'.
1994 ;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
1995 ;; busybox). Seems to be in `directory-files'.
1996 ;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
1997 ;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
1998 ;; expected error.
1999
2000 (defun tramp-test-all (&optional interactive)
2001 "Run all tests for \\[tramp]."
2002 (interactive "p")
2003 (funcall
2004 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
2005
2006 (provide 'tramp-tests)
2007 ;;; tramp-tests.el ends here