Change defgeneric so it doesn't completely redefine the function
[emacs.git] / test / automated / tramp-tests.el
blob5bb05dce19a1c108c8ccebbfdae5eaed6d33c7b9
1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `http://www.gnu.org/licenses/'.
20 ;;; Commentary:
22 ;; The tests require a recent ert.el from Emacs 24.4.
24 ;; Some of the tests require access to a remote host files. Since
25 ;; this could be problematic, a mock-up connection method "mock" is
26 ;; used. Emulating a remote connection, it simply calls "sh -i".
27 ;; Tramp's file name handlers still run, so this test is sufficient
28 ;; except for connection establishing.
30 ;; If you want to test a real Tramp connection, set
31 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
32 ;; overwrite the default value. If you want to skip tests accessing a
33 ;; remote host, set this environment variable to "/dev/null" or
34 ;; whatever is appropriate on your system.
36 ;; A whole test run can be performed calling the command `tramp-test-all'.
38 ;;; Code:
40 (require 'ert)
41 (require 'tramp)
42 (require 'vc)
43 (require 'vc-bzr)
44 (require 'vc-git)
45 (require 'vc-hg)
47 (declare-function tramp-find-executable "tramp-sh")
48 (declare-function tramp-get-remote-path "tramp-sh")
49 (declare-function tramp-get-remote-stat "tramp-sh")
50 (declare-function tramp-get-remote-perl "tramp-sh")
51 (defvar tramp-copy-size-limit)
52 (defvar tramp-remote-process-environment)
54 ;; There is no default value on w32 systems, which could work out of the box.
55 (defconst tramp-test-temporary-file-directory
56 (cond
57 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
58 ((eq system-type 'windows-nt) null-device)
59 (t (add-to-list
60 'tramp-methods
61 '("mock"
62 (tramp-login-program "sh")
63 (tramp-login-args (("-i")))
64 (tramp-remote-shell "/bin/sh")
65 (tramp-remote-shell-args ("-c"))
66 (tramp-connection-timeout 10)))
67 (format "/mock::%s" temporary-file-directory)))
68 "Temporary directory for Tramp tests.")
70 (setq password-cache-expiry nil
71 tramp-verbose 0
72 tramp-copy-size-limit nil
73 tramp-message-show-message nil)
75 ;; This shall happen on hydra only.
76 (when (getenv "NIX_STORE")
77 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
79 (defvar tramp--test-enabled-checked nil
80 "Cached result of `tramp--test-enabled'.
81 If the function did run, the value is a cons cell, the `cdr'
82 being the result.")
84 (defun tramp--test-enabled ()
85 "Whether remote file access is enabled."
86 (unless (consp tramp--test-enabled-checked)
87 (setq
88 tramp--test-enabled-checked
89 (cons
90 t (ignore-errors
91 (and
92 (file-remote-p tramp-test-temporary-file-directory)
93 (file-directory-p tramp-test-temporary-file-directory)
94 (file-writable-p tramp-test-temporary-file-directory))))))
96 (when (cdr tramp--test-enabled-checked)
97 ;; Cleanup connection.
98 (ignore-errors
99 (tramp-cleanup-connection
100 (tramp-dissect-file-name tramp-test-temporary-file-directory)
101 nil 'keep-password)))
103 ;; Return result.
104 (cdr tramp--test-enabled-checked))
106 (defun tramp--test-make-temp-name (&optional local)
107 "Create a temporary file name for test."
108 (expand-file-name
109 (make-temp-name "tramp-test")
110 (if local temporary-file-directory tramp-test-temporary-file-directory)))
112 (defmacro tramp--instrument-test-case (verbose &rest body)
113 "Run BODY with `tramp-verbose' equal VERBOSE.
114 Print the the content of the Tramp debug buffer, if BODY does not
115 eval properly in `should', `should-not' or `should-error'. BODY
116 shall not contain a timeout."
117 (declare (indent 1) (debug (natnump body)))
118 `(let ((tramp-verbose ,verbose)
119 (tramp-message-show-message t)
120 (tramp-debug-on-error t))
121 (unwind-protect
122 (progn ,@body)
123 (when (> tramp-verbose 3)
124 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
125 (with-current-buffer (tramp-get-connection-buffer v)
126 (message "%s" (buffer-string)))
127 (with-current-buffer (tramp-get-debug-buffer v)
128 (message "%s" (buffer-string))))))))
130 (ert-deftest tramp-test00-availability ()
131 "Test availability of Tramp functions."
132 :expected-result (if (tramp--test-enabled) :passed :failed)
133 (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
134 (should (ignore-errors
135 (and
136 (file-remote-p tramp-test-temporary-file-directory)
137 (file-directory-p tramp-test-temporary-file-directory)
138 (file-writable-p tramp-test-temporary-file-directory)))))
140 (ert-deftest tramp-test01-file-name-syntax ()
141 "Check remote file name syntax."
142 ;; Simple cases.
143 (should (tramp-tramp-file-p "/method::"))
144 (should (tramp-tramp-file-p "/host:"))
145 (should (tramp-tramp-file-p "/user@:"))
146 (should (tramp-tramp-file-p "/user@host:"))
147 (should (tramp-tramp-file-p "/method:host:"))
148 (should (tramp-tramp-file-p "/method:user@:"))
149 (should (tramp-tramp-file-p "/method:user@host:"))
150 (should (tramp-tramp-file-p "/method:user@email@host:"))
152 ;; Using a port.
153 (should (tramp-tramp-file-p "/host#1234:"))
154 (should (tramp-tramp-file-p "/user@host#1234:"))
155 (should (tramp-tramp-file-p "/method:host#1234:"))
156 (should (tramp-tramp-file-p "/method:user@host#1234:"))
158 ;; Using an IPv4 address.
159 (should (tramp-tramp-file-p "/1.2.3.4:"))
160 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
161 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
162 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
164 ;; Using an IPv6 address.
165 (should (tramp-tramp-file-p "/[]:"))
166 (should (tramp-tramp-file-p "/[::1]:"))
167 (should (tramp-tramp-file-p "/user@[::1]:"))
168 (should (tramp-tramp-file-p "/method:[::1]:"))
169 (should (tramp-tramp-file-p "/method:user@[::1]:"))
171 ;; Local file name part.
172 (should (tramp-tramp-file-p "/host:/:"))
173 (should (tramp-tramp-file-p "/method:::"))
174 (should (tramp-tramp-file-p "/method::/path/to/file"))
175 (should (tramp-tramp-file-p "/method::file"))
177 ;; Multihop.
178 (should (tramp-tramp-file-p "/method1:|method2::"))
179 (should (tramp-tramp-file-p "/method1:host1|host2:"))
180 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
181 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
182 (should (tramp-tramp-file-p
183 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
185 ;; No strings.
186 (should-not (tramp-tramp-file-p nil))
187 (should-not (tramp-tramp-file-p 'symbol))
188 ;; "/:" suppresses file name handlers.
189 (should-not (tramp-tramp-file-p "/::"))
190 (should-not (tramp-tramp-file-p "/:@:"))
191 (should-not (tramp-tramp-file-p "/:[]:"))
192 ;; Multihops require a method.
193 (should-not (tramp-tramp-file-p "/host1|host2:"))
194 ;; Methods or hostnames shall be at least two characters on MS Windows.
195 (when (memq system-type '(cygwin windows-nt))
196 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
197 (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
199 (ert-deftest tramp-test02-file-name-dissect ()
200 "Check remote file name components."
201 (let ((tramp-default-method "default-method")
202 (tramp-default-user "default-user")
203 (tramp-default-host "default-host"))
204 ;; Expand `tramp-default-user' and `tramp-default-host'.
205 (should (string-equal
206 (file-remote-p "/method::")
207 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
208 (should (string-equal (file-remote-p "/method::" 'method) "method"))
209 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
210 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
211 (should (string-equal (file-remote-p "/method::" 'localname) ""))
213 ;; Expand `tramp-default-method' and `tramp-default-user'.
214 (should (string-equal
215 (file-remote-p "/host:")
216 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
217 (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
218 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
219 (should (string-equal (file-remote-p "/host:" 'host) "host"))
220 (should (string-equal (file-remote-p "/host:" 'localname) ""))
222 ;; Expand `tramp-default-method' and `tramp-default-host'.
223 (should (string-equal
224 (file-remote-p "/user@:")
225 (format "/%s:%s@%s:" "default-method""user" "default-host")))
226 (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
227 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
228 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
229 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
231 ;; Expand `tramp-default-method'.
232 (should (string-equal
233 (file-remote-p "/user@host:")
234 (format "/%s:%s@%s:" "default-method" "user" "host")))
235 (should (string-equal
236 (file-remote-p "/user@host:" 'method) "default-method"))
237 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
238 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
239 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
241 ;; Expand `tramp-default-user'.
242 (should (string-equal
243 (file-remote-p "/method:host:")
244 (format "/%s:%s@%s:" "method" "default-user" "host")))
245 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
246 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
247 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
248 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
250 ;; Expand `tramp-default-host'.
251 (should (string-equal
252 (file-remote-p "/method:user@:")
253 (format "/%s:%s@%s:" "method" "user" "default-host")))
254 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
255 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
256 (should (string-equal (file-remote-p "/method:user@:" 'host)
257 "default-host"))
258 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
260 ;; No expansion.
261 (should (string-equal
262 (file-remote-p "/method:user@host:")
263 (format "/%s:%s@%s:" "method" "user" "host")))
264 (should (string-equal
265 (file-remote-p "/method:user@host:" 'method) "method"))
266 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
267 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
268 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
270 ;; No expansion.
271 (should (string-equal
272 (file-remote-p "/method:user@email@host:")
273 (format "/%s:%s@%s:" "method" "user@email" "host")))
274 (should (string-equal
275 (file-remote-p "/method:user@email@host:" 'method) "method"))
276 (should (string-equal
277 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
278 (should (string-equal
279 (file-remote-p "/method:user@email@host:" 'host) "host"))
280 (should (string-equal
281 (file-remote-p "/method:user@email@host:" 'localname) ""))
283 ;; Expand `tramp-default-method' and `tramp-default-user'.
284 (should (string-equal
285 (file-remote-p "/host#1234:")
286 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
287 (should (string-equal
288 (file-remote-p "/host#1234:" 'method) "default-method"))
289 (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
290 (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
291 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
293 ;; Expand `tramp-default-method'.
294 (should (string-equal
295 (file-remote-p "/user@host#1234:")
296 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
297 (should (string-equal
298 (file-remote-p "/user@host#1234:" 'method) "default-method"))
299 (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
300 (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
301 (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
303 ;; Expand `tramp-default-user'.
304 (should (string-equal
305 (file-remote-p "/method:host#1234:")
306 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
307 (should (string-equal
308 (file-remote-p "/method:host#1234:" 'method) "method"))
309 (should (string-equal
310 (file-remote-p "/method:host#1234:" 'user) "default-user"))
311 (should (string-equal
312 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
313 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
315 ;; No expansion.
316 (should (string-equal
317 (file-remote-p "/method:user@host#1234:")
318 (format "/%s:%s@%s:" "method" "user" "host#1234")))
319 (should (string-equal
320 (file-remote-p "/method:user@host#1234:" 'method) "method"))
321 (should (string-equal
322 (file-remote-p "/method:user@host#1234:" 'user) "user"))
323 (should (string-equal
324 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
325 (should (string-equal
326 (file-remote-p "/method:user@host#1234:" 'localname) ""))
328 ;; Expand `tramp-default-method' and `tramp-default-user'.
329 (should (string-equal
330 (file-remote-p "/1.2.3.4:")
331 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
332 (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
333 (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
334 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
335 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
337 ;; Expand `tramp-default-method'.
338 (should (string-equal
339 (file-remote-p "/user@1.2.3.4:")
340 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
341 (should (string-equal
342 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
343 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
344 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
345 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
347 ;; Expand `tramp-default-user'.
348 (should (string-equal
349 (file-remote-p "/method:1.2.3.4:")
350 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
351 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
352 (should (string-equal
353 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
354 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
355 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
357 ;; No expansion.
358 (should (string-equal
359 (file-remote-p "/method:user@1.2.3.4:")
360 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
361 (should (string-equal
362 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
363 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
364 (should (string-equal
365 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
366 (should (string-equal
367 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
369 ;; Expand `tramp-default-method', `tramp-default-user' and
370 ;; `tramp-default-host'.
371 (should (string-equal
372 (file-remote-p "/[]:")
373 (format
374 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
375 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
376 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
377 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
378 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
380 ;; Expand `tramp-default-method' and `tramp-default-user'.
381 (let ((tramp-default-host "::1"))
382 (should (string-equal
383 (file-remote-p "/[]:")
384 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
385 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
386 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
387 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
388 (should (string-equal (file-remote-p "/[]:" 'localname) "")))
390 ;; Expand `tramp-default-method' and `tramp-default-user'.
391 (should (string-equal
392 (file-remote-p "/[::1]:")
393 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
394 (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
395 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
396 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
397 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
399 ;; Expand `tramp-default-method'.
400 (should (string-equal
401 (file-remote-p "/user@[::1]:")
402 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
403 (should (string-equal
404 (file-remote-p "/user@[::1]:" 'method) "default-method"))
405 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
406 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
407 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
409 ;; Expand `tramp-default-user'.
410 (should (string-equal
411 (file-remote-p "/method:[::1]:")
412 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
413 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
414 (should (string-equal
415 (file-remote-p "/method:[::1]:" 'user) "default-user"))
416 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
417 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
419 ;; No expansion.
420 (should (string-equal
421 (file-remote-p "/method:user@[::1]:")
422 (format "/%s:%s@%s:" "method" "user" "[::1]")))
423 (should (string-equal
424 (file-remote-p "/method:user@[::1]:" 'method) "method"))
425 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
426 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
427 (should (string-equal
428 (file-remote-p "/method:user@[::1]:" 'localname) ""))
430 ;; Local file name part.
431 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
432 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
433 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
434 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
435 (should (string-equal
436 (file-remote-p "/method::/path/to/file" 'localname)
437 "/path/to/file"))
439 ;; Multihop.
440 (should
441 (string-equal
442 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
443 (format "/%s:%s@%s:" "method2" "user2" "host2")))
444 (should
445 (string-equal
446 (file-remote-p
447 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
448 "method2"))
449 (should
450 (string-equal
451 (file-remote-p
452 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
453 "user2"))
454 (should
455 (string-equal
456 (file-remote-p
457 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
458 "host2"))
459 (should
460 (string-equal
461 (file-remote-p
462 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
463 "/path/to/file"))
465 (should
466 (string-equal
467 (file-remote-p
468 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
469 (format "/%s:%s@%s:" "method3" "user3" "host3")))
470 (should
471 (string-equal
472 (file-remote-p
473 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
474 'method)
475 "method3"))
476 (should
477 (string-equal
478 (file-remote-p
479 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
480 'user)
481 "user3"))
482 (should
483 (string-equal
484 (file-remote-p
485 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
486 'host)
487 "host3"))
488 (should
489 (string-equal
490 (file-remote-p
491 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
492 'localname)
493 "/path/to/file"))))
495 (ert-deftest tramp-test03-file-name-defaults ()
496 "Check default values for some methods."
497 ;; Default values in tramp-adb.el.
498 (should (string-equal (file-remote-p "/adb::" 'host) ""))
499 ;; Default values in tramp-ftp.el.
500 (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
501 (dolist (u '("ftp" "anonymous"))
502 (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
503 ;; Default values in tramp-gvfs.el.
504 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
505 (symbol-value 'tramp-gvfs-enabled))
506 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
507 ;; Default values in tramp-gw.el.
508 (dolist (m '("tunnel" "socks"))
509 (should
510 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
511 ;; Default values in tramp-sh.el.
512 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
513 (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
514 (dolist (m '("su" "sudo" "ksu"))
515 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
516 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
517 (should
518 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
519 ;; Default values in tramp-smb.el.
520 (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
521 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
523 (ert-deftest tramp-test04-substitute-in-file-name ()
524 "Check `substitute-in-file-name'."
525 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
526 (should
527 (string-equal
528 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
529 (should
530 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
531 (should
532 (string-equal
533 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
534 (should
535 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
536 (let (process-environment)
537 (should
538 (string-equal
539 (substitute-in-file-name "/method:host:/path/$FOO")
540 "/method:host:/path/$FOO"))
541 (setenv "FOO" "bla")
542 (should
543 (string-equal
544 (substitute-in-file-name "/method:host:/path/$FOO")
545 "/method:host:/path/bla"))
546 (should
547 (string-equal
548 (substitute-in-file-name "/method:host:/path/$$FOO")
549 "/method:host:/path/$FOO"))))
551 (ert-deftest tramp-test05-expand-file-name ()
552 "Check `expand-file-name'."
553 (should
554 (string-equal
555 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
556 (should
557 (string-equal
558 (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
560 (ert-deftest tramp-test06-directory-file-name ()
561 "Check `directory-file-name'.
562 This checks also `file-name-as-directory', `file-name-directory',
563 `file-name-nondirectory' and `unhandled-file-name-directory'."
564 (should
565 (string-equal
566 (directory-file-name "/method:host:/path/to/file")
567 "/method:host:/path/to/file"))
568 (should
569 (string-equal
570 (directory-file-name "/method:host:/path/to/file/")
571 "/method:host:/path/to/file"))
572 (should
573 (string-equal
574 (file-name-as-directory "/method:host:/path/to/file")
575 "/method:host:/path/to/file/"))
576 (should
577 (string-equal
578 (file-name-as-directory "/method:host:/path/to/file/")
579 "/method:host:/path/to/file/"))
580 (should
581 (string-equal
582 (file-name-directory "/method:host:/path/to/file")
583 "/method:host:/path/to/"))
584 (should
585 (string-equal
586 (file-name-directory "/method:host:/path/to/file/")
587 "/method:host:/path/to/file/"))
588 (should
589 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
590 (should
591 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
592 (should-not
593 (unhandled-file-name-directory "/method:host:/path/to/file")))
595 (ert-deftest tramp-test07-file-exists-p ()
596 "Check `file-exist-p', `write-region' and `delete-file'."
597 (skip-unless (tramp--test-enabled))
599 (let ((tmp-name (tramp--test-make-temp-name)))
600 (should-not (file-exists-p tmp-name))
601 (write-region "foo" nil tmp-name)
602 (should (file-exists-p tmp-name))
603 (delete-file tmp-name)
604 (should-not (file-exists-p tmp-name))))
606 (ert-deftest tramp-test08-file-local-copy ()
607 "Check `file-local-copy'."
608 (skip-unless (tramp--test-enabled))
610 (let ((tmp-name1 (tramp--test-make-temp-name))
611 tmp-name2)
612 (unwind-protect
613 (progn
614 (write-region "foo" nil tmp-name1)
615 (should (setq tmp-name2 (file-local-copy tmp-name1)))
616 (with-temp-buffer
617 (insert-file-contents tmp-name2)
618 (should (string-equal (buffer-string) "foo")))
619 ;; Check also that a file transfer with compression works.
620 (let ((default-directory tramp-test-temporary-file-directory)
621 (tramp-copy-size-limit 4)
622 (tramp-inline-compress-start-size 2))
623 (delete-file tmp-name2)
624 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
625 (ignore-errors
626 (delete-file tmp-name1)
627 (delete-file tmp-name2)))))
629 (ert-deftest tramp-test09-insert-file-contents ()
630 "Check `insert-file-contents'."
631 (skip-unless (tramp--test-enabled))
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)))))
650 (ert-deftest tramp-test10-write-region ()
651 "Check `write-region'."
652 (skip-unless (tramp--test-enabled))
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)))))
684 (ert-deftest tramp-test11-copy-file ()
685 "Check `copy-file'."
686 (skip-unless (tramp--test-enabled))
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)))
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)))
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)))
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)))))
754 (ert-deftest tramp-test12-rename-file ()
755 "Check `rename-file'."
756 (skip-unless (tramp--test-enabled))
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)))
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)))
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)))
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)))))
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))
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)))))
859 (ert-deftest tramp-test14-delete-directory ()
860 "Check `delete-directory'."
861 (skip-unless (tramp--test-enabled))
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))))
876 (ert-deftest tramp-test15-copy-directory ()
877 "Check `copy-directory'."
878 (skip-unless (tramp--test-enabled))
879 (skip-unless
880 (not
882 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
883 'tramp-smb-file-name-handler)))
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)))))
910 (ert-deftest tramp-test16-directory-files ()
911 "Check `directory-files'."
912 (skip-unless (tramp--test-enabled))
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)))))
938 (ert-deftest tramp-test17-insert-directory ()
939 "Check `insert-directory'."
940 (skip-unless (tramp--test-enabled))
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)))))
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))
984 ;; We must use `file-truename' for the temporary directory, because
985 ;; it could be located on a symlinked directory. This would let the
986 ;; test fail.
987 (let* ((tramp-test-temporary-file-directory
988 (file-truename tramp-test-temporary-file-directory))
989 (tmp-name1 (tramp--test-make-temp-name))
990 (tmp-name2 (tramp--test-make-temp-name))
991 attr)
992 (unwind-protect
993 (progn
994 (write-region "foo" nil tmp-name1)
995 (should (file-exists-p tmp-name1))
996 (setq attr (file-attributes tmp-name1))
997 (should (consp attr))
998 (should (file-exists-p tmp-name1))
999 (should (file-readable-p tmp-name1))
1000 (should (file-regular-p tmp-name1))
1001 ;; We do not test inodes and device numbers.
1002 (should (null (car attr)))
1003 (should (numberp (nth 1 attr))) ;; Link.
1004 (should (numberp (nth 2 attr))) ;; Uid.
1005 (should (numberp (nth 3 attr))) ;; Gid.
1006 ;; Last access time.
1007 (should (stringp (current-time-string (nth 4 attr))))
1008 ;; Last modification time.
1009 (should (stringp (current-time-string (nth 5 attr))))
1010 ;; Last status change time.
1011 (should (stringp (current-time-string (nth 6 attr))))
1012 (should (numberp (nth 7 attr))) ;; Size.
1013 (should (stringp (nth 8 attr))) ;; Modes.
1015 (setq attr (file-attributes tmp-name1 'string))
1016 (should (stringp (nth 2 attr))) ;; Uid.
1017 (should (stringp (nth 3 attr))) ;; Gid.
1019 (condition-case err
1020 (progn
1021 (make-symbolic-link tmp-name1 tmp-name2)
1022 (should (file-exists-p tmp-name2))
1023 (should (file-symlink-p tmp-name2))
1024 (setq attr (file-attributes tmp-name2))
1025 (should (string-equal
1026 (car attr)
1027 (file-remote-p (file-truename tmp-name1) 'localname)))
1028 (delete-file tmp-name2))
1029 (file-error
1030 (should (string-equal (error-message-string err)
1031 "make-symbolic-link not supported"))))
1032 (delete-file tmp-name1)
1034 (make-directory tmp-name1)
1035 (should (file-exists-p tmp-name1))
1036 (should (file-readable-p tmp-name1))
1037 (should-not (file-regular-p tmp-name1))
1038 (setq attr (file-attributes tmp-name1))
1039 (should (eq (car attr) t)))
1041 (ignore-errors (delete-directory tmp-name1)))))
1043 (ert-deftest tramp-test19-directory-files-and-attributes ()
1044 "Check `directory-files-and-attributes'."
1045 (skip-unless (tramp--test-enabled))
1047 ;; `directory-files-and-attributes' contains also values for "../".
1048 ;; Ensure that this doesn't change during tests, for
1049 ;; example due to handling temporary files.
1050 (let* ((tmp-name1 (tramp--test-make-temp-name))
1051 (tmp-name2 (expand-file-name "bla" tmp-name1))
1052 attr)
1053 (unwind-protect
1054 (progn
1055 (make-directory tmp-name1)
1056 (should (file-directory-p tmp-name1))
1057 (make-directory tmp-name2)
1058 (should (file-directory-p tmp-name2))
1059 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
1060 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
1061 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
1062 (setq attr (directory-files-and-attributes tmp-name2))
1063 (should (consp attr))
1064 ;; Dumb remote shells without perl(1) or stat(1) are not
1065 ;; able to return the date correctly. They say "don't know".
1066 (dolist (elt attr)
1067 (unless
1068 (equal
1069 (nth 5
1070 (file-attributes (expand-file-name (car elt) tmp-name2)))
1071 '(0 0))
1072 (should
1073 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
1074 (cdr elt)))))
1075 (setq attr (directory-files-and-attributes tmp-name2 'full))
1076 (dolist (elt attr)
1077 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
1078 (should
1079 (equal (file-attributes (car elt)) (cdr elt)))))
1080 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
1081 (should (equal (mapcar 'car attr) '("bar" "boz"))))
1082 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1084 (ert-deftest tramp-test20-file-modes ()
1085 "Check `file-modes'.
1086 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1087 (skip-unless (tramp--test-enabled))
1088 (skip-unless
1089 (not
1090 (memq
1091 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1092 '(tramp-adb-file-name-handler
1093 tramp-gvfs-file-name-handler
1094 tramp-smb-file-name-handler))))
1096 (let ((tmp-name (tramp--test-make-temp-name)))
1097 (unwind-protect
1098 (progn
1099 (write-region "foo" nil tmp-name)
1100 (should (file-exists-p tmp-name))
1101 (set-file-modes tmp-name #o777)
1102 (should (= (file-modes tmp-name) #o777))
1103 (should (file-executable-p tmp-name))
1104 (should (file-writable-p tmp-name))
1105 (set-file-modes tmp-name #o444)
1106 (should (= (file-modes tmp-name) #o444))
1107 (should-not (file-executable-p tmp-name))
1108 ;; A file is always writable for user "root".
1109 (unless (zerop (nth 2 (file-attributes tmp-name)))
1110 (should-not (file-writable-p tmp-name))))
1111 (ignore-errors (delete-file tmp-name)))))
1113 (ert-deftest tramp-test21-file-links ()
1114 "Check `file-symlink-p'.
1115 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1116 (skip-unless (tramp--test-enabled))
1118 ;; We must use `file-truename' for the temporary directory, because
1119 ;; it could be located on a symlinked directory. This would let the
1120 ;; test fail.
1121 (let* ((tramp-test-temporary-file-directory
1122 (file-truename tramp-test-temporary-file-directory))
1123 (tmp-name1 (tramp--test-make-temp-name))
1124 (tmp-name2 (tramp--test-make-temp-name))
1125 (tmp-name3 (tramp--test-make-temp-name 'local)))
1126 (unwind-protect
1127 (progn
1128 (write-region "foo" nil tmp-name1)
1129 (should (file-exists-p tmp-name1))
1130 ;; Method "smb" supports `make-symbolic-link' only if the
1131 ;; remote host has CIFS capabilities. tramp-adb.el and
1132 ;; tramp-gvfs.el do not support symbolic links at all.
1133 (condition-case err
1134 (make-symbolic-link tmp-name1 tmp-name2)
1135 (file-error
1136 (skip-unless
1137 (not (string-equal (error-message-string err)
1138 "make-symbolic-link not supported")))))
1139 (should (file-symlink-p tmp-name2))
1140 (should-error (make-symbolic-link tmp-name1 tmp-name2))
1141 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
1142 (should (file-symlink-p tmp-name2))
1143 ;; `tmp-name3' is a local file name.
1144 (should-error (make-symbolic-link tmp-name1 tmp-name3)))
1145 (ignore-errors
1146 (delete-file tmp-name1)
1147 (delete-file tmp-name2)))
1149 (unwind-protect
1150 (progn
1151 (write-region "foo" nil tmp-name1)
1152 (should (file-exists-p tmp-name1))
1153 (add-name-to-file tmp-name1 tmp-name2)
1154 (should-not (file-symlink-p tmp-name2))
1155 (should-error (add-name-to-file tmp-name1 tmp-name2))
1156 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
1157 (should-not (file-symlink-p tmp-name2))
1158 ;; `tmp-name3' is a local file name.
1159 (should-error (add-name-to-file tmp-name1 tmp-name3)))
1160 (ignore-errors
1161 (delete-file tmp-name1)
1162 (delete-file tmp-name2)))
1164 (unwind-protect
1165 (progn
1166 (write-region "foo" nil tmp-name1)
1167 (should (file-exists-p tmp-name1))
1168 (make-symbolic-link tmp-name1 tmp-name2)
1169 (should (file-symlink-p tmp-name2))
1170 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
1171 (should
1172 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
1173 (should (file-equal-p tmp-name1 tmp-name2)))
1174 (ignore-errors
1175 (delete-file tmp-name1)
1176 (delete-file tmp-name2)))
1178 ;; `file-truename' shall preserve trailing link of directories.
1179 (unless (file-symlink-p tramp-test-temporary-file-directory)
1180 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
1181 (dir2 (file-name-as-directory dir1)))
1182 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
1183 (should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
1185 (ert-deftest tramp-test22-file-times ()
1186 "Check `set-file-times' and `file-newer-than-file-p'."
1187 (skip-unless (tramp--test-enabled))
1188 (skip-unless
1189 (not
1190 (memq
1191 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1192 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1194 (let ((tmp-name1 (tramp--test-make-temp-name))
1195 (tmp-name2 (tramp--test-make-temp-name))
1196 (tmp-name3 (tramp--test-make-temp-name)))
1197 (unwind-protect
1198 (progn
1199 (write-region "foo" nil tmp-name1)
1200 (should (file-exists-p tmp-name1))
1201 (should (consp (nth 5 (file-attributes tmp-name1))))
1202 ;; '(0 0) means don't know, and will be replaced by
1203 ;; `current-time'. Therefore, we use '(0 1).
1204 ;; We skip the test, if the remote handler is not able to
1205 ;; set the correct time.
1206 (skip-unless (set-file-times tmp-name1 '(0 1)))
1207 ;; Dumb remote shells without perl(1) or stat(1) are not
1208 ;; able to return the date correctly. They say "don't know".
1209 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
1210 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1211 (write-region "bla" nil tmp-name2)
1212 (should (file-exists-p tmp-name2))
1213 (should (file-newer-than-file-p tmp-name2 tmp-name1))
1214 ;; `tmp-name3' does not exist.
1215 (should (file-newer-than-file-p tmp-name2 tmp-name3))
1216 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
1217 (ignore-errors
1218 (delete-file tmp-name1)
1219 (delete-file tmp-name2)))))
1221 (ert-deftest tramp-test23-visited-file-modtime ()
1222 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1223 (skip-unless (tramp--test-enabled))
1225 (let ((tmp-name (tramp--test-make-temp-name)))
1226 (unwind-protect
1227 (progn
1228 (write-region "foo" nil tmp-name)
1229 (should (file-exists-p tmp-name))
1230 (with-temp-buffer
1231 (insert-file-contents tmp-name)
1232 (should (verify-visited-file-modtime))
1233 (set-visited-file-modtime '(0 1))
1234 (should (verify-visited-file-modtime))
1235 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1236 (ignore-errors (delete-file tmp-name)))))
1238 (ert-deftest tramp-test24-file-name-completion ()
1239 "Check `file-name-completion' and `file-name-all-completions'."
1240 (skip-unless (tramp--test-enabled))
1242 (let ((tmp-name (tramp--test-make-temp-name)))
1243 (unwind-protect
1244 (progn
1245 (make-directory tmp-name)
1246 (should (file-directory-p tmp-name))
1247 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1248 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1249 (make-directory (expand-file-name "boz" tmp-name))
1250 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1251 (should (equal (file-name-completion "b" tmp-name) "bo"))
1252 (should
1253 (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1254 (should (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1255 (should
1256 (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1257 '("bold" "boz/"))))
1258 (ignore-errors (delete-directory tmp-name 'recursive)))))
1260 (ert-deftest tramp-test25-load ()
1261 "Check `load'."
1262 (skip-unless (tramp--test-enabled))
1264 (let ((tmp-name (tramp--test-make-temp-name)))
1265 (unwind-protect
1266 (progn
1267 (load tmp-name 'noerror 'nomessage)
1268 (should-not (featurep 'tramp-test-load))
1269 (write-region "(provide 'tramp-test-load)" nil tmp-name)
1270 ;; `load' in lread.c does not pass `must-suffix'. Why?
1271 ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1272 (load tmp-name nil 'nomessage 'nosuffix)
1273 (should (featurep 'tramp-test-load)))
1274 (ignore-errors
1275 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1276 (delete-file tmp-name)))))
1278 (ert-deftest tramp-test26-process-file ()
1279 "Check `process-file'."
1280 (skip-unless (tramp--test-enabled))
1281 (skip-unless
1282 (not
1283 (memq
1284 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1285 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1287 (let* ((tmp-name (tramp--test-make-temp-name))
1288 (fnnd (file-name-nondirectory tmp-name))
1289 (default-directory tramp-test-temporary-file-directory)
1290 kill-buffer-query-functions)
1291 (unwind-protect
1292 (progn
1293 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1294 ;; do not exist on hydra.
1295 (should (zerop (process-file "true")))
1296 (should-not (zerop (process-file "false")))
1297 (should-not (zerop (process-file "binary-does-not-exist")))
1298 (with-temp-buffer
1299 (write-region "foo" nil tmp-name)
1300 (should (file-exists-p tmp-name))
1301 (should (zerop (process-file "ls" nil t nil fnnd)))
1302 ;; `ls' could produce colorized output.
1303 (goto-char (point-min))
1304 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1305 (replace-match "" nil nil))
1306 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1307 (should-not (get-buffer-window (current-buffer) t))
1309 ;; Second run. The output must be appended.
1310 (should (zerop (process-file "ls" nil t t fnnd)))
1311 ;; `ls' could produce colorized output.
1312 (goto-char (point-min))
1313 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1314 (replace-match "" nil nil))
1315 (should
1316 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
1317 ;; A non-nil DISPLAY must not raise the buffer.
1318 (should-not (get-buffer-window (current-buffer) t))))
1320 (ignore-errors (delete-file tmp-name)))))
1322 (ert-deftest tramp-test27-start-file-process ()
1323 "Check `start-file-process'."
1324 (skip-unless (tramp--test-enabled))
1325 (skip-unless
1326 (not
1327 (memq
1328 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1329 '(tramp-adb-file-name-handler
1330 tramp-gvfs-file-name-handler
1331 tramp-smb-file-name-handler))))
1333 (let ((default-directory tramp-test-temporary-file-directory)
1334 (tmp-name (tramp--test-make-temp-name))
1335 kill-buffer-query-functions proc)
1336 (unwind-protect
1337 (with-temp-buffer
1338 (setq proc (start-file-process "test1" (current-buffer) "cat"))
1339 (should (processp proc))
1340 (should (equal (process-status proc) 'run))
1341 (process-send-string proc "foo")
1342 (process-send-eof proc)
1343 ;; Read output.
1344 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1345 (while (< (- (point-max) (point-min)) (length "foo"))
1346 (accept-process-output proc 1)))
1347 (should (string-equal (buffer-string) "foo")))
1348 (ignore-errors (delete-process proc)))
1350 (unwind-protect
1351 (with-temp-buffer
1352 (write-region "foo" nil tmp-name)
1353 (should (file-exists-p tmp-name))
1354 (setq proc
1355 (start-file-process
1356 "test2" (current-buffer)
1357 "cat" (file-name-nondirectory tmp-name)))
1358 (should (processp proc))
1359 ;; Read output.
1360 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1361 (while (< (- (point-max) (point-min)) (length "foo"))
1362 (accept-process-output proc 1)))
1363 (should (string-equal (buffer-string) "foo")))
1364 (ignore-errors
1365 (delete-process proc)
1366 (delete-file tmp-name)))
1368 (unwind-protect
1369 (with-temp-buffer
1370 (setq proc (start-file-process "test3" (current-buffer) "cat"))
1371 (should (processp proc))
1372 (should (equal (process-status proc) 'run))
1373 (set-process-filter
1374 proc
1375 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
1376 (process-send-string proc "foo")
1377 (process-send-eof proc)
1378 ;; Read output.
1379 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1380 (while (< (- (point-max) (point-min)) (length "foo"))
1381 (accept-process-output proc 1)))
1382 (should (string-equal (buffer-string) "foo")))
1383 (ignore-errors (delete-process proc)))))
1385 (ert-deftest tramp-test28-shell-command ()
1386 "Check `shell-command'."
1387 (skip-unless (tramp--test-enabled))
1388 (skip-unless
1389 (not
1390 (memq
1391 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1392 '(tramp-adb-file-name-handler
1393 tramp-gvfs-file-name-handler
1394 tramp-smb-file-name-handler))))
1396 (let ((tmp-name (tramp--test-make-temp-name))
1397 (default-directory tramp-test-temporary-file-directory)
1398 kill-buffer-query-functions)
1399 (unwind-protect
1400 (with-temp-buffer
1401 (write-region "foo" nil tmp-name)
1402 (should (file-exists-p tmp-name))
1403 (shell-command
1404 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1405 ;; `ls' could produce colorized output.
1406 (goto-char (point-min))
1407 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1408 (replace-match "" nil nil))
1409 (should
1410 (string-equal
1411 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1412 (ignore-errors (delete-file tmp-name)))
1414 (unwind-protect
1415 (with-temp-buffer
1416 (write-region "foo" nil tmp-name)
1417 (should (file-exists-p tmp-name))
1418 (async-shell-command
1419 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1420 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1421 ;; Read output.
1422 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1423 (while (< (- (point-max) (point-min))
1424 (1+ (length (file-name-nondirectory tmp-name))))
1425 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1426 ;; `ls' could produce colorized output.
1427 (goto-char (point-min))
1428 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1429 (replace-match "" nil nil))
1430 ;; There might be a nasty "Process *Async Shell* finished" message.
1431 (goto-char (point-min))
1432 (forward-line)
1433 (narrow-to-region (point-min) (point))
1434 (should
1435 (string-equal
1436 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1437 (ignore-errors (delete-file tmp-name)))
1439 (unwind-protect
1440 (with-temp-buffer
1441 (write-region "foo" nil tmp-name)
1442 (should (file-exists-p tmp-name))
1443 (async-shell-command "read line; ls $line" (current-buffer))
1444 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1445 (process-send-string
1446 (get-buffer-process (current-buffer))
1447 (format "%s\n" (file-name-nondirectory tmp-name)))
1448 ;; Read output.
1449 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1450 (while (< (- (point-max) (point-min))
1451 (1+ (length (file-name-nondirectory tmp-name))))
1452 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1453 ;; `ls' could produce colorized output.
1454 (goto-char (point-min))
1455 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1456 (replace-match "" nil nil))
1457 ;; There might be a nasty "Process *Async Shell* finished" message.
1458 (goto-char (point-min))
1459 (forward-line)
1460 (narrow-to-region (point-min) (point))
1461 (should
1462 (string-equal
1463 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1464 (ignore-errors (delete-file tmp-name)))))
1466 (ert-deftest tramp-test29-vc-registered ()
1467 "Check `vc-registered'."
1468 (skip-unless (tramp--test-enabled))
1469 (skip-unless
1471 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1472 'tramp-sh-file-name-handler))
1474 (let* ((default-directory tramp-test-temporary-file-directory)
1475 (tmp-name1 (tramp--test-make-temp-name))
1476 (tmp-name2 (expand-file-name "foo" tmp-name1))
1477 (tramp-remote-process-environment tramp-remote-process-environment)
1478 (vc-handled-backends
1479 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1480 (cond
1481 ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
1482 (setq tramp-remote-process-environment
1483 (cons (format "BZR_HOME=%s"
1484 (file-remote-p tmp-name1 'localname))
1485 tramp-remote-process-environment))
1486 ;; We must force a reconnect, in order to activate $BZR_HOME.
1487 (tramp-cleanup-connection
1488 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1489 nil 'keep-password)
1490 '(Bzr))
1491 ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
1492 '(Git))
1493 ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
1494 '(Hg))
1495 (t nil)))))
1496 (skip-unless vc-handled-backends)
1497 (message "%s" vc-handled-backends)
1499 (unwind-protect
1500 (progn
1501 (make-directory tmp-name1)
1502 (write-region "foo" nil tmp-name2)
1503 (should (file-directory-p tmp-name1))
1504 (should (file-exists-p tmp-name2))
1505 (should-not (vc-registered tmp-name1))
1506 (should-not (vc-registered tmp-name2))
1508 (let ((default-directory tmp-name1))
1509 ;; Create empty repository, and register the file.
1510 (vc-create-repo (car vc-handled-backends))
1511 ;; The structure of VC-FILESET is not documented. Let's
1512 ;; hope it won't change.
1513 (condition-case nil
1514 (vc-register
1515 (list (car vc-handled-backends)
1516 (list (file-name-nondirectory tmp-name2))))
1517 ;; `vc-register' has changed its arguments in Emacs 25.1.
1518 (error
1519 (vc-register
1520 nil (list (car vc-handled-backends)
1521 (list (file-name-nondirectory tmp-name2)))))))
1522 (should (vc-registered tmp-name2)))
1524 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1526 (defun tramp--test-adb-p ()
1527 "Check, whether the remote host runs Android.
1528 This requires restrictions of file name syntax."
1529 (eq (tramp-find-foreign-file-name-handler
1530 tramp-test-temporary-file-directory)
1531 'tramp-adb-file-name-handler))
1533 (defun tramp--test-smb-or-windows-nt-p ()
1534 "Check, whether the locale or remote host runs MS Windows.
1535 This requires restrictions of file name syntax."
1536 (or (eq system-type 'windows-nt)
1537 (eq (tramp-find-foreign-file-name-handler
1538 tramp-test-temporary-file-directory)
1539 'tramp-smb-file-name-handler)))
1541 (defun tramp--test-check-files (&rest files)
1542 "Run a simple but comprehensive test over every file in FILES."
1543 ;; We must use `file-truename' for the temporary directory, because
1544 ;; it could be located on a symlinked directory. This would let the
1545 ;; test fail.
1546 (let* ((tramp-test-temporary-file-directory
1547 (file-truename tramp-test-temporary-file-directory))
1548 (tmp-name1 (tramp--test-make-temp-name))
1549 (tmp-name2 (tramp--test-make-temp-name 'local))
1550 (files (delq nil files)))
1551 (unwind-protect
1552 (progn
1553 (make-directory tmp-name1)
1554 (make-directory tmp-name2)
1555 (dolist (elt files)
1556 (let* ((file1 (expand-file-name elt tmp-name1))
1557 (file2 (expand-file-name elt tmp-name2))
1558 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
1559 (write-region elt nil file1)
1560 (should (file-exists-p file1))
1562 ;; Check file contents.
1563 (with-temp-buffer
1564 (insert-file-contents file1)
1565 (should (string-equal (buffer-string) elt)))
1567 ;; Copy file both directions.
1568 (copy-file file1 tmp-name2)
1569 (should (file-exists-p file2))
1570 (delete-file file1)
1571 (should-not (file-exists-p file1))
1572 (copy-file file2 tmp-name1)
1573 (should (file-exists-p file1))
1575 ;; Method "smb" supports `make-symbolic-link' only if the
1576 ;; remote host has CIFS capabilities. tramp-adb.el and
1577 ;; tramp-gvfs.el do not support symbolic links at all.
1578 (condition-case err
1579 (progn
1580 (make-symbolic-link file1 file3)
1581 (should (file-symlink-p file3))
1582 (should
1583 (string-equal
1584 (expand-file-name file1) (file-truename file3)))
1585 (should
1586 (string-equal
1587 (car (file-attributes file3))
1588 (file-remote-p (file-truename file1) 'localname)))
1589 ;; Check file contents.
1590 (with-temp-buffer
1591 (insert-file-contents file3)
1592 (should (string-equal (buffer-string) elt)))
1593 (delete-file file3))
1594 (file-error
1595 (should (string-equal (error-message-string err)
1596 "make-symbolic-link not supported"))))))
1598 ;; Check file names.
1599 (should (equal (directory-files
1600 tmp-name1 nil directory-files-no-dot-files-regexp)
1601 (sort (copy-sequence files) 'string-lessp)))
1602 (should (equal (directory-files
1603 tmp-name2 nil directory-files-no-dot-files-regexp)
1604 (sort (copy-sequence files) 'string-lessp)))
1606 ;; `substitute-in-file-name' could return different values.
1607 ;; For `adb', there could be strange file permissions
1608 ;; preventing overwriting a file. We don't care in this
1609 ;; testcase.
1610 (dolist (elt files)
1611 (let ((file1
1612 (substitute-in-file-name (expand-file-name elt tmp-name1)))
1613 (file2
1614 (substitute-in-file-name (expand-file-name elt tmp-name2))))
1615 (ignore-errors (write-region elt nil file1))
1616 (should (file-exists-p file1))
1617 (ignore-errors (write-region elt nil file2 nil 'nomessage))
1618 (should (file-exists-p file2))))
1620 (should (equal (directory-files
1621 tmp-name1 nil directory-files-no-dot-files-regexp)
1622 (directory-files
1623 tmp-name2 nil directory-files-no-dot-files-regexp)))
1625 ;; Check directory creation. We use a subdirectory "foo"
1626 ;; in order to avoid conflicts with previous file name tests.
1627 (dolist (elt files)
1628 (let* ((elt1 (concat elt "foo"))
1629 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1630 (file2 (expand-file-name elt file1))
1631 (file3 (expand-file-name elt1 file1)))
1632 (make-directory file1 'parents)
1633 (should (file-directory-p file1))
1634 (write-region elt nil file2)
1635 (should (file-exists-p file2))
1636 (should
1637 (equal
1638 (directory-files file1 nil directory-files-no-dot-files-regexp)
1639 `(,elt)))
1640 (should
1641 (equal
1642 (caar (directory-files-and-attributes
1643 file1 nil directory-files-no-dot-files-regexp))
1644 elt))
1646 ;; Check symlink in `directory-files-and-attributes'.
1647 (condition-case err
1648 (progn
1649 (make-symbolic-link file2 file3)
1650 (should (file-symlink-p file3))
1651 (should
1652 (string-equal
1653 (caar (directory-files-and-attributes
1654 file1 nil (regexp-quote elt1)))
1655 elt1))
1656 (should
1657 (string-equal
1658 (cadr (car (directory-files-and-attributes
1659 file1 nil (regexp-quote elt1))))
1660 (file-remote-p (file-truename file2) 'localname)))
1661 (delete-file file3)
1662 (should-not (file-exists-p file3)))
1663 (file-error
1664 (should (string-equal (error-message-string err)
1665 "make-symbolic-link not supported"))))
1667 (delete-file file2)
1668 (should-not (file-exists-p file2))
1669 (delete-directory file1)
1670 (should-not (file-exists-p file1)))))
1672 (ignore-errors (delete-directory tmp-name1 'recursive))
1673 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1675 (defun tramp--test-special-characters ()
1676 "Perform the test in `tramp-test30-special-characters*'."
1677 ;; Newlines, slashes and backslashes in file names are not
1678 ;; supported. So we don't test. And we don't test the tab
1679 ;; character on Windows or Cygwin, because the backslash is
1680 ;; interpreted as a path separator, preventing "\t" from being
1681 ;; expanded to <TAB>.
1682 (tramp--test-check-files
1683 (if (tramp--test-smb-or-windows-nt-p)
1684 "foo bar baz"
1685 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1686 " foo bar baz "
1687 " foo\tbar baz\t"))
1688 "$foo$bar$$baz$"
1689 "-foo-bar-baz-"
1690 "%foo%bar%baz%"
1691 "&foo&bar&baz&"
1692 (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?")
1693 (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*")
1694 (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"")
1695 "#foo~bar#baz~"
1696 (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|")
1697 (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;")
1698 (unless (tramp--test-smb-or-windows-nt-p) "<foo>bar<baz>")
1699 "(foo)bar(baz)"
1700 "[foo]bar[baz]"
1701 "{foo}bar{baz}"))
1703 ;; These tests are inspired by Bug#17238.
1704 (ert-deftest tramp-test30-special-characters ()
1705 "Check special characters in file names."
1706 (skip-unless (tramp--test-enabled))
1708 (tramp--test-special-characters))
1710 (ert-deftest tramp-test30-special-characters-with-stat ()
1711 "Check special characters in file names.
1712 Use the `stat' command."
1713 (skip-unless (tramp--test-enabled))
1714 (skip-unless
1716 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1717 'tramp-sh-file-name-handler))
1718 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1719 (skip-unless (tramp-get-remote-stat v)))
1721 (unwind-protect
1722 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1723 (tramp-set-connection-property v "perl" nil)
1724 (tramp--test-special-characters))
1725 ;; Reset suppressed properties.
1726 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1727 (tramp-set-connection-property v "perl" 'undef))))
1729 (ert-deftest tramp-test30-special-characters-with-perl ()
1730 "Check special characters in file names.
1731 Use the `perl' command."
1732 (skip-unless (tramp--test-enabled))
1733 (skip-unless
1735 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1736 'tramp-sh-file-name-handler))
1737 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1738 (skip-unless (tramp-get-remote-perl v)))
1740 (unwind-protect
1741 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1742 (tramp-set-connection-property v "stat" nil)
1743 (tramp--test-special-characters))
1744 ;; Reset suppressed properties.
1745 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1746 (tramp-set-connection-property v "stat" 'undef))))
1748 (ert-deftest tramp-test30-special-characters-with-ls ()
1749 "Check special characters in file names.
1750 Use the `ls' command."
1751 (skip-unless (tramp--test-enabled))
1752 (skip-unless
1754 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1755 'tramp-sh-file-name-handler))
1757 (unwind-protect
1758 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1759 (tramp-set-connection-property v "stat" nil)
1760 (tramp-set-connection-property v "perl" nil)
1761 (tramp--test-special-characters))
1762 ;; Reset suppressed properties.
1763 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1764 (tramp-set-connection-property v "stat" 'undef)
1765 (tramp-set-connection-property v "perl" 'undef))))
1767 (defun tramp--test-utf8 ()
1768 "Perform the test in `tramp-test31-utf8*'."
1769 (let ((coding-system-for-read 'utf-8)
1770 (coding-system-for-write 'utf-8)
1771 (file-name-coding-system 'utf-8))
1772 (tramp--test-check-files
1773 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1774 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1775 "银河系漫游指南系列"
1776 "Автостопом по гала́ктике")))
1778 (ert-deftest tramp-test31-utf8 ()
1779 "Check UTF8 encoding in file names and file contents."
1780 (skip-unless (tramp--test-enabled))
1782 (tramp--test-utf8))
1784 (ert-deftest tramp-test31-utf8-with-stat ()
1785 "Check UTF8 encoding in file names and file contents.
1786 Use the `stat' command."
1787 (skip-unless (tramp--test-enabled))
1788 (skip-unless
1790 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1791 'tramp-sh-file-name-handler))
1792 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1793 (skip-unless (tramp-get-remote-stat v)))
1795 (unwind-protect
1796 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1797 (tramp-set-connection-property v "perl" nil)
1798 (tramp--test-utf8))
1799 ;; Reset suppressed properties.
1800 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1801 (tramp-set-connection-property v "perl" 'undef))))
1803 (ert-deftest tramp-test31-utf8-with-perl ()
1804 "Check UTF8 encoding in file names and file contents.
1805 Use the `perl' command."
1806 (skip-unless (tramp--test-enabled))
1807 (skip-unless
1809 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1810 'tramp-sh-file-name-handler))
1811 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1812 (skip-unless (tramp-get-remote-perl v)))
1814 (unwind-protect
1815 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1816 (tramp-set-connection-property v "stat" nil)
1817 (tramp--test-utf8))
1818 ;; Reset suppressed properties.
1819 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1820 (tramp-set-connection-property v "stat" 'undef))))
1822 (ert-deftest tramp-test31-utf8-with-ls ()
1823 "Check UTF8 encoding in file names and file contents.
1824 Use the `ls' command."
1825 (skip-unless (tramp--test-enabled))
1826 (skip-unless
1828 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1829 'tramp-sh-file-name-handler))
1831 (unwind-protect
1832 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1833 (tramp-set-connection-property v "stat" nil)
1834 (tramp-set-connection-property v "perl" nil)
1835 (tramp--test-utf8))
1836 ;; Reset suppressed properties.
1837 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1838 (tramp-set-connection-property v "stat" 'undef)
1839 (tramp-set-connection-property v "perl" 'undef))))
1841 ;; This test is inspired by Bug#16928.
1842 (ert-deftest tramp-test32-asynchronous-requests ()
1843 "Check parallel asynchronous requests.
1844 Such requests could arrive from timers, process filters and
1845 process sentinels. They shall not disturb each other."
1846 ;; Mark as failed until bug has been fixed.
1847 :expected-result :failed
1848 (skip-unless (tramp--test-enabled))
1849 (skip-unless
1851 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1852 'tramp-sh-file-name-handler))
1854 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
1855 ;; has the side effect, that this test fails instead to abort. Good
1856 ;; for hydra.
1857 (tramp--instrument-test-case 0
1858 (let* ((tmp-name (tramp--test-make-temp-name))
1859 (default-directory tmp-name)
1860 (remote-file-name-inhibit-cache t)
1861 timer buffers kill-buffer-query-functions)
1863 (unwind-protect
1864 (progn
1865 (make-directory tmp-name)
1867 ;; Setup a timer in order to raise an ordinary command again
1868 ;; and again. `vc-registered' is well suited, because there
1869 ;; are many checks.
1870 (setq
1871 timer
1872 (run-at-time
1874 (lambda ()
1875 (when buffers
1876 (vc-registered
1877 (buffer-name (nth (random (length buffers)) buffers)))))))
1879 ;; Create temporary buffers. The number of buffers
1880 ;; corresponds to the number of processes; it could be
1881 ;; increased in order to make pressure on Tramp.
1882 (dotimes (i 5)
1883 (add-to-list 'buffers (generate-new-buffer "*temp*")))
1885 ;; Open asynchronous processes. Set process sentinel.
1886 (dolist (buf buffers)
1887 (async-shell-command "read line; touch $line; echo $line" buf)
1888 (set-process-sentinel
1889 (get-buffer-process buf)
1890 (lambda (proc _state)
1891 (delete-file (buffer-name (process-buffer proc))))))
1893 ;; Send a string. Use a random order of the buffers. Mix
1894 ;; with regular operation.
1895 (let ((buffers (copy-sequence buffers))
1896 buf)
1897 (while buffers
1898 (setq buf (nth (random (length buffers)) buffers))
1899 (process-send-string
1900 (get-buffer-process buf) (format "'%s'\n" buf))
1901 (file-attributes (buffer-name buf))
1902 (setq buffers (delq buf buffers))))
1904 ;; Wait until the whole output has been read.
1905 (with-timeout ((* 10 (length buffers))
1906 (ert-fail "`async-shell-command' timed out"))
1907 (let ((buffers (copy-sequence buffers))
1908 buf)
1909 (while buffers
1910 (setq buf (nth (random (length buffers)) buffers))
1911 (if (ignore-errors
1912 (memq (process-status (get-buffer-process buf))
1913 '(run open)))
1914 (accept-process-output (get-buffer-process buf) 0.1)
1915 (setq buffers (delq buf buffers))))))
1917 ;; Check.
1918 (dolist (buf buffers)
1919 (with-current-buffer buf
1920 (should
1921 (string-equal (format "'%s'\n" buf) (buffer-string)))))
1922 (should-not
1923 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
1925 ;; Cleanup.
1926 (ignore-errors (cancel-timer timer))
1927 (ignore-errors (delete-directory tmp-name 'recursive))
1928 (dolist (buf buffers)
1929 (ignore-errors (kill-buffer buf)))))))
1931 (ert-deftest tramp-test33-recursive-load ()
1932 "Check that Tramp does not fail due to recursive load."
1933 (skip-unless (tramp--test-enabled))
1935 (dolist (code
1936 (list
1937 (format
1938 "(expand-file-name %S)"
1939 tramp-test-temporary-file-directory)
1940 (format
1941 "(let ((default-directory %S)) (expand-file-name %S))"
1942 tramp-test-temporary-file-directory
1943 temporary-file-directory)))
1944 (should-not
1945 (string-match
1946 "Recursive load"
1947 (shell-command-to-string
1948 (format
1949 "%s -batch -Q -L %s --eval %s"
1950 (expand-file-name invocation-name invocation-directory)
1951 (mapconcat 'shell-quote-argument load-path " -L ")
1952 (shell-quote-argument code)))))))
1954 (ert-deftest tramp-test34-unload ()
1955 "Check that Tramp and its subpackages unload completely.
1956 Since it unloads Tramp, it shall be the last test to run."
1957 ;; Mark as failed until all symbols are unbound.
1958 :expected-result (if (featurep 'tramp) :failed :passed)
1959 (when (featurep 'tramp)
1960 (unload-feature 'tramp 'force)
1961 ;; No Tramp feature must be left.
1962 (should-not (featurep 'tramp))
1963 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
1964 ;; `file-name-handler-alist' must be clean.
1965 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
1966 ;; There shouldn't be left a bound symbol. We do not regard our
1967 ;; test symbols, and the Tramp unload hooks.
1968 (mapatoms
1969 (lambda (x)
1970 (and (or (boundp x) (functionp x))
1971 (string-match "^tramp" (symbol-name x))
1972 (not (string-match "^tramp--?test" (symbol-name x)))
1973 (not (string-match "unload-hook$" (symbol-name x)))
1974 (ert-fail (format "`%s' still bound" x)))))
1975 ;; There shouldn't be left a hook function containing a Tramp
1976 ;; function. We do not regard the Tramp unload hooks.
1977 (mapatoms
1978 (lambda (x)
1979 (and (boundp x)
1980 (string-match "-hooks?$" (symbol-name x))
1981 (not (string-match "unload-hook$" (symbol-name x)))
1982 (consp (symbol-value x))
1983 (ignore-errors (all-completions "tramp" (symbol-value x)))
1984 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
1986 ;; TODO:
1988 ;; * dired-compress-file
1989 ;; * dired-uncache
1990 ;; * file-acl
1991 ;; * file-ownership-preserved-p
1992 ;; * file-selinux-context
1993 ;; * find-backup-file-name
1994 ;; * make-auto-save-file-name
1995 ;; * set-file-acl
1996 ;; * set-file-selinux-context
1998 ;; * Work on skipped tests. Make a comment, when it is impossible.
1999 ;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe
2000 ;; doesn't work well when an interactive password must be provided.
2001 ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
2002 ;; Windows (`process-send-eof'?).
2003 ;; * Fix `tramp-test30-special-characters' for `nc'.
2004 ;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
2005 ;; busybox). Seems to be in `directory-files'.
2006 ;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
2007 ;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
2008 ;; expected error.
2010 (defun tramp-test-all (&optional interactive)
2011 "Run all tests for \\[tramp]."
2012 (interactive "p")
2013 (funcall
2014 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
2016 (provide 'tramp-tests)
2017 ;;; tramp-tests.el ends here