Don't test "\t" in file names on Cygwin.
[emacs.git] / test / automated / tramp-tests.el
blob9ba67430960e720ce69301112cd0e09e8d19df05
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
128 (tramp-get-debug-buffer v)
129 (message "%s" (buffer-string))))))))
131 (ert-deftest tramp-test00-availability ()
132 "Test availability of Tramp functions."
133 :expected-result (if (tramp--test-enabled) :passed :failed)
134 (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
135 (should (ignore-errors
136 (and
137 (file-remote-p tramp-test-temporary-file-directory)
138 (file-directory-p tramp-test-temporary-file-directory)
139 (file-writable-p tramp-test-temporary-file-directory)))))
141 (ert-deftest tramp-test01-file-name-syntax ()
142 "Check remote file name syntax."
143 ;; Simple cases.
144 (should (tramp-tramp-file-p "/method::"))
145 (should (tramp-tramp-file-p "/host:"))
146 (should (tramp-tramp-file-p "/user@:"))
147 (should (tramp-tramp-file-p "/user@host:"))
148 (should (tramp-tramp-file-p "/method:host:"))
149 (should (tramp-tramp-file-p "/method:user@:"))
150 (should (tramp-tramp-file-p "/method:user@host:"))
151 (should (tramp-tramp-file-p "/method:user@email@host:"))
153 ;; Using a port.
154 (should (tramp-tramp-file-p "/host#1234:"))
155 (should (tramp-tramp-file-p "/user@host#1234:"))
156 (should (tramp-tramp-file-p "/method:host#1234:"))
157 (should (tramp-tramp-file-p "/method:user@host#1234:"))
159 ;; Using an IPv4 address.
160 (should (tramp-tramp-file-p "/1.2.3.4:"))
161 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
162 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
163 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
165 ;; Using an IPv6 address.
166 (should (tramp-tramp-file-p "/[]:"))
167 (should (tramp-tramp-file-p "/[::1]:"))
168 (should (tramp-tramp-file-p "/user@[::1]:"))
169 (should (tramp-tramp-file-p "/method:[::1]:"))
170 (should (tramp-tramp-file-p "/method:user@[::1]:"))
172 ;; Local file name part.
173 (should (tramp-tramp-file-p "/host:/:"))
174 (should (tramp-tramp-file-p "/method:::"))
175 (should (tramp-tramp-file-p "/method::/path/to/file"))
176 (should (tramp-tramp-file-p "/method::file"))
178 ;; Multihop.
179 (should (tramp-tramp-file-p "/method1:|method2::"))
180 (should (tramp-tramp-file-p "/method1:host1|host2:"))
181 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
182 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
183 (should (tramp-tramp-file-p
184 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
186 ;; No strings.
187 (should-not (tramp-tramp-file-p nil))
188 (should-not (tramp-tramp-file-p 'symbol))
189 ;; "/:" suppresses file name handlers.
190 (should-not (tramp-tramp-file-p "/::"))
191 (should-not (tramp-tramp-file-p "/:@:"))
192 (should-not (tramp-tramp-file-p "/:[]:"))
193 ;; Multihops require a method.
194 (should-not (tramp-tramp-file-p "/host1|host2:"))
195 ;; Methods or hostnames shall be at least two characters on MS Windows.
196 (when (memq system-type '(cygwin windows-nt))
197 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
198 (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
200 (ert-deftest tramp-test02-file-name-dissect ()
201 "Check remote file name components."
202 (let ((tramp-default-method "default-method")
203 (tramp-default-user "default-user")
204 (tramp-default-host "default-host"))
205 ;; Expand `tramp-default-user' and `tramp-default-host'.
206 (should (string-equal
207 (file-remote-p "/method::")
208 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
209 (should (string-equal (file-remote-p "/method::" 'method) "method"))
210 (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
211 (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
212 (should (string-equal (file-remote-p "/method::" 'localname) ""))
214 ;; Expand `tramp-default-method' and `tramp-default-user'.
215 (should (string-equal
216 (file-remote-p "/host:")
217 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
218 (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
219 (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
220 (should (string-equal (file-remote-p "/host:" 'host) "host"))
221 (should (string-equal (file-remote-p "/host:" 'localname) ""))
223 ;; Expand `tramp-default-method' and `tramp-default-host'.
224 (should (string-equal
225 (file-remote-p "/user@:")
226 (format "/%s:%s@%s:" "default-method""user" "default-host")))
227 (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
228 (should (string-equal (file-remote-p "/user@:" 'user) "user"))
229 (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
230 (should (string-equal (file-remote-p "/user@:" 'localname) ""))
232 ;; Expand `tramp-default-method'.
233 (should (string-equal
234 (file-remote-p "/user@host:")
235 (format "/%s:%s@%s:" "default-method" "user" "host")))
236 (should (string-equal
237 (file-remote-p "/user@host:" 'method) "default-method"))
238 (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
239 (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
240 (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
242 ;; Expand `tramp-default-user'.
243 (should (string-equal
244 (file-remote-p "/method:host:")
245 (format "/%s:%s@%s:" "method" "default-user" "host")))
246 (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
247 (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
248 (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
249 (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
251 ;; Expand `tramp-default-host'.
252 (should (string-equal
253 (file-remote-p "/method:user@:")
254 (format "/%s:%s@%s:" "method" "user" "default-host")))
255 (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
256 (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
257 (should (string-equal (file-remote-p "/method:user@:" 'host)
258 "default-host"))
259 (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
261 ;; No expansion.
262 (should (string-equal
263 (file-remote-p "/method:user@host:")
264 (format "/%s:%s@%s:" "method" "user" "host")))
265 (should (string-equal
266 (file-remote-p "/method:user@host:" 'method) "method"))
267 (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
268 (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
269 (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
271 ;; No expansion.
272 (should (string-equal
273 (file-remote-p "/method:user@email@host:")
274 (format "/%s:%s@%s:" "method" "user@email" "host")))
275 (should (string-equal
276 (file-remote-p "/method:user@email@host:" 'method) "method"))
277 (should (string-equal
278 (file-remote-p "/method:user@email@host:" 'user) "user@email"))
279 (should (string-equal
280 (file-remote-p "/method:user@email@host:" 'host) "host"))
281 (should (string-equal
282 (file-remote-p "/method:user@email@host:" 'localname) ""))
284 ;; Expand `tramp-default-method' and `tramp-default-user'.
285 (should (string-equal
286 (file-remote-p "/host#1234:")
287 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
288 (should (string-equal
289 (file-remote-p "/host#1234:" 'method) "default-method"))
290 (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
291 (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
292 (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
294 ;; Expand `tramp-default-method'.
295 (should (string-equal
296 (file-remote-p "/user@host#1234:")
297 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
298 (should (string-equal
299 (file-remote-p "/user@host#1234:" 'method) "default-method"))
300 (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
301 (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
302 (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
304 ;; Expand `tramp-default-user'.
305 (should (string-equal
306 (file-remote-p "/method:host#1234:")
307 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
308 (should (string-equal
309 (file-remote-p "/method:host#1234:" 'method) "method"))
310 (should (string-equal
311 (file-remote-p "/method:host#1234:" 'user) "default-user"))
312 (should (string-equal
313 (file-remote-p "/method:host#1234:" 'host) "host#1234"))
314 (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
316 ;; No expansion.
317 (should (string-equal
318 (file-remote-p "/method:user@host#1234:")
319 (format "/%s:%s@%s:" "method" "user" "host#1234")))
320 (should (string-equal
321 (file-remote-p "/method:user@host#1234:" 'method) "method"))
322 (should (string-equal
323 (file-remote-p "/method:user@host#1234:" 'user) "user"))
324 (should (string-equal
325 (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
326 (should (string-equal
327 (file-remote-p "/method:user@host#1234:" 'localname) ""))
329 ;; Expand `tramp-default-method' and `tramp-default-user'.
330 (should (string-equal
331 (file-remote-p "/1.2.3.4:")
332 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
333 (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
334 (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
335 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
336 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
338 ;; Expand `tramp-default-method'.
339 (should (string-equal
340 (file-remote-p "/user@1.2.3.4:")
341 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
342 (should (string-equal
343 (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
344 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
345 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
346 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
348 ;; Expand `tramp-default-user'.
349 (should (string-equal
350 (file-remote-p "/method:1.2.3.4:")
351 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
352 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
353 (should (string-equal
354 (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
355 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
356 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
358 ;; No expansion.
359 (should (string-equal
360 (file-remote-p "/method:user@1.2.3.4:")
361 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
362 (should (string-equal
363 (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
364 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
365 (should (string-equal
366 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
367 (should (string-equal
368 (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
370 ;; Expand `tramp-default-method', `tramp-default-user' and
371 ;; `tramp-default-host'.
372 (should (string-equal
373 (file-remote-p "/[]:")
374 (format
375 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
376 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
377 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
378 (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
379 (should (string-equal (file-remote-p "/[]:" 'localname) ""))
381 ;; Expand `tramp-default-method' and `tramp-default-user'.
382 (let ((tramp-default-host "::1"))
383 (should (string-equal
384 (file-remote-p "/[]:")
385 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
386 (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
387 (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
388 (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
389 (should (string-equal (file-remote-p "/[]:" 'localname) "")))
391 ;; Expand `tramp-default-method' and `tramp-default-user'.
392 (should (string-equal
393 (file-remote-p "/[::1]:")
394 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
395 (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
396 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
397 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
398 (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
400 ;; Expand `tramp-default-method'.
401 (should (string-equal
402 (file-remote-p "/user@[::1]:")
403 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
404 (should (string-equal
405 (file-remote-p "/user@[::1]:" 'method) "default-method"))
406 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
407 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
408 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
410 ;; Expand `tramp-default-user'.
411 (should (string-equal
412 (file-remote-p "/method:[::1]:")
413 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
414 (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
415 (should (string-equal
416 (file-remote-p "/method:[::1]:" 'user) "default-user"))
417 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
418 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
420 ;; No expansion.
421 (should (string-equal
422 (file-remote-p "/method:user@[::1]:")
423 (format "/%s:%s@%s:" "method" "user" "[::1]")))
424 (should (string-equal
425 (file-remote-p "/method:user@[::1]:" 'method) "method"))
426 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
427 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
428 (should (string-equal
429 (file-remote-p "/method:user@[::1]:" 'localname) ""))
431 ;; Local file name part.
432 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
433 (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
434 (should (string-equal (file-remote-p "/method:: " 'localname) " "))
435 (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
436 (should (string-equal
437 (file-remote-p "/method::/path/to/file" 'localname)
438 "/path/to/file"))
440 ;; Multihop.
441 (should
442 (string-equal
443 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
444 (format "/%s:%s@%s:" "method2" "user2" "host2")))
445 (should
446 (string-equal
447 (file-remote-p
448 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
449 "method2"))
450 (should
451 (string-equal
452 (file-remote-p
453 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
454 "user2"))
455 (should
456 (string-equal
457 (file-remote-p
458 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
459 "host2"))
460 (should
461 (string-equal
462 (file-remote-p
463 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
464 "/path/to/file"))
466 (should
467 (string-equal
468 (file-remote-p
469 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
470 (format "/%s:%s@%s:" "method3" "user3" "host3")))
471 (should
472 (string-equal
473 (file-remote-p
474 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
475 'method)
476 "method3"))
477 (should
478 (string-equal
479 (file-remote-p
480 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
481 'user)
482 "user3"))
483 (should
484 (string-equal
485 (file-remote-p
486 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
487 'host)
488 "host3"))
489 (should
490 (string-equal
491 (file-remote-p
492 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
493 'localname)
494 "/path/to/file"))))
496 (ert-deftest tramp-test03-file-name-defaults ()
497 "Check default values for some methods."
498 ;; Default values in tramp-adb.el.
499 (should (string-equal (file-remote-p "/adb::" 'host) ""))
500 ;; Default values in tramp-ftp.el.
501 (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
502 (dolist (u '("ftp" "anonymous"))
503 (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
504 ;; Default values in tramp-gvfs.el.
505 (when (and (load "tramp-gvfs" 'noerror 'nomessage)
506 (symbol-value 'tramp-gvfs-enabled))
507 (should (string-equal (file-remote-p "/synce::" 'user) nil)))
508 ;; Default values in tramp-gw.el.
509 (dolist (m '("tunnel" "socks"))
510 (should
511 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
512 ;; Default values in tramp-sh.el.
513 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
514 (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
515 (dolist (m '("su" "sudo" "ksu"))
516 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
517 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
518 (should
519 (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
520 ;; Default values in tramp-smb.el.
521 (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
522 (should (string-equal (file-remote-p "/smb::" 'user) nil)))
524 (ert-deftest tramp-test04-substitute-in-file-name ()
525 "Check `substitute-in-file-name'."
526 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
527 (should
528 (string-equal
529 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
530 (should
531 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
532 (should
533 (string-equal
534 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
535 (should
536 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
537 (let (process-environment)
538 (should
539 (string-equal
540 (substitute-in-file-name "/method:host:/path/$FOO")
541 "/method:host:/path/$FOO"))
542 (setenv "FOO" "bla")
543 (should
544 (string-equal
545 (substitute-in-file-name "/method:host:/path/$FOO")
546 "/method:host:/path/bla"))
547 (should
548 (string-equal
549 (substitute-in-file-name "/method:host:/path/$$FOO")
550 "/method:host:/path/$FOO"))))
552 (ert-deftest tramp-test05-expand-file-name ()
553 "Check `expand-file-name'."
554 (should
555 (string-equal
556 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
557 (should
558 (string-equal
559 (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
561 (ert-deftest tramp-test06-directory-file-name ()
562 "Check `directory-file-name'.
563 This checks also `file-name-as-directory', `file-name-directory',
564 `file-name-nondirectory' and `unhandled-file-name-directory'."
565 (should
566 (string-equal
567 (directory-file-name "/method:host:/path/to/file")
568 "/method:host:/path/to/file"))
569 (should
570 (string-equal
571 (directory-file-name "/method:host:/path/to/file/")
572 "/method:host:/path/to/file"))
573 (should
574 (string-equal
575 (file-name-as-directory "/method:host:/path/to/file")
576 "/method:host:/path/to/file/"))
577 (should
578 (string-equal
579 (file-name-as-directory "/method:host:/path/to/file/")
580 "/method:host:/path/to/file/"))
581 (should
582 (string-equal
583 (file-name-directory "/method:host:/path/to/file")
584 "/method:host:/path/to/"))
585 (should
586 (string-equal
587 (file-name-directory "/method:host:/path/to/file/")
588 "/method:host:/path/to/file/"))
589 (should
590 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
591 (should
592 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
593 (should-not
594 (unhandled-file-name-directory "/method:host:/path/to/file")))
596 (ert-deftest tramp-test07-file-exists-p ()
597 "Check `file-exist-p', `write-region' and `delete-file'."
598 (skip-unless (tramp--test-enabled))
600 (let ((tmp-name (tramp--test-make-temp-name)))
601 (should-not (file-exists-p tmp-name))
602 (write-region "foo" nil tmp-name)
603 (should (file-exists-p tmp-name))
604 (delete-file tmp-name)
605 (should-not (file-exists-p tmp-name))))
607 (ert-deftest tramp-test08-file-local-copy ()
608 "Check `file-local-copy'."
609 (skip-unless (tramp--test-enabled))
611 (let ((tmp-name1 (tramp--test-make-temp-name))
612 tmp-name2)
613 (unwind-protect
614 (progn
615 (write-region "foo" nil tmp-name1)
616 (should (setq tmp-name2 (file-local-copy tmp-name1)))
617 (with-temp-buffer
618 (insert-file-contents tmp-name2)
619 (should (string-equal (buffer-string) "foo")))
620 ;; Check also that a file transfer with compression works.
621 (let ((default-directory tramp-test-temporary-file-directory)
622 (tramp-copy-size-limit 4)
623 (tramp-inline-compress-start-size 2))
624 (delete-file tmp-name2)
625 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
626 (ignore-errors
627 (delete-file tmp-name1)
628 (delete-file tmp-name2)))))
630 (ert-deftest tramp-test09-insert-file-contents ()
631 "Check `insert-file-contents'."
632 (skip-unless (tramp--test-enabled))
634 (let ((tmp-name (tramp--test-make-temp-name)))
635 (unwind-protect
636 (progn
637 (write-region "foo" nil tmp-name)
638 (with-temp-buffer
639 (insert-file-contents tmp-name)
640 (should (string-equal (buffer-string) "foo"))
641 (insert-file-contents tmp-name)
642 (should (string-equal (buffer-string) "foofoo"))
643 ;; Insert partly.
644 (insert-file-contents tmp-name nil 1 3)
645 (should (string-equal (buffer-string) "oofoofoo"))
646 ;; Replace.
647 (insert-file-contents tmp-name nil nil nil 'replace)
648 (should (string-equal (buffer-string) "foo"))))
649 (ignore-errors (delete-file tmp-name)))))
651 (ert-deftest tramp-test10-write-region ()
652 "Check `write-region'."
653 (skip-unless (tramp--test-enabled))
655 (let ((tmp-name (tramp--test-make-temp-name)))
656 (unwind-protect
657 (progn
658 (with-temp-buffer
659 (insert "foo")
660 (write-region nil nil tmp-name))
661 (with-temp-buffer
662 (insert-file-contents tmp-name)
663 (should (string-equal (buffer-string) "foo")))
664 ;; Append.
665 (with-temp-buffer
666 (insert "bla")
667 (write-region nil nil tmp-name 'append))
668 (with-temp-buffer
669 (insert-file-contents tmp-name)
670 (should (string-equal (buffer-string) "foobla")))
671 ;; Write string.
672 (write-region "foo" nil tmp-name)
673 (with-temp-buffer
674 (insert-file-contents tmp-name)
675 (should (string-equal (buffer-string) "foo")))
676 ;; Write partly.
677 (with-temp-buffer
678 (insert "123456789")
679 (write-region 3 5 tmp-name))
680 (with-temp-buffer
681 (insert-file-contents tmp-name)
682 (should (string-equal (buffer-string) "34"))))
683 (ignore-errors (delete-file tmp-name)))))
685 (ert-deftest tramp-test11-copy-file ()
686 "Check `copy-file'."
687 (skip-unless (tramp--test-enabled))
689 (let ((tmp-name1 (tramp--test-make-temp-name))
690 (tmp-name2 (tramp--test-make-temp-name))
691 (tmp-name3 (tramp--test-make-temp-name))
692 (tmp-name4 (tramp--test-make-temp-name 'local))
693 (tmp-name5 (tramp--test-make-temp-name 'local)))
695 ;; Copy on remote side.
696 (unwind-protect
697 (progn
698 (write-region "foo" nil tmp-name1)
699 (copy-file tmp-name1 tmp-name2)
700 (should (file-exists-p tmp-name2))
701 (with-temp-buffer
702 (insert-file-contents tmp-name2)
703 (should (string-equal (buffer-string) "foo")))
704 (should-error (copy-file tmp-name1 tmp-name2))
705 (copy-file tmp-name1 tmp-name2 'ok)
706 (make-directory tmp-name3)
707 (copy-file tmp-name1 tmp-name3)
708 (should
709 (file-exists-p
710 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
711 (ignore-errors (delete-file tmp-name1))
712 (ignore-errors (delete-file tmp-name2))
713 (ignore-errors (delete-directory tmp-name3 'recursive)))
715 ;; Copy from remote side to local side.
716 (unwind-protect
717 (progn
718 (write-region "foo" nil tmp-name1)
719 (copy-file tmp-name1 tmp-name4)
720 (should (file-exists-p tmp-name4))
721 (with-temp-buffer
722 (insert-file-contents tmp-name4)
723 (should (string-equal (buffer-string) "foo")))
724 (should-error (copy-file tmp-name1 tmp-name4))
725 (copy-file tmp-name1 tmp-name4 'ok)
726 (make-directory tmp-name5)
727 (copy-file tmp-name1 tmp-name5)
728 (should
729 (file-exists-p
730 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
731 (ignore-errors (delete-file tmp-name1))
732 (ignore-errors (delete-file tmp-name4))
733 (ignore-errors (delete-directory tmp-name5 'recursive)))
735 ;; Copy from local side to remote side.
736 (unwind-protect
737 (progn
738 (write-region "foo" nil tmp-name4 nil 'nomessage)
739 (copy-file tmp-name4 tmp-name1)
740 (should (file-exists-p tmp-name1))
741 (with-temp-buffer
742 (insert-file-contents tmp-name1)
743 (should (string-equal (buffer-string) "foo")))
744 (should-error (copy-file tmp-name4 tmp-name1))
745 (copy-file tmp-name4 tmp-name1 'ok)
746 (make-directory tmp-name3)
747 (copy-file tmp-name4 tmp-name3)
748 (should
749 (file-exists-p
750 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
751 (ignore-errors (delete-file tmp-name1))
752 (ignore-errors (delete-file tmp-name4))
753 (ignore-errors (delete-directory tmp-name3 'recursive)))))
755 (ert-deftest tramp-test12-rename-file ()
756 "Check `rename-file'."
757 (skip-unless (tramp--test-enabled))
759 (let ((tmp-name1 (tramp--test-make-temp-name))
760 (tmp-name2 (tramp--test-make-temp-name))
761 (tmp-name3 (tramp--test-make-temp-name))
762 (tmp-name4 (tramp--test-make-temp-name 'local))
763 (tmp-name5 (tramp--test-make-temp-name 'local)))
765 ;; Rename on remote side.
766 (unwind-protect
767 (progn
768 (write-region "foo" nil tmp-name1)
769 (rename-file tmp-name1 tmp-name2)
770 (should-not (file-exists-p tmp-name1))
771 (should (file-exists-p tmp-name2))
772 (with-temp-buffer
773 (insert-file-contents tmp-name2)
774 (should (string-equal (buffer-string) "foo")))
775 (write-region "foo" nil tmp-name1)
776 (should-error (rename-file tmp-name1 tmp-name2))
777 (rename-file tmp-name1 tmp-name2 'ok)
778 (should-not (file-exists-p tmp-name1))
779 (write-region "foo" nil tmp-name1)
780 (make-directory tmp-name3)
781 (rename-file tmp-name1 tmp-name3)
782 (should-not (file-exists-p tmp-name1))
783 (should
784 (file-exists-p
785 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
786 (ignore-errors (delete-file tmp-name1))
787 (ignore-errors (delete-file tmp-name2))
788 (ignore-errors (delete-directory tmp-name3 'recursive)))
790 ;; Rename from remote side to local side.
791 (unwind-protect
792 (progn
793 (write-region "foo" nil tmp-name1)
794 (rename-file tmp-name1 tmp-name4)
795 (should-not (file-exists-p tmp-name1))
796 (should (file-exists-p tmp-name4))
797 (with-temp-buffer
798 (insert-file-contents tmp-name4)
799 (should (string-equal (buffer-string) "foo")))
800 (write-region "foo" nil tmp-name1)
801 (should-error (rename-file tmp-name1 tmp-name4))
802 (rename-file tmp-name1 tmp-name4 'ok)
803 (should-not (file-exists-p tmp-name1))
804 (write-region "foo" nil tmp-name1)
805 (make-directory tmp-name5)
806 (rename-file tmp-name1 tmp-name5)
807 (should-not (file-exists-p tmp-name1))
808 (should
809 (file-exists-p
810 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
811 (ignore-errors (delete-file tmp-name1))
812 (ignore-errors (delete-file tmp-name4))
813 (ignore-errors (delete-directory tmp-name5 'recursive)))
815 ;; Rename from local side to remote side.
816 (unwind-protect
817 (progn
818 (write-region "foo" nil tmp-name4 nil 'nomessage)
819 (rename-file tmp-name4 tmp-name1)
820 (should-not (file-exists-p tmp-name4))
821 (should (file-exists-p tmp-name1))
822 (with-temp-buffer
823 (insert-file-contents tmp-name1)
824 (should (string-equal (buffer-string) "foo")))
825 (write-region "foo" nil tmp-name4 nil 'nomessage)
826 (should-error (rename-file tmp-name4 tmp-name1))
827 (rename-file tmp-name4 tmp-name1 'ok)
828 (should-not (file-exists-p tmp-name4))
829 (write-region "foo" nil tmp-name4 nil 'nomessage)
830 (make-directory tmp-name3)
831 (rename-file tmp-name4 tmp-name3)
832 (should-not (file-exists-p tmp-name4))
833 (should
834 (file-exists-p
835 (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
836 (ignore-errors (delete-file tmp-name1))
837 (ignore-errors (delete-file tmp-name4))
838 (ignore-errors (delete-directory tmp-name3 'recursive)))))
840 (ert-deftest tramp-test13-make-directory ()
841 "Check `make-directory'.
842 This tests also `file-directory-p' and `file-accessible-directory-p'."
843 (skip-unless (tramp--test-enabled))
845 (let ((tmp-name (tramp--test-make-temp-name)))
846 (unwind-protect
847 (progn
848 (make-directory tmp-name)
849 (should (file-directory-p tmp-name))
850 (should (file-accessible-directory-p tmp-name))
851 (should-error
852 (make-directory (expand-file-name "foo/bar" tmp-name))
853 :type 'file-error)
854 (make-directory (expand-file-name "foo/bar" tmp-name) 'parents)
855 (should (file-directory-p (expand-file-name "foo/bar" tmp-name)))
856 (should
857 (file-accessible-directory-p (expand-file-name "foo/bar" tmp-name))))
858 (ignore-errors (delete-directory tmp-name)))))
860 (ert-deftest tramp-test14-delete-directory ()
861 "Check `delete-directory'."
862 (skip-unless (tramp--test-enabled))
864 (let ((tmp-name (tramp--test-make-temp-name)))
865 ;; Delete empty directory.
866 (make-directory tmp-name)
867 (should (file-directory-p tmp-name))
868 (delete-directory tmp-name)
869 (should-not (file-directory-p tmp-name))
870 ;; Delete non-empty directory.
871 (make-directory tmp-name)
872 (write-region "foo" nil (expand-file-name "bla" tmp-name))
873 (should-error (delete-directory tmp-name) :type 'file-error)
874 (delete-directory tmp-name 'recursive)
875 (should-not (file-directory-p tmp-name))))
877 (ert-deftest tramp-test15-copy-directory ()
878 "Check `copy-directory'."
879 (skip-unless (tramp--test-enabled))
880 (skip-unless
881 (not
883 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
884 'tramp-smb-file-name-handler)))
886 (let* ((tmp-name1 (tramp--test-make-temp-name))
887 (tmp-name2 (tramp--test-make-temp-name))
888 (tmp-name3 (expand-file-name
889 (file-name-nondirectory tmp-name1) tmp-name2))
890 (tmp-name4 (expand-file-name "foo" tmp-name1))
891 (tmp-name5 (expand-file-name "foo" tmp-name2))
892 (tmp-name6 (expand-file-name "foo" tmp-name3)))
893 (unwind-protect
894 (progn
895 ;; Copy empty directory.
896 (make-directory tmp-name1)
897 (write-region "foo" nil tmp-name4)
898 (should (file-directory-p tmp-name1))
899 (should (file-exists-p tmp-name4))
900 (copy-directory tmp-name1 tmp-name2)
901 (should (file-directory-p tmp-name2))
902 (should (file-exists-p tmp-name5))
903 ;; Target directory does exist already.
904 (copy-directory tmp-name1 tmp-name2)
905 (should (file-directory-p tmp-name3))
906 (should (file-exists-p tmp-name6)))
907 (ignore-errors
908 (delete-directory tmp-name1 'recursive)
909 (delete-directory tmp-name2 'recursive)))))
911 (ert-deftest tramp-test16-directory-files ()
912 "Check `directory-files'."
913 (skip-unless (tramp--test-enabled))
915 (let* ((tmp-name1 (tramp--test-make-temp-name))
916 (tmp-name2 (expand-file-name "bla" tmp-name1))
917 (tmp-name3 (expand-file-name "foo" tmp-name1)))
918 (unwind-protect
919 (progn
920 (make-directory tmp-name1)
921 (write-region "foo" nil tmp-name2)
922 (write-region "bla" nil tmp-name3)
923 (should (file-directory-p tmp-name1))
924 (should (file-exists-p tmp-name2))
925 (should (file-exists-p tmp-name3))
926 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
927 (should (equal (directory-files tmp-name1 'full)
928 `(,(concat tmp-name1 "/.")
929 ,(concat tmp-name1 "/..")
930 ,tmp-name2 ,tmp-name3)))
931 (should (equal (directory-files
932 tmp-name1 nil directory-files-no-dot-files-regexp)
933 '("bla" "foo")))
934 (should (equal (directory-files
935 tmp-name1 'full directory-files-no-dot-files-regexp)
936 `(,tmp-name2 ,tmp-name3))))
937 (ignore-errors (delete-directory tmp-name1 'recursive)))))
939 (ert-deftest tramp-test17-insert-directory ()
940 "Check `insert-directory'."
941 (skip-unless (tramp--test-enabled))
943 (let* ((tmp-name1 (tramp--test-make-temp-name))
944 (tmp-name2 (expand-file-name "foo" tmp-name1))
945 ;; We test for the summary line. Keyword "total" could be localized.
946 (process-environment
947 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
948 (unwind-protect
949 (progn
950 (make-directory tmp-name1)
951 (write-region "foo" nil tmp-name2)
952 (should (file-directory-p tmp-name1))
953 (should (file-exists-p tmp-name2))
954 (with-temp-buffer
955 (insert-directory tmp-name1 nil)
956 (goto-char (point-min))
957 (should (looking-at-p (regexp-quote tmp-name1))))
958 (with-temp-buffer
959 (insert-directory tmp-name1 "-al")
960 (goto-char (point-min))
961 (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
962 (with-temp-buffer
963 (insert-directory (file-name-as-directory tmp-name1) "-al")
964 (goto-char (point-min))
965 (should
966 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
967 (with-temp-buffer
968 (insert-directory
969 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
970 (goto-char (point-min))
971 (should
972 (looking-at-p
973 (concat
974 ;; There might be a summary line.
975 "\\(total.+[[:digit:]]+\n\\)?"
976 ;; We don't know in which order ".", ".." and "foo" appear.
977 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
978 (ignore-errors (delete-directory tmp-name1 'recursive)))))
980 (ert-deftest tramp-test18-file-attributes ()
981 "Check `file-attributes'.
982 This tests also `file-readable-p' and `file-regular-p'."
983 (skip-unless (tramp--test-enabled))
985 (let ((tmp-name (tramp--test-make-temp-name))
986 attr)
987 (unwind-protect
988 (progn
989 (write-region "foo" nil tmp-name)
990 (should (file-exists-p tmp-name))
991 (setq attr (file-attributes tmp-name))
992 (should (consp attr))
993 (should (file-exists-p tmp-name))
994 (should (file-readable-p tmp-name))
995 (should (file-regular-p tmp-name))
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.
1010 (setq attr (file-attributes tmp-name 'string))
1011 (should (stringp (nth 2 attr))) ;; Uid.
1012 (should (stringp (nth 3 attr))) ;; Gid.
1013 (delete-file tmp-name)
1015 (make-directory tmp-name)
1016 (should (file-exists-p tmp-name))
1017 (should (file-readable-p tmp-name))
1018 (should-not (file-regular-p tmp-name))
1019 (setq attr (file-attributes tmp-name))
1020 (should (eq (car attr) t)))
1021 (ignore-errors (delete-directory tmp-name)))))
1023 (ert-deftest tramp-test19-directory-files-and-attributes ()
1024 "Check `directory-files-and-attributes'."
1025 (skip-unless (tramp--test-enabled))
1027 ;; `directory-files-and-attributes' contains also values for "../".
1028 ;; Ensure that this doesn't change during tests, for
1029 ;; example due to handling temporary files.
1030 (let* ((tmp-name1 (tramp--test-make-temp-name))
1031 (tmp-name2 (expand-file-name "bla" tmp-name1))
1032 attr)
1033 (unwind-protect
1034 (progn
1035 (make-directory tmp-name1)
1036 (should (file-directory-p tmp-name1))
1037 (make-directory tmp-name2)
1038 (should (file-directory-p tmp-name2))
1039 (write-region "foo" nil (expand-file-name "foo" tmp-name2))
1040 (write-region "bar" nil (expand-file-name "bar" tmp-name2))
1041 (write-region "boz" nil (expand-file-name "boz" tmp-name2))
1042 (setq attr (directory-files-and-attributes tmp-name2))
1043 (should (consp attr))
1044 ;; Dumb remote shells without perl(1) or stat(1) are not
1045 ;; able to return the date correctly. They say "don't know".
1046 (dolist (elt attr)
1047 (unless
1048 (equal
1049 (nth 5
1050 (file-attributes (expand-file-name (car elt) tmp-name2)))
1051 '(0 0))
1052 (should
1053 (equal (file-attributes (expand-file-name (car elt) tmp-name2))
1054 (cdr elt)))))
1055 (setq attr (directory-files-and-attributes tmp-name2 'full))
1056 (dolist (elt attr)
1057 (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
1058 (should
1059 (equal (file-attributes (car elt)) (cdr elt)))))
1060 (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
1061 (should (equal (mapcar 'car attr) '("bar" "boz"))))
1062 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1064 (ert-deftest tramp-test20-file-modes ()
1065 "Check `file-modes'.
1066 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1067 (skip-unless (tramp--test-enabled))
1068 (skip-unless
1069 (not
1070 (memq
1071 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1072 '(tramp-adb-file-name-handler
1073 tramp-gvfs-file-name-handler
1074 tramp-smb-file-name-handler))))
1076 (let ((tmp-name (tramp--test-make-temp-name)))
1077 (unwind-protect
1078 (progn
1079 (write-region "foo" nil tmp-name)
1080 (should (file-exists-p tmp-name))
1081 (set-file-modes tmp-name #o777)
1082 (should (= (file-modes tmp-name) #o777))
1083 (should (file-executable-p tmp-name))
1084 (should (file-writable-p tmp-name))
1085 (set-file-modes tmp-name #o444)
1086 (should (= (file-modes tmp-name) #o444))
1087 (should-not (file-executable-p tmp-name))
1088 ;; A file is always writable for user "root".
1089 (unless (zerop (nth 2 (file-attributes tmp-name)))
1090 (should-not (file-writable-p tmp-name))))
1091 (ignore-errors (delete-file tmp-name)))))
1093 (ert-deftest tramp-test21-file-links ()
1094 "Check `file-symlink-p'.
1095 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1096 (skip-unless (tramp--test-enabled))
1098 ;; We must use `file-truename' for the temporary directory, because
1099 ;; it could be located on a symlinked directory. This would let the
1100 ;; test fail.
1101 (let* ((tramp-test-temporary-file-directory
1102 (file-truename tramp-test-temporary-file-directory))
1103 (tmp-name1 (tramp--test-make-temp-name))
1104 (tmp-name2 (tramp--test-make-temp-name))
1105 (tmp-name3 (tramp--test-make-temp-name 'local)))
1106 (unwind-protect
1107 (progn
1108 (write-region "foo" nil tmp-name1)
1109 (should (file-exists-p tmp-name1))
1110 ;; Method "smb" supports `make-symbolic-link' only if the
1111 ;; remote host has CIFS capabilities. tramp-adb.el and
1112 ;; tramp-gvfs.el do not support symbolic links at all.
1113 (condition-case err
1114 (make-symbolic-link tmp-name1 tmp-name2)
1115 (file-error
1116 (skip-unless
1117 (not (string-equal (error-message-string err)
1118 "make-symbolic-link not supported")))))
1119 (should (file-symlink-p tmp-name2))
1120 (should-error (make-symbolic-link tmp-name1 tmp-name2))
1121 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
1122 (should (file-symlink-p tmp-name2))
1123 ;; `tmp-name3' is a local file name.
1124 (should-error (make-symbolic-link tmp-name1 tmp-name3)))
1125 (ignore-errors
1126 (delete-file tmp-name1)
1127 (delete-file tmp-name2)))
1129 (unwind-protect
1130 (progn
1131 (write-region "foo" nil tmp-name1)
1132 (should (file-exists-p tmp-name1))
1133 (add-name-to-file tmp-name1 tmp-name2)
1134 (should-not (file-symlink-p tmp-name2))
1135 (should-error (add-name-to-file tmp-name1 tmp-name2))
1136 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
1137 (should-not (file-symlink-p tmp-name2))
1138 ;; `tmp-name3' is a local file name.
1139 (should-error (add-name-to-file tmp-name1 tmp-name3)))
1140 (ignore-errors
1141 (delete-file tmp-name1)
1142 (delete-file tmp-name2)))
1144 (unwind-protect
1145 (progn
1146 (write-region "foo" nil tmp-name1)
1147 (should (file-exists-p tmp-name1))
1148 (make-symbolic-link tmp-name1 tmp-name2)
1149 (should (file-symlink-p tmp-name2))
1150 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
1151 (should
1152 (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
1153 (should (file-equal-p tmp-name1 tmp-name2)))
1154 (ignore-errors
1155 (delete-file tmp-name1)
1156 (delete-file tmp-name2)))
1158 ;; `file-truename' shall preserve trailing link of directories.
1159 (unless (file-symlink-p tramp-test-temporary-file-directory)
1160 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
1161 (dir2 (file-name-as-directory dir1)))
1162 (should (string-equal (file-truename dir1) (expand-file-name dir1)))
1163 (should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
1165 (ert-deftest tramp-test22-file-times ()
1166 "Check `set-file-times' and `file-newer-than-file-p'."
1167 (skip-unless (tramp--test-enabled))
1168 (skip-unless
1169 (not
1170 (memq
1171 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1172 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1174 (let ((tmp-name1 (tramp--test-make-temp-name))
1175 (tmp-name2 (tramp--test-make-temp-name))
1176 (tmp-name3 (tramp--test-make-temp-name)))
1177 (unwind-protect
1178 (progn
1179 (write-region "foo" nil tmp-name1)
1180 (should (file-exists-p tmp-name1))
1181 (should (consp (nth 5 (file-attributes tmp-name1))))
1182 ;; '(0 0) means don't know, and will be replaced by
1183 ;; `current-time'. Therefore, we use '(0 1).
1184 ;; We skip the test, if the remote handler is not able to
1185 ;; set the correct time.
1186 (skip-unless (set-file-times tmp-name1 '(0 1)))
1187 ;; Dumb remote shells without perl(1) or stat(1) are not
1188 ;; able to return the date correctly. They say "don't know".
1189 (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
1190 (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1191 (write-region "bla" nil tmp-name2)
1192 (should (file-exists-p tmp-name2))
1193 (should (file-newer-than-file-p tmp-name2 tmp-name1))
1194 ;; `tmp-name3' does not exist.
1195 (should (file-newer-than-file-p tmp-name2 tmp-name3))
1196 (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
1197 (ignore-errors
1198 (delete-file tmp-name1)
1199 (delete-file tmp-name2)))))
1201 (ert-deftest tramp-test23-visited-file-modtime ()
1202 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1203 (skip-unless (tramp--test-enabled))
1205 (let ((tmp-name (tramp--test-make-temp-name)))
1206 (unwind-protect
1207 (progn
1208 (write-region "foo" nil tmp-name)
1209 (should (file-exists-p tmp-name))
1210 (with-temp-buffer
1211 (insert-file-contents tmp-name)
1212 (should (verify-visited-file-modtime))
1213 (set-visited-file-modtime '(0 1))
1214 (should (verify-visited-file-modtime))
1215 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1216 (ignore-errors (delete-file tmp-name)))))
1218 (ert-deftest tramp-test24-file-name-completion ()
1219 "Check `file-name-completion' and `file-name-all-completions'."
1220 (skip-unless (tramp--test-enabled))
1222 (let ((tmp-name (tramp--test-make-temp-name)))
1223 (unwind-protect
1224 (progn
1225 (make-directory tmp-name)
1226 (should (file-directory-p tmp-name))
1227 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1228 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1229 (make-directory (expand-file-name "boz" tmp-name))
1230 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1231 (should (equal (file-name-completion "b" tmp-name) "bo"))
1232 (should
1233 (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1234 (should (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1235 (should
1236 (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1237 '("bold" "boz/"))))
1238 (ignore-errors (delete-directory tmp-name 'recursive)))))
1240 (ert-deftest tramp-test25-load ()
1241 "Check `load'."
1242 (skip-unless (tramp--test-enabled))
1244 (let ((tmp-name (tramp--test-make-temp-name)))
1245 (unwind-protect
1246 (progn
1247 (load tmp-name 'noerror 'nomessage)
1248 (should-not (featurep 'tramp-test-load))
1249 (write-region "(provide 'tramp-test-load)" nil tmp-name)
1250 ;; `load' in lread.c does not pass `must-suffix'. Why?
1251 ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1252 (load tmp-name nil 'nomessage 'nosuffix)
1253 (should (featurep 'tramp-test-load)))
1254 (ignore-errors
1255 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1256 (delete-file tmp-name)))))
1258 (ert-deftest tramp-test26-process-file ()
1259 "Check `process-file'."
1260 (skip-unless (tramp--test-enabled))
1261 (skip-unless
1262 (not
1263 (memq
1264 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1265 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1267 (let* ((tmp-name (tramp--test-make-temp-name))
1268 (fnnd (file-name-nondirectory tmp-name))
1269 (default-directory tramp-test-temporary-file-directory)
1270 kill-buffer-query-functions)
1271 (unwind-protect
1272 (progn
1273 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1274 ;; do not exist on hydra.
1275 (should (zerop (process-file "true")))
1276 (should-not (zerop (process-file "false")))
1277 (should-not (zerop (process-file "binary-does-not-exist")))
1278 (with-temp-buffer
1279 (write-region "foo" nil tmp-name)
1280 (should (file-exists-p tmp-name))
1281 (should (zerop (process-file "ls" nil t nil fnnd)))
1282 ;; `ls' could produce colorized output.
1283 (goto-char (point-min))
1284 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1285 (replace-match "" nil nil))
1286 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1287 (should-not (get-buffer-window (current-buffer) t))
1289 ;; Second run. The output must be appended.
1290 (should (zerop (process-file "ls" nil t t fnnd)))
1291 ;; `ls' could produce colorized output.
1292 (goto-char (point-min))
1293 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1294 (replace-match "" nil nil))
1295 (should
1296 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
1297 ;; A non-nil DISPLAY must not raise the buffer.
1298 (should-not (get-buffer-window (current-buffer) t))))
1300 (ignore-errors (delete-file tmp-name)))))
1302 (ert-deftest tramp-test27-start-file-process ()
1303 "Check `start-file-process'."
1304 (skip-unless (tramp--test-enabled))
1305 (skip-unless
1306 (not
1307 (memq
1308 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1309 '(tramp-adb-file-name-handler
1310 tramp-gvfs-file-name-handler
1311 tramp-smb-file-name-handler))))
1313 (let ((default-directory tramp-test-temporary-file-directory)
1314 (tmp-name (tramp--test-make-temp-name))
1315 kill-buffer-query-functions proc)
1316 (unwind-protect
1317 (with-temp-buffer
1318 (setq proc (start-file-process "test1" (current-buffer) "cat"))
1319 (should (processp proc))
1320 (should (equal (process-status proc) 'run))
1321 (process-send-string proc "foo")
1322 (process-send-eof proc)
1323 ;; Read output.
1324 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1325 (while (< (- (point-max) (point-min)) (length "foo"))
1326 (accept-process-output proc 1)))
1327 (should (string-equal (buffer-string) "foo")))
1328 (ignore-errors (delete-process proc)))
1330 (unwind-protect
1331 (with-temp-buffer
1332 (write-region "foo" nil tmp-name)
1333 (should (file-exists-p tmp-name))
1334 (setq proc
1335 (start-file-process
1336 "test2" (current-buffer)
1337 "cat" (file-name-nondirectory tmp-name)))
1338 (should (processp proc))
1339 ;; Read output.
1340 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1341 (while (< (- (point-max) (point-min)) (length "foo"))
1342 (accept-process-output proc 1)))
1343 (should (string-equal (buffer-string) "foo")))
1344 (ignore-errors
1345 (delete-process proc)
1346 (delete-file tmp-name)))
1348 (unwind-protect
1349 (with-temp-buffer
1350 (setq proc (start-file-process "test3" (current-buffer) "cat"))
1351 (should (processp proc))
1352 (should (equal (process-status proc) 'run))
1353 (set-process-filter
1354 proc
1355 (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
1356 (process-send-string proc "foo")
1357 (process-send-eof proc)
1358 ;; Read output.
1359 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1360 (while (< (- (point-max) (point-min)) (length "foo"))
1361 (accept-process-output proc 1)))
1362 (should (string-equal (buffer-string) "foo")))
1363 (ignore-errors (delete-process proc)))))
1365 (ert-deftest tramp-test28-shell-command ()
1366 "Check `shell-command'."
1367 (skip-unless (tramp--test-enabled))
1368 (skip-unless
1369 (not
1370 (memq
1371 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1372 '(tramp-adb-file-name-handler
1373 tramp-gvfs-file-name-handler
1374 tramp-smb-file-name-handler))))
1376 (let ((tmp-name (tramp--test-make-temp-name))
1377 (default-directory tramp-test-temporary-file-directory)
1378 kill-buffer-query-functions)
1379 (unwind-protect
1380 (with-temp-buffer
1381 (write-region "foo" nil tmp-name)
1382 (should (file-exists-p tmp-name))
1383 (shell-command
1384 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1385 ;; `ls' could produce colorized output.
1386 (goto-char (point-min))
1387 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1388 (replace-match "" nil nil))
1389 (should
1390 (string-equal
1391 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1392 (ignore-errors (delete-file tmp-name)))
1394 (unwind-protect
1395 (with-temp-buffer
1396 (write-region "foo" nil tmp-name)
1397 (should (file-exists-p tmp-name))
1398 (async-shell-command
1399 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1400 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1401 ;; Read output.
1402 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1403 (while (< (- (point-max) (point-min))
1404 (1+ (length (file-name-nondirectory tmp-name))))
1405 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1406 ;; `ls' could produce colorized output.
1407 (goto-char (point-min))
1408 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1409 (replace-match "" nil nil))
1410 ;; There might be a nasty "Process *Async Shell* finished" message.
1411 (goto-char (point-min))
1412 (forward-line)
1413 (narrow-to-region (point-min) (point))
1414 (should
1415 (string-equal
1416 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1417 (ignore-errors (delete-file tmp-name)))
1419 (unwind-protect
1420 (with-temp-buffer
1421 (write-region "foo" nil tmp-name)
1422 (should (file-exists-p tmp-name))
1423 (async-shell-command "read line; ls $line" (current-buffer))
1424 (set-process-sentinel (get-buffer-process (current-buffer)) nil)
1425 (process-send-string
1426 (get-buffer-process (current-buffer))
1427 (format "%s\n" (file-name-nondirectory tmp-name)))
1428 ;; Read output.
1429 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1430 (while (< (- (point-max) (point-min))
1431 (1+ (length (file-name-nondirectory tmp-name))))
1432 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1433 ;; `ls' could produce colorized output.
1434 (goto-char (point-min))
1435 (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1436 (replace-match "" nil nil))
1437 ;; There might be a nasty "Process *Async Shell* finished" message.
1438 (goto-char (point-min))
1439 (forward-line)
1440 (narrow-to-region (point-min) (point))
1441 (should
1442 (string-equal
1443 (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1444 (ignore-errors (delete-file tmp-name)))))
1446 (ert-deftest tramp-test29-vc-registered ()
1447 "Check `vc-registered'."
1448 (skip-unless (tramp--test-enabled))
1449 (skip-unless
1451 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1452 'tramp-sh-file-name-handler))
1454 (let* ((default-directory tramp-test-temporary-file-directory)
1455 (tmp-name1 (tramp--test-make-temp-name))
1456 (tmp-name2 (expand-file-name "foo" tmp-name1))
1457 (tramp-remote-process-environment tramp-remote-process-environment)
1458 (vc-handled-backends
1459 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1460 (cond
1461 ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
1462 (setq tramp-remote-process-environment
1463 (cons (format "BZR_HOME=%s"
1464 (file-remote-p tmp-name1 'localname))
1465 tramp-remote-process-environment))
1466 ;; We must force a reconnect, in order to activate $BZR_HOME.
1467 (tramp-cleanup-connection
1468 (tramp-dissect-file-name tramp-test-temporary-file-directory)
1469 nil 'keep-password)
1470 '(Bzr))
1471 ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
1472 '(Git))
1473 ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
1474 '(Hg))
1475 (t nil)))))
1476 (skip-unless vc-handled-backends)
1477 (message "%s" vc-handled-backends)
1479 (unwind-protect
1480 (progn
1481 (make-directory tmp-name1)
1482 (write-region "foo" nil tmp-name2)
1483 (should (file-directory-p tmp-name1))
1484 (should (file-exists-p tmp-name2))
1485 (should-not (vc-registered tmp-name1))
1486 (should-not (vc-registered tmp-name2))
1488 (let ((default-directory tmp-name1))
1489 ;; Create empty repository, and register the file.
1490 (vc-create-repo (car vc-handled-backends))
1491 ;; The structure of VC-FILESET is not documented. Let's
1492 ;; hope it won't change.
1493 (condition-case nil
1494 (vc-register
1495 (list (car vc-handled-backends)
1496 (list (file-name-nondirectory tmp-name2))))
1497 ;; `vc-register' has changed its arguments in Emacs 25.1.
1498 (error
1499 (vc-register
1500 nil (list (car vc-handled-backends)
1501 (list (file-name-nondirectory tmp-name2)))))))
1502 (should (vc-registered tmp-name2)))
1504 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1506 (defun tramp--test-adb-p ()
1507 "Check, whether the remote host runs Android.
1508 This requires restrictions of file name syntax."
1509 (eq (tramp-find-foreign-file-name-handler
1510 tramp-test-temporary-file-directory)
1511 'tramp-adb-file-name-handler))
1513 (defun tramp--test-smb-or-windows-nt-p ()
1514 "Check, whether the locale or remote host runs MS Windows.
1515 This requires restrictions of file name syntax."
1516 (or (eq system-type 'windows-nt)
1517 (eq (tramp-find-foreign-file-name-handler
1518 tramp-test-temporary-file-directory)
1519 'tramp-smb-file-name-handler)))
1521 (defun tramp--test-check-files (&rest files)
1522 "Run a simple but comprehensive test over every file in FILES."
1523 (let ((tmp-name1 (tramp--test-make-temp-name))
1524 (tmp-name2 (tramp--test-make-temp-name 'local))
1525 (files (delq nil files)))
1526 (unwind-protect
1527 (progn
1528 (make-directory tmp-name1)
1529 (make-directory tmp-name2)
1530 (dolist (elt files)
1531 (let* ((file1 (expand-file-name elt tmp-name1))
1532 (file2 (expand-file-name elt tmp-name2))
1533 (file3 (concat file1 "foo")))
1534 (write-region elt nil file1)
1535 (should (file-exists-p file1))
1537 ;; Check file contents.
1538 (with-temp-buffer
1539 (insert-file-contents file1)
1540 (should (string-equal (buffer-string) elt)))
1542 ;; Copy file both directions.
1543 (copy-file file1 tmp-name2)
1544 (should (file-exists-p file2))
1545 (delete-file file1)
1546 (should-not (file-exists-p file1))
1547 (copy-file file2 tmp-name1)
1548 (should (file-exists-p file1))
1550 ;; Method "smb" supports `make-symbolic-link' only if the
1551 ;; remote host has CIFS capabilities. tramp-adb.el and
1552 ;; tramp-gvfs.el do not support symbolic links at all.
1553 (condition-case err
1554 (progn
1555 (make-symbolic-link file1 file3)
1556 (should (file-symlink-p file3))
1557 (should
1558 (string-equal
1559 (expand-file-name file1) (file-truename file3)))
1560 ;; Check file contents.
1561 (with-temp-buffer
1562 (insert-file-contents file3)
1563 (should (string-equal (buffer-string) elt)))
1564 (delete-file file3))
1565 (file-error
1566 (should (string-equal (error-message-string err)
1567 "make-symbolic-link not supported"))))))
1569 ;; Check file names.
1570 (should (equal (directory-files
1571 tmp-name1 nil directory-files-no-dot-files-regexp)
1572 (sort (copy-sequence files) 'string-lessp)))
1573 (should (equal (directory-files
1574 tmp-name2 nil directory-files-no-dot-files-regexp)
1575 (sort (copy-sequence files) 'string-lessp)))
1577 ;; `substitute-in-file-name' could return different values.
1578 ;; For `adb', there could be strange file permissions
1579 ;; preventing overwriting a file. We don't care in this
1580 ;; testcase.
1581 (dolist (elt files)
1582 (let ((file1
1583 (substitute-in-file-name (expand-file-name elt tmp-name1)))
1584 (file2
1585 (substitute-in-file-name (expand-file-name elt tmp-name2))))
1586 (ignore-errors (write-region elt nil file1))
1587 (should (file-exists-p file1))
1588 (ignore-errors (write-region elt nil file2 nil 'nomessage))
1589 (should (file-exists-p file2))))
1591 (should (equal (directory-files
1592 tmp-name1 nil directory-files-no-dot-files-regexp)
1593 (directory-files
1594 tmp-name2 nil directory-files-no-dot-files-regexp)))
1596 ;; Check directory creation. We use a subdirectory "foo"
1597 ;; in order to avoid conflicts with previous file name tests.
1598 (dolist (elt files)
1599 (let* ((file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1600 (file2 (expand-file-name elt file1)))
1601 (make-directory file1 'parents)
1602 (should (file-directory-p file1))
1603 (write-region elt nil file2)
1604 (should (file-exists-p file2))
1605 (should
1606 (equal
1607 (directory-files file1 nil directory-files-no-dot-files-regexp)
1608 `(,elt)))
1609 (should
1610 (equal
1611 (caar (directory-files-and-attributes
1612 file1 nil directory-files-no-dot-files-regexp))
1613 elt))
1614 (delete-file file2)
1615 (should-not (file-exists-p file2))
1616 (delete-directory file1)
1617 (should-not (file-exists-p file1)))))
1619 (ignore-errors (delete-directory tmp-name1 'recursive))
1620 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1622 (defun tramp--test-special-characters ()
1623 "Perform the test in `tramp-test30-special-characters*'."
1624 ;; Newlines, slashes and backslashes in file names are not
1625 ;; supported. So we don't test. And we don't test the tab
1626 ;; character on Windows or Cygwin, because the backslash is
1627 ;; interpreted as a path separator, preventing "\t" from being
1628 ;; expanded to <TAB>.
1629 (tramp--test-check-files
1630 (if (tramp--test-smb-or-windows-nt-p)
1631 "foo bar baz"
1632 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1633 " foo bar baz "
1634 " foo\tbar baz\t"))
1635 "$foo$bar$$baz$"
1636 "-foo-bar-baz-"
1637 "%foo%bar%baz%"
1638 "&foo&bar&baz&"
1639 (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?")
1640 (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*")
1641 (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"")
1642 "#foo~bar#baz~"
1643 (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|")
1644 (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;")
1645 (unless (tramp--test-smb-or-windows-nt-p) "<foo>bar<baz>")
1646 "(foo)bar(baz)"
1647 "[foo]bar[baz]"
1648 "{foo}bar{baz}"))
1650 ;; These tests are inspired by Bug#17238.
1651 (ert-deftest tramp-test30-special-characters ()
1652 "Check special characters in file names."
1653 (skip-unless (tramp--test-enabled))
1655 (tramp--test-special-characters))
1657 (ert-deftest tramp-test30-special-characters-with-stat ()
1658 "Check special characters in file names.
1659 Use the `stat' command."
1660 (skip-unless (tramp--test-enabled))
1661 (skip-unless
1663 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1664 'tramp-sh-file-name-handler))
1665 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1666 (skip-unless (tramp-get-remote-stat v)))
1668 (unwind-protect
1669 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1670 (tramp-set-connection-property v "perl" nil)
1671 (tramp--test-special-characters))
1672 ;; Reset suppressed properties.
1673 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1674 (tramp-set-connection-property v "perl" 'undef))))
1676 (ert-deftest tramp-test30-special-characters-with-perl ()
1677 "Check special characters in file names.
1678 Use the `perl' command."
1679 (skip-unless (tramp--test-enabled))
1680 (skip-unless
1682 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1683 'tramp-sh-file-name-handler))
1684 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1685 (skip-unless (tramp-get-remote-perl v)))
1687 (unwind-protect
1688 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1689 (tramp-set-connection-property v "stat" nil)
1690 (tramp--test-special-characters))
1691 ;; Reset suppressed properties.
1692 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1693 (tramp-set-connection-property v "stat" 'undef))))
1695 (ert-deftest tramp-test30-special-characters-with-ls ()
1696 "Check special characters in file names.
1697 Use the `ls' command."
1698 (skip-unless (tramp--test-enabled))
1699 (skip-unless
1701 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1702 'tramp-sh-file-name-handler))
1704 (unwind-protect
1705 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1706 (tramp-set-connection-property v "stat" nil)
1707 (tramp-set-connection-property v "perl" nil)
1708 (tramp--test-special-characters))
1709 ;; Reset suppressed properties.
1710 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1711 (tramp-set-connection-property v "stat" 'undef)
1712 (tramp-set-connection-property v "perl" 'undef))))
1714 (defun tramp--test-utf8 ()
1715 "Perform the test in `tramp-test31-utf8*'."
1716 (let ((coding-system-for-read 'utf-8)
1717 (coding-system-for-write 'utf-8)
1718 (file-name-coding-system 'utf-8))
1719 (tramp--test-check-files
1720 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1721 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1722 "银河系漫游指南系列"
1723 "Автостопом по гала́ктике")))
1725 (ert-deftest tramp-test31-utf8 ()
1726 "Check UTF8 encoding in file names and file contents."
1727 (skip-unless (tramp--test-enabled))
1728 (skip-unless (not (tramp--test-adb-p)))
1730 (tramp--test-utf8))
1732 (ert-deftest tramp-test31-utf8-with-stat ()
1733 "Check UTF8 encoding in file names and file contents.
1734 Use the `stat' command."
1735 (skip-unless (tramp--test-enabled))
1736 (skip-unless
1738 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1739 'tramp-sh-file-name-handler))
1740 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1741 (skip-unless (tramp-get-remote-stat v)))
1743 (unwind-protect
1744 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1745 (tramp-set-connection-property v "perl" nil)
1746 (tramp--test-utf8))
1747 ;; Reset suppressed properties.
1748 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1749 (tramp-set-connection-property v "perl" 'undef))))
1751 (ert-deftest tramp-test31-utf8-with-perl ()
1752 "Check UTF8 encoding in file names and file contents.
1753 Use the `perl' command."
1754 (skip-unless (tramp--test-enabled))
1755 (skip-unless
1757 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1758 'tramp-sh-file-name-handler))
1759 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1760 (skip-unless (tramp-get-remote-perl v)))
1762 (unwind-protect
1763 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1764 (tramp-set-connection-property v "stat" nil)
1765 (tramp--test-utf8))
1766 ;; Reset suppressed properties.
1767 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1768 (tramp-set-connection-property v "stat" 'undef))))
1770 (ert-deftest tramp-test31-utf8-with-ls ()
1771 "Check UTF8 encoding in file names and file contents.
1772 Use the `ls' command."
1773 (skip-unless (tramp--test-enabled))
1774 (skip-unless
1776 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1777 'tramp-sh-file-name-handler))
1779 (unwind-protect
1780 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1781 (tramp-set-connection-property v "stat" nil)
1782 (tramp-set-connection-property v "perl" nil)
1783 (tramp--test-utf8))
1784 ;; Reset suppressed properties.
1785 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1786 (tramp-set-connection-property v "stat" 'undef)
1787 (tramp-set-connection-property v "perl" 'undef))))
1789 ;; This test is inspired by Bug#16928.
1790 (ert-deftest tramp-test32-asynchronous-requests ()
1791 "Check parallel asynchronous requests.
1792 Such requests could arrive from timers, process filters and
1793 process sentinels. They shall not disturb each other."
1794 ;; Mark as failed until bug has been fixed.
1795 :expected-result :failed
1796 (skip-unless (tramp--test-enabled))
1797 (skip-unless
1799 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1800 'tramp-sh-file-name-handler))
1802 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
1803 ;; has the side effect, that this test fails instead to abort. Good
1804 ;; for hydra.
1805 (tramp--instrument-test-case 0
1806 (let* ((tmp-name (tramp--test-make-temp-name))
1807 (default-directory tmp-name)
1808 (remote-file-name-inhibit-cache t)
1809 timer buffers kill-buffer-query-functions)
1811 (unwind-protect
1812 (progn
1813 (make-directory tmp-name)
1815 ;; Setup a timer in order to raise an ordinary command again
1816 ;; and again. `vc-registered' is well suited, because there
1817 ;; are many checks.
1818 (setq
1819 timer
1820 (run-at-time
1822 (lambda ()
1823 (when buffers
1824 (vc-registered
1825 (buffer-name (nth (random (length buffers)) buffers)))))))
1827 ;; Create temporary buffers. The number of buffers
1828 ;; corresponds to the number of processes; it could be
1829 ;; increased in order to make pressure on Tramp.
1830 (dotimes (i 5)
1831 (add-to-list 'buffers (generate-new-buffer "*temp*")))
1833 ;; Open asynchronous processes. Set process sentinel.
1834 (dolist (buf buffers)
1835 (async-shell-command "read line; touch $line; echo $line" buf)
1836 (set-process-sentinel
1837 (get-buffer-process buf)
1838 (lambda (proc _state)
1839 (delete-file (buffer-name (process-buffer proc))))))
1841 ;; Send a string. Use a random order of the buffers. Mix
1842 ;; with regular operation.
1843 (let ((buffers (copy-sequence buffers))
1844 buf)
1845 (while buffers
1846 (setq buf (nth (random (length buffers)) buffers))
1847 (process-send-string
1848 (get-buffer-process buf) (format "'%s'\n" buf))
1849 (file-attributes (buffer-name buf))
1850 (setq buffers (delq buf buffers))))
1852 ;; Wait until the whole output has been read.
1853 (with-timeout ((* 10 (length buffers))
1854 (ert-fail "`async-shell-command' timed out"))
1855 (let ((buffers (copy-sequence buffers))
1856 buf)
1857 (while buffers
1858 (setq buf (nth (random (length buffers)) buffers))
1859 (if (ignore-errors
1860 (memq (process-status (get-buffer-process buf))
1861 '(run open)))
1862 (accept-process-output (get-buffer-process buf) 0.1)
1863 (setq buffers (delq buf buffers))))))
1865 ;; Check.
1866 (dolist (buf buffers)
1867 (with-current-buffer buf
1868 (should
1869 (string-equal (format "'%s'\n" buf) (buffer-string)))))
1870 (should-not
1871 (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
1873 ;; Cleanup.
1874 (ignore-errors (cancel-timer timer))
1875 (ignore-errors (delete-directory tmp-name 'recursive))
1876 (dolist (buf buffers)
1877 (ignore-errors (kill-buffer buf)))))))
1879 (ert-deftest tramp-test33-recursive-load ()
1880 "Check that Tramp does not fail due to recursive load."
1881 (skip-unless (tramp--test-enabled))
1883 (dolist (code
1884 (list
1885 (format
1886 "(expand-file-name %S)"
1887 tramp-test-temporary-file-directory)
1888 (format
1889 "(let ((default-directory %S)) (expand-file-name %S))"
1890 tramp-test-temporary-file-directory
1891 temporary-file-directory)))
1892 (should-not
1893 (string-match
1894 "Recursive load"
1895 (shell-command-to-string
1896 (format
1897 "%s -batch -Q -L %s --eval %s"
1898 (expand-file-name invocation-name invocation-directory)
1899 (mapconcat 'shell-quote-argument load-path " -L ")
1900 (shell-quote-argument code)))))))
1902 (ert-deftest tramp-test34-unload ()
1903 "Check that Tramp and its subpackages unload completely.
1904 Since it unloads Tramp, it shall be the last test to run."
1905 ;; Mark as failed until all symbols are unbound.
1906 :expected-result (if (featurep 'tramp) :failed :passed)
1907 (when (featurep 'tramp)
1908 (unload-feature 'tramp 'force)
1909 ;; No Tramp feature must be left.
1910 (should-not (featurep 'tramp))
1911 (should-not (all-completions "tramp" (delq 'tramp-tests features)))
1912 ;; `file-name-handler-alist' must be clean.
1913 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
1914 ;; There shouldn't be left a bound symbol. We do not regard our
1915 ;; test symbols, and the Tramp unload hooks.
1916 (mapatoms
1917 (lambda (x)
1918 (and (or (boundp x) (functionp x))
1919 (string-match "^tramp" (symbol-name x))
1920 (not (string-match "^tramp--?test" (symbol-name x)))
1921 (not (string-match "unload-hook$" (symbol-name x)))
1922 (ert-fail (format "`%s' still bound" x)))))
1923 ; (progn (message "`%s' still bound" x)))))
1924 ;; There shouldn't be left a hook function containing a Tramp
1925 ;; function. We do not regard the Tramp unload hooks.
1926 (mapatoms
1927 (lambda (x)
1928 (and (boundp x)
1929 (string-match "-hooks?$" (symbol-name x))
1930 (not (string-match "unload-hook$" (symbol-name x)))
1931 (consp (symbol-value x))
1932 (ignore-errors (all-completions "tramp" (symbol-value x)))
1933 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
1935 ;; TODO:
1937 ;; * dired-compress-file
1938 ;; * dired-uncache
1939 ;; * file-acl
1940 ;; * file-ownership-preserved-p
1941 ;; * file-selinux-context
1942 ;; * find-backup-file-name
1943 ;; * make-auto-save-file-name
1944 ;; * set-file-acl
1945 ;; * set-file-selinux-context
1947 ;; * Work on skipped tests. Make a comment, when it is impossible.
1948 ;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe
1949 ;; doesn't work well when an interactive password must be provided.
1950 ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
1951 ;; Windows (`process-send-eof'?).
1952 ;; * Fix `tramp-test30-special-characters' for `nc'.
1953 ;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
1954 ;; busybox). Seems to be in `directory-files'.
1955 ;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
1956 ;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
1957 ;; expected error.
1959 (defun tramp-test-all (&optional interactive)
1960 "Run all tests for \\[tramp]."
1961 (interactive "p")
1962 (funcall
1963 (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
1965 (provide 'tramp-tests)
1966 ;;; tramp-tests.el ends here