1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2017 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/'.
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'.
47 (autoload 'dired-uncache
"dired")
48 (declare-function tramp-find-executable
"tramp-sh")
49 (declare-function tramp-get-remote-path
"tramp-sh")
50 (declare-function tramp-get-remote-stat
"tramp-sh")
51 (declare-function tramp-get-remote-perl
"tramp-sh")
52 (defvar tramp-copy-size-limit
)
53 (defvar tramp-persistency-file-name
)
54 (defvar tramp-remote-process-environment
)
56 ;; There is no default value on w32 systems, which could work out of the box.
57 (defconst tramp-test-temporary-file-directory
59 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
60 ((eq system-type
'windows-nt
) null-device
)
64 (tramp-login-program "sh")
65 (tramp-login-args (("-i")))
66 (tramp-remote-shell "/bin/sh")
67 (tramp-remote-shell-args ("-c"))
68 (tramp-connection-timeout 10)))
69 (format "/mock::%s" temporary-file-directory
)))
70 "Temporary directory for Tramp tests.")
72 (setq password-cache-expiry nil
74 tramp-copy-size-limit nil
75 tramp-message-show-message nil
76 tramp-persistency-file-name nil
)
78 ;; This shall happen on hydra only.
79 (when (getenv "NIX_STORE")
80 (add-to-list 'tramp-remote-path
'tramp-own-remote-path
))
82 (defvar tramp--test-expensive-test
84 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
85 "Whether expensive tests are run.")
87 (defvar tramp--test-enabled-checked nil
88 "Cached result of `tramp--test-enabled'.
89 If the function did run, the value is a cons cell, the `cdr'
92 (defun tramp--test-enabled ()
93 "Whether remote file access is enabled."
94 (unless (consp tramp--test-enabled-checked
)
96 tramp--test-enabled-checked
100 (file-remote-p tramp-test-temporary-file-directory
)
101 (file-directory-p tramp-test-temporary-file-directory
)
102 (file-writable-p tramp-test-temporary-file-directory
))))))
104 (when (cdr tramp--test-enabled-checked
)
105 ;; Cleanup connection.
107 (tramp-cleanup-connection
108 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
109 nil
'keep-password
)))
112 (cdr tramp--test-enabled-checked
))
114 (defun tramp--test-make-temp-name (&optional local quoted
)
115 "Create a temporary file name for test.
116 If LOCAL is non-nil, a local file is created.
117 If QUOTED is non-nil, the local part of the file is quoted."
119 (if quoted
'tramp-compat-file-name-quote
'identity
)
121 (make-temp-name "tramp-test")
122 (if local temporary-file-directory tramp-test-temporary-file-directory
))))
124 (defmacro tramp--instrument-test-case
(verbose &rest body
)
125 "Run BODY with `tramp-verbose' equal VERBOSE.
126 Print the the content of the Tramp debug buffer, if BODY does not
127 eval properly in `should' or `should-not'. `should-error' is not
128 handled properly. BODY shall not contain a timeout."
129 (declare (indent 1) (debug (natnump body
)))
130 `(let ((tramp-verbose ,verbose
)
131 (tramp-debug-on-error t
)
132 (debug-ignored-errors
133 (cons "^make-symbolic-link not supported$" debug-ignored-errors
)))
136 (when (> tramp-verbose
3)
137 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
138 (with-current-buffer (tramp-get-connection-buffer v
)
139 (message "%s" (buffer-string)))
140 (with-current-buffer (tramp-get-debug-buffer v
)
141 (message "%s" (buffer-string))))))))
143 (ert-deftest tramp-test00-availability
()
144 "Test availability of Tramp functions."
145 :expected-result
(if (tramp--test-enabled) :passed
:failed
)
146 (message "Remote directory: `%s'" tramp-test-temporary-file-directory
)
147 (should (ignore-errors
149 (file-remote-p tramp-test-temporary-file-directory
)
150 (file-directory-p tramp-test-temporary-file-directory
)
151 (file-writable-p tramp-test-temporary-file-directory
)))))
153 (ert-deftest tramp-test01-file-name-syntax
()
154 "Check remote file name syntax."
156 (should (tramp-tramp-file-p "/method::"))
157 (should (tramp-tramp-file-p "/host:"))
158 (should (tramp-tramp-file-p "/user@:"))
159 (should (tramp-tramp-file-p "/user@host:"))
160 (should (tramp-tramp-file-p "/method:host:"))
161 (should (tramp-tramp-file-p "/method:user@:"))
162 (should (tramp-tramp-file-p "/method:user@host:"))
163 (should (tramp-tramp-file-p "/method:user@email@host:"))
166 (should (tramp-tramp-file-p "/host#1234:"))
167 (should (tramp-tramp-file-p "/user@host#1234:"))
168 (should (tramp-tramp-file-p "/method:host#1234:"))
169 (should (tramp-tramp-file-p "/method:user@host#1234:"))
171 ;; Using an IPv4 address.
172 (should (tramp-tramp-file-p "/1.2.3.4:"))
173 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
174 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
175 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
177 ;; Using an IPv6 address.
178 (should (tramp-tramp-file-p "/[]:"))
179 (should (tramp-tramp-file-p "/[::1]:"))
180 (should (tramp-tramp-file-p "/user@[::1]:"))
181 (should (tramp-tramp-file-p "/method:[::1]:"))
182 (should (tramp-tramp-file-p "/method:user@[::1]:"))
184 ;; Local file name part.
185 (should (tramp-tramp-file-p "/host:/:"))
186 (should (tramp-tramp-file-p "/method:::"))
187 (should (tramp-tramp-file-p "/method::/:"))
188 (should (tramp-tramp-file-p "/method::/path/to/file"))
189 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
190 (should (tramp-tramp-file-p "/method::file"))
191 (should (tramp-tramp-file-p "/method::/:file"))
194 (should (tramp-tramp-file-p "/method1:|method2::"))
195 (should (tramp-tramp-file-p "/method1:host1|host2:"))
196 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
197 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
198 (should (tramp-tramp-file-p
199 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
200 (should (tramp-tramp-file-p "/host1|host2:"))
201 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
204 (should-not (tramp-tramp-file-p nil
))
205 (should-not (tramp-tramp-file-p 'symbol
))
206 ;; Quote with "/:" suppresses file name handlers.
207 (should-not (tramp-tramp-file-p "/::"))
208 (should-not (tramp-tramp-file-p "/:@:"))
209 (should-not (tramp-tramp-file-p "/:[]:"))
210 ;; Methods or host names shall be at least two characters on MS Windows.
211 (let ((system-type 'windows-nt
))
212 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
213 (should-not (tramp-tramp-file-p "/c::/path/to/file")))
214 (let ((system-type 'gnu
/linux
))
215 (should (tramp-tramp-file-p "/h:/path/to/file"))
216 (should (tramp-tramp-file-p "/m::/path/to/file"))))
218 (ert-deftest tramp-test02-file-name-dissect
()
219 "Check remote file name components."
220 (let ((tramp-default-method "default-method")
221 (tramp-default-user "default-user")
222 (tramp-default-host "default-host"))
223 ;; Expand `tramp-default-user' and `tramp-default-host'.
224 (should (string-equal
225 (file-remote-p "/method::")
226 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
227 (should (string-equal (file-remote-p "/method::" 'method
) "method"))
228 (should (string-equal (file-remote-p "/method::" 'user
) "default-user"))
229 (should (string-equal (file-remote-p "/method::" 'host
) "default-host"))
230 (should (string-equal (file-remote-p "/method::" 'localname
) ""))
231 (should (string-equal (file-remote-p "/method::" 'hop
) nil
))
233 ;; Expand `tramp-default-method' and `tramp-default-user'.
234 (should (string-equal
235 (file-remote-p "/host:")
236 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
237 (should (string-equal (file-remote-p "/host:" 'method
) "default-method"))
238 (should (string-equal (file-remote-p "/host:" 'user
) "default-user"))
239 (should (string-equal (file-remote-p "/host:" 'host
) "host"))
240 (should (string-equal (file-remote-p "/host:" 'localname
) ""))
241 (should (string-equal (file-remote-p "/host:" 'hop
) nil
))
243 ;; Expand `tramp-default-method' and `tramp-default-host'.
244 (should (string-equal
245 (file-remote-p "/user@:")
246 (format "/%s:%s@%s:" "default-method""user" "default-host")))
247 (should (string-equal (file-remote-p "/user@:" 'method
) "default-method"))
248 (should (string-equal (file-remote-p "/user@:" 'user
) "user"))
249 (should (string-equal (file-remote-p "/user@:" 'host
) "default-host"))
250 (should (string-equal (file-remote-p "/user@:" 'localname
) ""))
251 (should (string-equal (file-remote-p "/user@:" 'hop
) nil
))
253 ;; Expand `tramp-default-method'.
254 (should (string-equal
255 (file-remote-p "/user@host:")
256 (format "/%s:%s@%s:" "default-method" "user" "host")))
257 (should (string-equal
258 (file-remote-p "/user@host:" 'method
) "default-method"))
259 (should (string-equal (file-remote-p "/user@host:" 'user
) "user"))
260 (should (string-equal (file-remote-p "/user@host:" 'host
) "host"))
261 (should (string-equal (file-remote-p "/user@host:" 'localname
) ""))
262 (should (string-equal (file-remote-p "/user@host:" 'hop
) nil
))
264 ;; Expand `tramp-default-user'.
265 (should (string-equal
266 (file-remote-p "/method:host:")
267 (format "/%s:%s@%s:" "method" "default-user" "host")))
268 (should (string-equal (file-remote-p "/method:host:" 'method
) "method"))
269 (should (string-equal (file-remote-p "/method:host:" 'user
) "default-user"))
270 (should (string-equal (file-remote-p "/method:host:" 'host
) "host"))
271 (should (string-equal (file-remote-p "/method:host:" 'localname
) ""))
272 (should (string-equal (file-remote-p "/method:host:" 'hop
) nil
))
274 ;; Expand `tramp-default-host'.
275 (should (string-equal
276 (file-remote-p "/method:user@:")
277 (format "/%s:%s@%s:" "method" "user" "default-host")))
278 (should (string-equal (file-remote-p "/method:user@:" 'method
) "method"))
279 (should (string-equal (file-remote-p "/method:user@:" 'user
) "user"))
280 (should (string-equal (file-remote-p "/method:user@:" 'host
)
282 (should (string-equal (file-remote-p "/method:user@:" 'localname
) ""))
283 (should (string-equal (file-remote-p "/method:user@:" 'hop
) nil
))
286 (should (string-equal
287 (file-remote-p "/method:user@host:")
288 (format "/%s:%s@%s:" "method" "user" "host")))
289 (should (string-equal
290 (file-remote-p "/method:user@host:" 'method
) "method"))
291 (should (string-equal (file-remote-p "/method:user@host:" 'user
) "user"))
292 (should (string-equal (file-remote-p "/method:user@host:" 'host
) "host"))
293 (should (string-equal (file-remote-p "/method:user@host:" 'localname
) ""))
294 (should (string-equal (file-remote-p "/method:user@host:" 'hop
) nil
))
297 (should (string-equal
298 (file-remote-p "/method:user@email@host:")
299 (format "/%s:%s@%s:" "method" "user@email" "host")))
300 (should (string-equal
301 (file-remote-p "/method:user@email@host:" 'method
) "method"))
302 (should (string-equal
303 (file-remote-p "/method:user@email@host:" 'user
) "user@email"))
304 (should (string-equal
305 (file-remote-p "/method:user@email@host:" 'host
) "host"))
306 (should (string-equal
307 (file-remote-p "/method:user@email@host:" 'localname
) ""))
308 (should (string-equal
309 (file-remote-p "/method:user@email@host:" 'hop
) nil
))
311 ;; Expand `tramp-default-method' and `tramp-default-user'.
312 (should (string-equal
313 (file-remote-p "/host#1234:")
314 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
315 (should (string-equal
316 (file-remote-p "/host#1234:" 'method
) "default-method"))
317 (should (string-equal (file-remote-p "/host#1234:" 'user
) "default-user"))
318 (should (string-equal (file-remote-p "/host#1234:" 'host
) "host#1234"))
319 (should (string-equal (file-remote-p "/host#1234:" 'localname
) ""))
320 (should (string-equal (file-remote-p "/host#1234:" 'hop
) nil
))
322 ;; Expand `tramp-default-method'.
323 (should (string-equal
324 (file-remote-p "/user@host#1234:")
325 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
326 (should (string-equal
327 (file-remote-p "/user@host#1234:" 'method
) "default-method"))
328 (should (string-equal (file-remote-p "/user@host#1234:" 'user
) "user"))
329 (should (string-equal (file-remote-p "/user@host#1234:" 'host
) "host#1234"))
330 (should (string-equal (file-remote-p "/user@host#1234:" 'localname
) ""))
331 (should (string-equal (file-remote-p "/user@host#1234:" 'hop
) nil
))
333 ;; Expand `tramp-default-user'.
334 (should (string-equal
335 (file-remote-p "/method:host#1234:")
336 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
337 (should (string-equal
338 (file-remote-p "/method:host#1234:" 'method
) "method"))
339 (should (string-equal
340 (file-remote-p "/method:host#1234:" 'user
) "default-user"))
341 (should (string-equal
342 (file-remote-p "/method:host#1234:" 'host
) "host#1234"))
343 (should (string-equal (file-remote-p "/method:host#1234:" 'localname
) ""))
344 (should (string-equal (file-remote-p "/method:host#1234:" 'hop
) nil
))
347 (should (string-equal
348 (file-remote-p "/method:user@host#1234:")
349 (format "/%s:%s@%s:" "method" "user" "host#1234")))
350 (should (string-equal
351 (file-remote-p "/method:user@host#1234:" 'method
) "method"))
352 (should (string-equal
353 (file-remote-p "/method:user@host#1234:" 'user
) "user"))
354 (should (string-equal
355 (file-remote-p "/method:user@host#1234:" 'host
) "host#1234"))
356 (should (string-equal
357 (file-remote-p "/method:user@host#1234:" 'localname
) ""))
358 (should (string-equal
359 (file-remote-p "/method:user@host#1234:" 'hop
) nil
))
361 ;; Expand `tramp-default-method' and `tramp-default-user'.
362 (should (string-equal
363 (file-remote-p "/1.2.3.4:")
364 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
365 (should (string-equal (file-remote-p "/1.2.3.4:" 'method
) "default-method"))
366 (should (string-equal (file-remote-p "/1.2.3.4:" 'user
) "default-user"))
367 (should (string-equal (file-remote-p "/1.2.3.4:" 'host
) "1.2.3.4"))
368 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname
) ""))
369 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop
) nil
))
371 ;; Expand `tramp-default-method'.
372 (should (string-equal
373 (file-remote-p "/user@1.2.3.4:")
374 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
375 (should (string-equal
376 (file-remote-p "/user@1.2.3.4:" 'method
) "default-method"))
377 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user
) "user"))
378 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host
) "1.2.3.4"))
379 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname
) ""))
380 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop
) nil
))
382 ;; Expand `tramp-default-user'.
383 (should (string-equal
384 (file-remote-p "/method:1.2.3.4:")
385 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
386 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method
) "method"))
387 (should (string-equal
388 (file-remote-p "/method:1.2.3.4:" 'user
) "default-user"))
389 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host
) "1.2.3.4"))
390 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname
) ""))
391 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop
) nil
))
394 (should (string-equal
395 (file-remote-p "/method:user@1.2.3.4:")
396 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
397 (should (string-equal
398 (file-remote-p "/method:user@1.2.3.4:" 'method
) "method"))
399 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user
) "user"))
400 (should (string-equal
401 (file-remote-p "/method:user@1.2.3.4:" 'host
) "1.2.3.4"))
402 (should (string-equal
403 (file-remote-p "/method:user@1.2.3.4:" 'localname
) ""))
404 (should (string-equal
405 (file-remote-p "/method:user@1.2.3.4:" 'hop
) nil
))
407 ;; Expand `tramp-default-method', `tramp-default-user' and
408 ;; `tramp-default-host'.
409 (should (string-equal
410 (file-remote-p "/[]:")
412 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
413 (should (string-equal (file-remote-p "/[]:" 'method
) "default-method"))
414 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
415 (should (string-equal (file-remote-p "/[]:" 'host
) "default-host"))
416 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
417 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
))
419 ;; Expand `tramp-default-method' and `tramp-default-user'.
420 (let ((tramp-default-host "::1"))
421 (should (string-equal
422 (file-remote-p "/[]:")
423 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
424 (should (string-equal (file-remote-p "/[]:" 'method
) "default-method"))
425 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
426 (should (string-equal (file-remote-p "/[]:" 'host
) "::1"))
427 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
428 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
)))
430 ;; Expand `tramp-default-method' and `tramp-default-user'.
431 (should (string-equal
432 (file-remote-p "/[::1]:")
433 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
434 (should (string-equal (file-remote-p "/[::1]:" 'method
) "default-method"))
435 (should (string-equal (file-remote-p "/[::1]:" 'user
) "default-user"))
436 (should (string-equal (file-remote-p "/[::1]:" 'host
) "::1"))
437 (should (string-equal (file-remote-p "/[::1]:" 'localname
) ""))
438 (should (string-equal (file-remote-p "/[::1]:" 'hop
) nil
))
440 ;; Expand `tramp-default-method'.
441 (should (string-equal
442 (file-remote-p "/user@[::1]:")
443 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
444 (should (string-equal
445 (file-remote-p "/user@[::1]:" 'method
) "default-method"))
446 (should (string-equal (file-remote-p "/user@[::1]:" 'user
) "user"))
447 (should (string-equal (file-remote-p "/user@[::1]:" 'host
) "::1"))
448 (should (string-equal (file-remote-p "/user@[::1]:" 'localname
) ""))
449 (should (string-equal (file-remote-p "/user@[::1]:" 'hop
) nil
))
451 ;; Expand `tramp-default-user'.
452 (should (string-equal
453 (file-remote-p "/method:[::1]:")
454 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
455 (should (string-equal (file-remote-p "/method:[::1]:" 'method
) "method"))
456 (should (string-equal
457 (file-remote-p "/method:[::1]:" 'user
) "default-user"))
458 (should (string-equal (file-remote-p "/method:[::1]:" 'host
) "::1"))
459 (should (string-equal (file-remote-p "/method:[::1]:" 'localname
) ""))
460 (should (string-equal (file-remote-p "/method:[::1]:" 'hop
) nil
))
463 (should (string-equal
464 (file-remote-p "/method:user@[::1]:")
465 (format "/%s:%s@%s:" "method" "user" "[::1]")))
466 (should (string-equal
467 (file-remote-p "/method:user@[::1]:" 'method
) "method"))
468 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user
) "user"))
469 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host
) "::1"))
470 (should (string-equal
471 (file-remote-p "/method:user@[::1]:" 'localname
) ""))
472 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop
) nil
))
474 ;; Local file name part.
475 (should (string-equal (file-remote-p "/host:/:" 'localname
) "/:"))
476 (should (string-equal (file-remote-p "/method:::" 'localname
) ":"))
477 (should (string-equal (file-remote-p "/method:: " 'localname
) " "))
478 (should (string-equal (file-remote-p "/method::file" 'localname
) "file"))
479 (should (string-equal
480 (file-remote-p "/method::/path/to/file" 'localname
)
486 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
487 (format "/%s:%s@%s|%s:%s@%s:"
488 "method1" "user1" "host1" "method2" "user2" "host2")))
492 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method
)
497 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user
)
502 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host
)
507 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname
)
512 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop
)
514 "method1" "user1" "host1")))
520 "/method1:user1@host1"
521 "|method2:user2@host2"
522 "|method3:user3@host3:/path/to/file"))
523 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
524 "method1" "user1" "host1"
525 "method2" "user2" "host2"
526 "method3" "user3" "host3")))
531 "/method1:user1@host1"
532 "|method2:user2@host2"
533 "|method3:user3@host3:/path/to/file")
540 "/method1:user1@host1"
541 "|method2:user2@host2"
542 "|method3:user3@host3:/path/to/file")
549 "/method1:user1@host1"
550 "|method2:user2@host2"
551 "|method3:user3@host3:/path/to/file")
558 "/method1:user1@host1"
559 "|method2:user2@host2"
560 "|method3:user3@host3:/path/to/file")
567 "/method1:user1@host1"
568 "|method2:user2@host2"
569 "|method3:user3@host3:/path/to/file")
571 (format "%s:%s@%s|%s:%s@%s|"
572 "method1" "user1" "host1" "method2" "user2" "host2")))))
574 (ert-deftest tramp-test03-file-name-defaults
()
575 "Check default values for some methods."
576 ;; Default values in tramp-adb.el.
577 (should (string-equal (file-remote-p "/adb::" 'host
) ""))
578 ;; Default values in tramp-ftp.el.
579 (should (string-equal (file-remote-p "/ftp.host:" 'method
) "ftp"))
580 (dolist (u '("ftp" "anonymous"))
581 (should (string-equal (file-remote-p (format "/%s@:" u
) 'method
) "ftp")))
582 ;; Default values in tramp-gvfs.el.
583 (when (and (load "tramp-gvfs" 'noerror
'nomessage
)
584 (symbol-value 'tramp-gvfs-enabled
))
585 (should (string-equal (file-remote-p "/synce::" 'user
) nil
)))
586 ;; Default values in tramp-sh.el.
587 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
588 (should (string-equal (file-remote-p (format "/root@%s:" h
) 'method
) "su")))
589 (dolist (m '("su" "sudo" "ksu"))
590 (should (string-equal (file-remote-p (format "/%s::" m
) 'user
) "root")))
591 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
593 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
594 ;; Default values in tramp-smb.el.
595 (should (string-equal (file-remote-p "/user%domain@host:" 'method
) "smb"))
596 (should (string-equal (file-remote-p "/smb::" 'user
) nil
)))
598 (ert-deftest tramp-test04-substitute-in-file-name
()
599 "Check `substitute-in-file-name'."
600 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
603 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
605 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
606 ;; Quoting local part.
609 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
612 (substitute-in-file-name "/method:host:/:/path//foo")
613 "/method:host:/:/path//foo"))
616 (substitute-in-file-name "/method:host:/:/path///foo")
617 "/method:host:/:/path///foo"))
621 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
623 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
624 ;; Quoting local part.
627 (substitute-in-file-name "/method:host:/:/path/~/foo")
628 "/method:host:/:/path/~/foo"))
631 (substitute-in-file-name "/method:host:/:/path//~/foo")
632 "/method:host:/:/path//~/foo"))
634 (let (process-environment)
637 (substitute-in-file-name "/method:host:/path/$FOO")
638 "/method:host:/path/$FOO"))
642 (substitute-in-file-name "/method:host:/path/$FOO")
643 "/method:host:/path/bla"))
646 (substitute-in-file-name "/method:host:/path/$$FOO")
647 "/method:host:/path/$FOO"))
648 ;; Quoting local part.
651 (substitute-in-file-name "/method:host:/:/path/$FOO")
652 "/method:host:/:/path/$FOO"))
656 (substitute-in-file-name "/method:host:/:/path/$FOO")
657 "/method:host:/:/path/$FOO"))
660 (substitute-in-file-name "/method:host:/:/path/$$FOO")
661 "/method:host:/:/path/$$FOO"))))
663 (ert-deftest tramp-test05-expand-file-name
()
664 "Check `expand-file-name'."
667 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
670 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
671 ;; Quoting local part.
674 (expand-file-name "/method:host:/:/path/./file")
675 "/method:host:/:/path/file"))
678 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
681 (expand-file-name "/method:host:/:/~/path/./file")
682 "/method:host:/:/~/path/file")))
684 (ert-deftest tramp-test06-directory-file-name
()
685 "Check `directory-file-name'.
686 This checks also `file-name-as-directory', `file-name-directory',
687 `file-name-nondirectory' and `unhandled-file-name-directory'."
690 (directory-file-name "/method:host:/path/to/file")
691 "/method:host:/path/to/file"))
694 (directory-file-name "/method:host:/path/to/file/")
695 "/method:host:/path/to/file"))
698 (file-name-as-directory "/method:host:/path/to/file")
699 "/method:host:/path/to/file/"))
702 (file-name-as-directory "/method:host:/path/to/file/")
703 "/method:host:/path/to/file/"))
706 (file-name-directory "/method:host:/path/to/file")
707 "/method:host:/path/to/"))
710 (file-name-directory "/method:host:/path/to/file/")
711 "/method:host:/path/to/file/"))
713 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
715 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
717 (unhandled-file-name-directory "/method:host:/path/to/file"))
720 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
721 (dolist (n-e '(nil t
))
722 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
723 ;; which ruins the tests.
724 (let ((non-essential n-e
)
725 tramp-default-method
)
727 `(,(file-remote-p tramp-test-temporary-file-directory
'method
)
728 ,(file-remote-p tramp-test-temporary-file-directory
'host
)))
729 (unless (zerop (length file
))
730 (setq file
(format "/%s:" file
))
731 (should (string-equal (directory-file-name file
) file
))
734 (file-name-as-directory file
)
735 (if (tramp-completion-mode-p) file
(concat file
"./"))))
736 (should (string-equal (file-name-directory file
) file
))
737 (should (string-equal (file-name-nondirectory file
) ""))))))))
739 (ert-deftest tramp-test07-file-exists-p
()
740 "Check `file-exist-p', `write-region' and `delete-file'."
741 (skip-unless (tramp--test-enabled))
743 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
744 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
745 (should-not (file-exists-p tmp-name
))
746 (write-region "foo" nil tmp-name
)
747 (should (file-exists-p tmp-name
))
748 (delete-file tmp-name
)
749 (should-not (file-exists-p tmp-name
)))))
751 (ert-deftest tramp-test08-file-local-copy
()
752 "Check `file-local-copy'."
753 (skip-unless (tramp--test-enabled))
755 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
756 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
760 (write-region "foo" nil tmp-name1
)
761 (should (setq tmp-name2
(file-local-copy tmp-name1
)))
763 (insert-file-contents tmp-name2
)
764 (should (string-equal (buffer-string) "foo")))
765 ;; Check also that a file transfer with compression works.
766 (let ((default-directory tramp-test-temporary-file-directory
)
767 (tramp-copy-size-limit 4)
768 (tramp-inline-compress-start-size 2))
769 (delete-file tmp-name2
)
770 (should (setq tmp-name2
(file-local-copy tmp-name1
)))))
774 (delete-file tmp-name1
)
775 (delete-file tmp-name2
))))))
777 (ert-deftest tramp-test09-insert-file-contents
()
778 "Check `insert-file-contents'."
779 (skip-unless (tramp--test-enabled))
781 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
782 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
785 (write-region "foo" nil tmp-name
)
787 (insert-file-contents tmp-name
)
788 (should (string-equal (buffer-string) "foo"))
789 (insert-file-contents tmp-name
)
790 (should (string-equal (buffer-string) "foofoo"))
792 (insert-file-contents tmp-name nil
1 3)
793 (should (string-equal (buffer-string) "oofoofoo"))
795 (insert-file-contents tmp-name nil nil nil
'replace
)
796 (should (string-equal (buffer-string) "foo"))))
799 (ignore-errors (delete-file tmp-name
))))))
801 (ert-deftest tramp-test10-write-region
()
802 "Check `write-region'."
803 (skip-unless (tramp--test-enabled))
805 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
806 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
811 (write-region nil nil tmp-name
))
813 (insert-file-contents tmp-name
)
814 (should (string-equal (buffer-string) "foo")))
818 (write-region nil nil tmp-name
'append
))
820 (insert-file-contents tmp-name
)
821 (should (string-equal (buffer-string) "foobla")))
823 (write-region "foo" nil tmp-name
)
825 (insert-file-contents tmp-name
)
826 (should (string-equal (buffer-string) "foo")))
830 (write-region 3 5 tmp-name
))
832 (insert-file-contents tmp-name
)
833 (should (string-equal (buffer-string) "34"))))
836 (ignore-errors (delete-file tmp-name
))))))
838 (ert-deftest tramp-test11-copy-file
()
840 (skip-unless (tramp--test-enabled))
842 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
843 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
844 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
845 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
846 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
847 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
849 ;; Copy on remote side.
852 (write-region "foo" nil tmp-name1
)
853 (copy-file tmp-name1 tmp-name2
)
854 (should (file-exists-p tmp-name2
))
856 (insert-file-contents tmp-name2
)
857 (should (string-equal (buffer-string) "foo")))
858 (should-error (copy-file tmp-name1 tmp-name2
))
859 (copy-file tmp-name1 tmp-name2
'ok
)
860 (make-directory tmp-name3
)
861 (copy-file tmp-name1 tmp-name3
)
864 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
867 (ignore-errors (delete-file tmp-name1
))
868 (ignore-errors (delete-file tmp-name2
))
869 (ignore-errors (delete-directory tmp-name3
'recursive
)))
871 ;; Copy from remote side to local side.
874 (write-region "foo" nil tmp-name1
)
875 (copy-file tmp-name1 tmp-name4
)
876 (should (file-exists-p tmp-name4
))
878 (insert-file-contents tmp-name4
)
879 (should (string-equal (buffer-string) "foo")))
880 (should-error (copy-file tmp-name1 tmp-name4
))
881 (copy-file tmp-name1 tmp-name4
'ok
)
882 (make-directory tmp-name5
)
883 (copy-file tmp-name1 tmp-name5
)
886 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
889 (ignore-errors (delete-file tmp-name1
))
890 (ignore-errors (delete-file tmp-name4
))
891 (ignore-errors (delete-directory tmp-name5
'recursive
)))
893 ;; Copy from local side to remote side.
896 (write-region "foo" nil tmp-name4 nil
'nomessage
)
897 (copy-file tmp-name4 tmp-name1
)
898 (should (file-exists-p tmp-name1
))
900 (insert-file-contents tmp-name1
)
901 (should (string-equal (buffer-string) "foo")))
902 (should-error (copy-file tmp-name4 tmp-name1
))
903 (copy-file tmp-name4 tmp-name1
'ok
)
904 (make-directory tmp-name3
)
905 (copy-file tmp-name4 tmp-name3
)
908 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
911 (ignore-errors (delete-file tmp-name1
))
912 (ignore-errors (delete-file tmp-name4
))
913 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
915 (ert-deftest tramp-test12-rename-file
()
916 "Check `rename-file'."
917 (skip-unless (tramp--test-enabled))
919 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
920 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
921 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
922 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
923 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
924 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
926 ;; Rename on remote side.
929 (write-region "foo" nil tmp-name1
)
930 (rename-file tmp-name1 tmp-name2
)
931 (should-not (file-exists-p tmp-name1
))
932 (should (file-exists-p tmp-name2
))
934 (insert-file-contents tmp-name2
)
935 (should (string-equal (buffer-string) "foo")))
936 (write-region "foo" nil tmp-name1
)
937 (should-error (rename-file tmp-name1 tmp-name2
))
938 (rename-file tmp-name1 tmp-name2
'ok
)
939 (should-not (file-exists-p tmp-name1
))
940 (write-region "foo" nil tmp-name1
)
941 (make-directory tmp-name3
)
942 (rename-file tmp-name1 tmp-name3
)
943 (should-not (file-exists-p tmp-name1
))
946 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
949 (ignore-errors (delete-file tmp-name1
))
950 (ignore-errors (delete-file tmp-name2
))
951 (ignore-errors (delete-directory tmp-name3
'recursive
)))
953 ;; Rename from remote side to local side.
956 (write-region "foo" nil tmp-name1
)
957 (rename-file tmp-name1 tmp-name4
)
958 (should-not (file-exists-p tmp-name1
))
959 (should (file-exists-p tmp-name4
))
961 (insert-file-contents tmp-name4
)
962 (should (string-equal (buffer-string) "foo")))
963 (write-region "foo" nil tmp-name1
)
964 (should-error (rename-file tmp-name1 tmp-name4
))
965 (rename-file tmp-name1 tmp-name4
'ok
)
966 (should-not (file-exists-p tmp-name1
))
967 (write-region "foo" nil tmp-name1
)
968 (make-directory tmp-name5
)
969 (rename-file tmp-name1 tmp-name5
)
970 (should-not (file-exists-p tmp-name1
))
973 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
976 (ignore-errors (delete-file tmp-name1
))
977 (ignore-errors (delete-file tmp-name4
))
978 (ignore-errors (delete-directory tmp-name5
'recursive
)))
980 ;; Rename from local side to remote side.
983 (write-region "foo" nil tmp-name4 nil
'nomessage
)
984 (rename-file tmp-name4 tmp-name1
)
985 (should-not (file-exists-p tmp-name4
))
986 (should (file-exists-p tmp-name1
))
988 (insert-file-contents tmp-name1
)
989 (should (string-equal (buffer-string) "foo")))
990 (write-region "foo" nil tmp-name4 nil
'nomessage
)
991 (should-error (rename-file tmp-name4 tmp-name1
))
992 (rename-file tmp-name4 tmp-name1
'ok
)
993 (should-not (file-exists-p tmp-name4
))
994 (write-region "foo" nil tmp-name4 nil
'nomessage
)
995 (make-directory tmp-name3
)
996 (rename-file tmp-name4 tmp-name3
)
997 (should-not (file-exists-p tmp-name4
))
1000 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
1003 (ignore-errors (delete-file tmp-name1
))
1004 (ignore-errors (delete-file tmp-name4
))
1005 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
1007 (ert-deftest tramp-test13-make-directory
()
1008 "Check `make-directory'.
1009 This tests also `file-directory-p' and `file-accessible-directory-p'."
1010 (skip-unless (tramp--test-enabled))
1012 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1013 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1014 (tmp-name2 (expand-file-name "foo/bar" tmp-name1
)))
1017 (make-directory tmp-name1
)
1018 (should (file-directory-p tmp-name1
))
1019 (should (file-accessible-directory-p tmp-name1
))
1020 (should-error (make-directory tmp-name2
))
1021 (make-directory tmp-name2
'parents
)
1022 (should (file-directory-p tmp-name2
))
1023 (should (file-accessible-directory-p tmp-name2
)))
1026 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
1028 (ert-deftest tramp-test14-delete-directory
()
1029 "Check `delete-directory'."
1030 (skip-unless (tramp--test-enabled))
1032 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1033 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1034 ;; Delete empty directory.
1035 (make-directory tmp-name
)
1036 (should (file-directory-p tmp-name
))
1037 (delete-directory tmp-name
)
1038 (should-not (file-directory-p tmp-name
))
1039 ;; Delete non-empty directory.
1040 (make-directory tmp-name
)
1041 (should (file-directory-p tmp-name
))
1042 (write-region "foo" nil
(expand-file-name "bla" tmp-name
))
1043 (should (file-exists-p (expand-file-name "bla" tmp-name
)))
1044 (should-error (delete-directory tmp-name
))
1045 (delete-directory tmp-name
'recursive
)
1046 (should-not (file-directory-p tmp-name
)))))
1048 (ert-deftest tramp-test15-copy-directory
()
1049 "Check `copy-directory'."
1050 (skip-unless (tramp--test-enabled))
1052 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1053 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1054 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1055 (tmp-name3 (expand-file-name
1056 (file-name-nondirectory tmp-name1
) tmp-name2
))
1057 (tmp-name4 (expand-file-name "foo" tmp-name1
))
1058 (tmp-name5 (expand-file-name "foo" tmp-name2
))
1059 (tmp-name6 (expand-file-name "foo" tmp-name3
)))
1061 ;; Copy complete directory.
1064 ;; Copy empty directory.
1065 (make-directory tmp-name1
)
1066 (write-region "foo" nil tmp-name4
)
1067 (should (file-directory-p tmp-name1
))
1068 (should (file-exists-p tmp-name4
))
1069 (copy-directory tmp-name1 tmp-name2
)
1070 (should (file-directory-p tmp-name2
))
1071 (should (file-exists-p tmp-name5
))
1072 ;; Target directory does exist already.
1073 (copy-directory tmp-name1 tmp-name2
)
1074 (should (file-directory-p tmp-name3
))
1075 (should (file-exists-p tmp-name6
)))
1079 (delete-directory tmp-name1
'recursive
)
1080 (delete-directory tmp-name2
'recursive
)))
1082 ;; Copy directory contents.
1085 ;; Copy empty directory.
1086 (make-directory tmp-name1
)
1087 (write-region "foo" nil tmp-name4
)
1088 (should (file-directory-p tmp-name1
))
1089 (should (file-exists-p tmp-name4
))
1090 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
1091 (should (file-directory-p tmp-name2
))
1092 (should (file-exists-p tmp-name5
))
1093 ;; Target directory does exist already.
1094 (delete-file tmp-name5
)
1095 (should-not (file-exists-p tmp-name5
))
1096 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
1097 (should (file-directory-p tmp-name2
))
1098 (should (file-exists-p tmp-name5
))
1099 (should-not (file-directory-p tmp-name3
))
1100 (should-not (file-exists-p tmp-name6
)))
1104 (delete-directory tmp-name1
'recursive
)
1105 (delete-directory tmp-name2
'recursive
))))))
1107 (ert-deftest tramp-test16-directory-files
()
1108 "Check `directory-files'."
1109 (skip-unless (tramp--test-enabled))
1111 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1112 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1113 (tmp-name2 (expand-file-name "bla" tmp-name1
))
1114 (tmp-name3 (expand-file-name "foo" tmp-name1
)))
1117 (make-directory tmp-name1
)
1118 (write-region "foo" nil tmp-name2
)
1119 (write-region "bla" nil tmp-name3
)
1120 (should (file-directory-p tmp-name1
))
1121 (should (file-exists-p tmp-name2
))
1122 (should (file-exists-p tmp-name3
))
1123 (should (equal (directory-files tmp-name1
) '("." ".." "bla" "foo")))
1124 (should (equal (directory-files tmp-name1
'full
)
1125 `(,(concat tmp-name1
"/.")
1126 ,(concat tmp-name1
"/..")
1127 ,tmp-name2
,tmp-name3
)))
1128 (should (equal (directory-files
1129 tmp-name1 nil directory-files-no-dot-files-regexp
)
1131 (should (equal (directory-files
1132 tmp-name1
'full directory-files-no-dot-files-regexp
)
1133 `(,tmp-name2
,tmp-name3
))))
1136 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
1138 (ert-deftest tramp-test17-insert-directory
()
1139 "Check `insert-directory'."
1140 (skip-unless (tramp--test-enabled))
1142 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1143 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1144 (tmp-name2 (expand-file-name "foo" tmp-name1
))
1145 ;; We test for the summary line. Keyword "total" could be localized.
1146 (process-environment
1147 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment
)))
1150 (make-directory tmp-name1
)
1151 (write-region "foo" nil tmp-name2
)
1152 (should (file-directory-p tmp-name1
))
1153 (should (file-exists-p tmp-name2
))
1155 (insert-directory tmp-name1 nil
)
1156 (goto-char (point-min))
1157 (should (looking-at-p (regexp-quote tmp-name1
))))
1159 (insert-directory tmp-name1
"-al")
1160 (goto-char (point-min))
1162 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1
)))))
1164 (insert-directory (file-name-as-directory tmp-name1
) "-al")
1165 (goto-char (point-min))
1167 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1
)))))
1170 (file-name-as-directory tmp-name1
) "-al" nil
'full-directory-p
)
1171 (goto-char (point-min))
1175 ;; There might be a summary line.
1176 "\\(total.+[[:digit:]]+\n\\)?"
1177 ;; We don't know in which order ".", ".." and "foo" appear.
1178 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
1181 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
1183 (ert-deftest tramp-test18-file-attributes
()
1184 "Check `file-attributes'.
1185 This tests also `file-readable-p', `file-regular-p' and
1186 `file-ownership-preserved-p'."
1187 (skip-unless (tramp--test-enabled))
1189 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1190 ;; We must use `file-truename' for the temporary directory,
1191 ;; because it could be located on a symlinked directory. This
1192 ;; would let the test fail.
1193 (let* ((tramp-test-temporary-file-directory
1194 (file-truename tramp-test-temporary-file-directory
))
1195 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
1196 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1197 ;; File name with "//".
1201 (file-remote-p tmp-name1
)
1202 (replace-regexp-in-string
1203 "/" "//" (file-remote-p tmp-name1
'localname
))))
1207 ;; `file-ownership-preserved-p' should return t for
1208 ;; non-existing files. It is implemented only in tramp-sh.el.
1209 (when (tramp--test-sh-p)
1210 (should (file-ownership-preserved-p tmp-name1
'group
)))
1211 (write-region "foo" nil tmp-name1
)
1212 (should (file-exists-p tmp-name1
))
1213 (should (file-readable-p tmp-name1
))
1214 (should (file-regular-p tmp-name1
))
1215 (when (tramp--test-sh-p)
1216 (should (file-ownership-preserved-p tmp-name1
'group
)))
1218 ;; We do not test inodes and device numbers.
1219 (setq attr
(file-attributes tmp-name1
))
1220 (should (consp attr
))
1221 (should (null (car attr
)))
1222 (should (numberp (nth 1 attr
))) ;; Link.
1223 (should (numberp (nth 2 attr
))) ;; Uid.
1224 (should (numberp (nth 3 attr
))) ;; Gid.
1225 ;; Last access time.
1226 (should (stringp (current-time-string (nth 4 attr
))))
1227 ;; Last modification time.
1228 (should (stringp (current-time-string (nth 5 attr
))))
1229 ;; Last status change time.
1230 (should (stringp (current-time-string (nth 6 attr
))))
1231 (should (numberp (nth 7 attr
))) ;; Size.
1232 (should (stringp (nth 8 attr
))) ;; Modes.
1234 (setq attr
(file-attributes tmp-name1
'string
))
1235 (should (stringp (nth 2 attr
))) ;; Uid.
1236 (should (stringp (nth 3 attr
))) ;; Gid.
1240 (when (tramp--test-sh-p)
1241 (should (file-ownership-preserved-p tmp-name2
'group
)))
1242 (make-symbolic-link tmp-name1 tmp-name2
)
1243 (should (file-exists-p tmp-name2
))
1244 (should (file-symlink-p tmp-name2
))
1245 (when (tramp--test-sh-p)
1246 (should (file-ownership-preserved-p tmp-name2
'group
)))
1247 (setq attr
(file-attributes tmp-name2
))
1251 (if quoted
'tramp-compat-file-name-quote
'identity
)
1253 (file-remote-p (file-truename tmp-name1
) 'localname
)))
1254 (delete-file tmp-name2
))
1256 (should (string-equal (error-message-string err
)
1257 "make-symbolic-link not supported"))))
1259 ;; Check, that "//" in symlinks are handled properly.
1261 (let ((default-directory tramp-test-temporary-file-directory
))
1265 (tramp-file-name-localname
1266 (tramp-dissect-file-name tmp-name3
))
1267 (tramp-file-name-localname
1268 (tramp-dissect-file-name tmp-name2
)))
1270 (when (file-symlink-p tmp-name2
)
1271 (setq attr
(file-attributes tmp-name2
))
1275 (tramp-file-name-localname
1276 (tramp-dissect-file-name tmp-name3
))))
1277 (delete-file tmp-name2
))
1279 (when (tramp--test-sh-p)
1280 (should (file-ownership-preserved-p tmp-name1
'group
)))
1281 (delete-file tmp-name1
)
1282 (make-directory tmp-name1
)
1283 (should (file-exists-p tmp-name1
))
1284 (should (file-readable-p tmp-name1
))
1285 (should-not (file-regular-p tmp-name1
))
1286 (when (tramp--test-sh-p)
1287 (should (file-ownership-preserved-p tmp-name1
'group
)))
1288 (setq attr
(file-attributes tmp-name1
))
1289 (should (eq (car attr
) t
)))
1292 (ignore-errors (delete-directory tmp-name1
))
1293 (ignore-errors (delete-file tmp-name1
))
1294 (ignore-errors (delete-file tmp-name2
))))))
1296 (ert-deftest tramp-test19-directory-files-and-attributes
()
1297 "Check `directory-files-and-attributes'."
1298 (skip-unless (tramp--test-enabled))
1300 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1301 ;; `directory-files-and-attributes' contains also values for
1302 ;; "../". Ensure that this doesn't change during tests, for
1303 ;; example due to handling temporary files.
1304 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1305 (tmp-name2 (expand-file-name "bla" tmp-name1
))
1309 (make-directory tmp-name1
)
1310 (should (file-directory-p tmp-name1
))
1311 (make-directory tmp-name2
)
1312 (should (file-directory-p tmp-name2
))
1313 (write-region "foo" nil
(expand-file-name "foo" tmp-name2
))
1314 (write-region "bar" nil
(expand-file-name "bar" tmp-name2
))
1315 (write-region "boz" nil
(expand-file-name "boz" tmp-name2
))
1316 (setq attr
(directory-files-and-attributes tmp-name2
))
1317 (should (consp attr
))
1318 ;; Dumb remote shells without perl(1) or stat(1) are not
1319 ;; able to return the date correctly. They say "don't know".
1324 5 (file-attributes (expand-file-name (car elt
) tmp-name2
)))
1327 (equal (file-attributes (expand-file-name (car elt
) tmp-name2
))
1329 (setq attr
(directory-files-and-attributes tmp-name2
'full
))
1331 (unless (equal (nth 5 (file-attributes (car elt
))) '(0 0))
1333 (equal (file-attributes (car elt
)) (cdr elt
)))))
1334 (setq attr
(directory-files-and-attributes tmp-name2 nil
"^b"))
1335 (should (equal (mapcar 'car attr
) '("bar" "boz"))))
1338 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
1340 (ert-deftest tramp-test20-file-modes
()
1341 "Check `file-modes'.
1342 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
1343 (skip-unless (tramp--test-enabled))
1344 (skip-unless (tramp--test-sh-p))
1346 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1347 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1350 (write-region "foo" nil tmp-name
)
1351 (should (file-exists-p tmp-name
))
1352 (set-file-modes tmp-name
#o777
)
1353 (should (= (file-modes tmp-name
) #o777
))
1354 (should (file-executable-p tmp-name
))
1355 (should (file-writable-p tmp-name
))
1356 (set-file-modes tmp-name
#o444
)
1357 (should (= (file-modes tmp-name
) #o444
))
1358 (should-not (file-executable-p tmp-name
))
1359 ;; A file is always writable for user "root".
1360 (unless (zerop (nth 2 (file-attributes tmp-name
)))
1361 (should-not (file-writable-p tmp-name
))))
1364 (ignore-errors (delete-file tmp-name
))))))
1366 (ert-deftest tramp-test21-file-links
()
1367 "Check `file-symlink-p'.
1368 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1369 (skip-unless (tramp--test-enabled))
1371 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1372 ;; We must use `file-truename' for the temporary directory,
1373 ;; because it could be located on a symlinked directory. This
1374 ;; would let the test fail.
1375 (let* ((tramp-test-temporary-file-directory
1376 (file-truename tramp-test-temporary-file-directory
))
1377 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
1378 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1379 (tmp-name3 (tramp--test-make-temp-name 'local quoted
)))
1381 ;; Check `make-symbolic-link'.
1384 (write-region "foo" nil tmp-name1
)
1385 (should (file-exists-p tmp-name1
))
1386 ;; Method "smb" supports `make-symbolic-link' only if the
1387 ;; remote host has CIFS capabilities. tramp-adb.el and
1388 ;; tramp-gvfs.el do not support symbolic links at all.
1390 (make-symbolic-link tmp-name1 tmp-name2
)
1393 (not (string-equal (error-message-string err
)
1394 "make-symbolic-link not supported")))))
1395 (should (file-symlink-p tmp-name2
))
1396 (should-error (make-symbolic-link tmp-name1 tmp-name2
))
1397 (make-symbolic-link tmp-name1 tmp-name2
'ok-if-already-exists
)
1398 (should (file-symlink-p tmp-name2
))
1399 ;; `tmp-name3' is a local file name.
1400 (should-error (make-symbolic-link tmp-name1 tmp-name3
)))
1404 (delete-file tmp-name1
)
1405 (delete-file tmp-name2
)))
1407 ;; Check `add-name-to-file'.
1410 (write-region "foo" nil tmp-name1
)
1411 (should (file-exists-p tmp-name1
))
1412 (add-name-to-file tmp-name1 tmp-name2
)
1413 (should-not (file-symlink-p tmp-name2
))
1414 (should-error (add-name-to-file tmp-name1 tmp-name2
))
1415 (add-name-to-file tmp-name1 tmp-name2
'ok-if-already-exists
)
1416 (should-not (file-symlink-p tmp-name2
))
1417 ;; `tmp-name3' is a local file name.
1418 (should-error (add-name-to-file tmp-name1 tmp-name3
)))
1422 (delete-file tmp-name1
)
1423 (delete-file tmp-name2
)))
1425 ;; Check `file-truename'.
1428 (write-region "foo" nil tmp-name1
)
1429 (should (file-exists-p tmp-name1
))
1430 (make-symbolic-link tmp-name1 tmp-name2
)
1431 (should (file-symlink-p tmp-name2
))
1432 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
1434 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
)))
1435 (should (file-equal-p tmp-name1 tmp-name2
)))
1437 (delete-file tmp-name1
)
1438 (delete-file tmp-name2
)))
1440 ;; `file-truename' shall preserve trailing link of directories.
1441 (unless (file-symlink-p tramp-test-temporary-file-directory
)
1442 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory
))
1443 (dir2 (file-name-as-directory dir1
)))
1444 (should (string-equal (file-truename dir1
) (expand-file-name dir1
)))
1446 (string-equal (file-truename dir2
) (expand-file-name dir2
))))))))
1448 (ert-deftest tramp-test22-file-times
()
1449 "Check `set-file-times' and `file-newer-than-file-p'."
1450 (skip-unless (tramp--test-enabled))
1451 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
1453 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1454 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1455 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1456 (tmp-name3 (tramp--test-make-temp-name nil quoted
)))
1459 (write-region "foo" nil tmp-name1
)
1460 (should (file-exists-p tmp-name1
))
1461 (should (consp (nth 5 (file-attributes tmp-name1
))))
1462 ;; '(0 0) means don't know, and will be replaced by
1463 ;; `current-time'. Therefore, we use '(0 1). We skip the
1464 ;; test, if the remote handler is not able to set the
1466 (skip-unless (set-file-times tmp-name1
'(0 1)))
1467 ;; Dumb remote shells without perl(1) or stat(1) are not
1468 ;; able to return the date correctly. They say "don't know".
1469 (unless (equal (nth 5 (file-attributes tmp-name1
)) '(0 0))
1470 (should (equal (nth 5 (file-attributes tmp-name1
)) '(0 1)))
1471 (write-region "bla" nil tmp-name2
)
1472 (should (file-exists-p tmp-name2
))
1473 (should (file-newer-than-file-p tmp-name2 tmp-name1
))
1474 ;; `tmp-name3' does not exist.
1475 (should (file-newer-than-file-p tmp-name2 tmp-name3
))
1476 (should-not (file-newer-than-file-p tmp-name3 tmp-name1
))))
1480 (delete-file tmp-name1
)
1481 (delete-file tmp-name2
))))))
1483 (ert-deftest tramp-test23-visited-file-modtime
()
1484 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1485 (skip-unless (tramp--test-enabled))
1487 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1488 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1491 (write-region "foo" nil tmp-name
)
1492 (should (file-exists-p tmp-name
))
1494 (insert-file-contents tmp-name
)
1495 (should (verify-visited-file-modtime))
1496 (set-visited-file-modtime '(0 1))
1497 (should (verify-visited-file-modtime))
1498 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1501 (ignore-errors (delete-file tmp-name
))))))
1503 (ert-deftest tramp-test24-file-name-completion
()
1504 "Check `file-name-completion' and `file-name-all-completions'."
1505 (skip-unless (tramp--test-enabled))
1507 (dolist (n-e '(nil t
))
1508 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1509 (let ((non-essential n-e
)
1510 (tmp-name (tramp--test-make-temp-name nil quoted
))
1511 (method (file-remote-p tramp-test-temporary-file-directory
'method
))
1512 (host (file-remote-p tramp-test-temporary-file-directory
'host
)))
1516 ;; Method and host name in completion mode. This kind
1517 ;; of completion does not work on MS Windows.
1518 (when (and (tramp-completion-mode-p)
1519 (not (memq system-type
'(cygwin windows-nt
))))
1520 (unless (zerop (length method
))
1523 (format "%s:" method
)
1524 (file-name-all-completions (substring method
0 1) "/"))))
1525 (unless (zerop (length host
))
1526 (let ((tramp-default-method (or method tramp-default-method
)))
1530 (file-name-all-completions (substring host
0 1) "/")))))
1531 (unless (or (zerop (length method
)) (zerop (length host
)))
1535 (file-name-all-completions
1536 (substring host
0 1) (format "/%s:" method
))))))
1539 (make-directory tmp-name
)
1540 (should (file-directory-p tmp-name
))
1541 (write-region "foo" nil
(expand-file-name "foo" tmp-name
))
1542 (should (file-exists-p (expand-file-name "foo" tmp-name
)))
1543 (write-region "bar" nil
(expand-file-name "bold" tmp-name
))
1544 (should (file-exists-p (expand-file-name "bold" tmp-name
)))
1545 (make-directory (expand-file-name "boz" tmp-name
))
1546 (should (file-directory-p (expand-file-name "boz" tmp-name
)))
1547 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
1548 (should (equal (file-name-completion "foo" tmp-name
) t
))
1549 (should (equal (file-name-completion "b" tmp-name
) "bo"))
1550 (should-not (file-name-completion "a" tmp-name
))
1553 (file-name-completion "b" tmp-name
'file-directory-p
) "boz/"))
1555 (equal (file-name-all-completions "fo" tmp-name
) '("foo")))
1558 (sort (file-name-all-completions "b" tmp-name
) 'string-lessp
)
1560 (should-not (file-name-all-completions "a" tmp-name
))
1561 ;; `completion-regexp-list' restricts the completion to
1562 ;; files which match all expressions in this list.
1563 (let ((completion-regexp-list
1564 `(,directory-files-no-dot-files-regexp
"b")))
1566 (equal (file-name-completion "" tmp-name
) "bo"))
1569 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
1571 ;; `file-name-completion' ignores file names that end in
1572 ;; any string in `completion-ignored-extensions'.
1573 (let ((completion-ignored-extensions '(".ext")))
1574 (write-region "foo" nil
(expand-file-name "foo.ext" tmp-name
))
1575 (should (file-exists-p (expand-file-name "foo.ext" tmp-name
)))
1576 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
1577 (should (equal (file-name-completion "foo" tmp-name
) t
))
1579 (equal (file-name-completion "foo." tmp-name
) "foo.ext"))
1580 (should (equal (file-name-completion "foo.ext" tmp-name
) t
))
1581 ;; `file-name-all-completions' is not affected.
1584 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
1585 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
1588 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
1590 (ert-deftest tramp-test25-load
()
1592 (skip-unless (tramp--test-enabled))
1594 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1595 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1598 (load tmp-name
'noerror
'nomessage
)
1599 (should-not (featurep 'tramp-test-load
))
1600 (write-region "(provide 'tramp-test-load)" nil tmp-name
)
1601 ;; `load' in lread.c does not pass `must-suffix'. Why?
1603 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1604 (load tmp-name nil
'nomessage
'nosuffix
)
1605 (should (featurep 'tramp-test-load
)))
1609 (and (featurep 'tramp-test-load
) (unload-feature 'tramp-test-load
))
1610 (delete-file tmp-name
))))))
1612 (ert-deftest tramp-test26-process-file
()
1613 "Check `process-file'."
1614 :tags
'(:expensive-test
)
1615 (skip-unless (tramp--test-enabled))
1616 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
1618 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1619 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
1620 (fnnd (file-name-nondirectory tmp-name
))
1621 (default-directory tramp-test-temporary-file-directory
)
1622 kill-buffer-query-functions
)
1625 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1626 ;; do not exist on hydra.
1627 (should (zerop (process-file "true")))
1628 (should-not (zerop (process-file "false")))
1629 (should-not (zerop (process-file "binary-does-not-exist")))
1631 (write-region "foo" nil tmp-name
)
1632 (should (file-exists-p tmp-name
))
1633 (should (zerop (process-file "ls" nil t nil fnnd
)))
1634 ;; `ls' could produce colorized output.
1635 (goto-char (point-min))
1637 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
1638 (replace-match "" nil nil
))
1639 (should (string-equal (format "%s\n" fnnd
) (buffer-string)))
1640 (should-not (get-buffer-window (current-buffer) t
))
1642 ;; Second run. The output must be appended.
1643 (goto-char (point-max))
1644 (should (zerop (process-file "ls" nil t t fnnd
)))
1645 ;; `ls' could produce colorized output.
1646 (goto-char (point-min))
1648 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
1649 (replace-match "" nil nil
))
1651 (string-equal (format "%s\n%s\n" fnnd fnnd
) (buffer-string)))
1652 ;; A non-nil DISPLAY must not raise the buffer.
1653 (should-not (get-buffer-window (current-buffer) t
))))
1656 (ignore-errors (delete-file tmp-name
))))))
1658 (ert-deftest tramp-test27-start-file-process
()
1659 "Check `start-file-process'."
1660 :tags
'(:expensive-test
)
1661 (skip-unless (tramp--test-enabled))
1662 (skip-unless (tramp--test-sh-p))
1664 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1665 (let ((default-directory tramp-test-temporary-file-directory
)
1666 (tmp-name (tramp--test-make-temp-name nil quoted
))
1667 kill-buffer-query-functions proc
)
1670 (setq proc
(start-file-process "test1" (current-buffer) "cat"))
1671 (should (processp proc
))
1672 (should (equal (process-status proc
) 'run
))
1673 (process-send-string proc
"foo")
1674 (process-send-eof proc
)
1676 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1677 (while (< (- (point-max) (point-min)) (length "foo"))
1678 (accept-process-output proc
0.1)))
1679 (should (string-equal (buffer-string) "foo")))
1682 (ignore-errors (delete-process proc
)))
1686 (write-region "foo" nil tmp-name
)
1687 (should (file-exists-p tmp-name
))
1690 "test2" (current-buffer)
1691 "cat" (file-name-nondirectory tmp-name
)))
1692 (should (processp proc
))
1694 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1695 (while (< (- (point-max) (point-min)) (length "foo"))
1696 (accept-process-output proc
0.1)))
1697 (should (string-equal (buffer-string) "foo")))
1701 (delete-process proc
)
1702 (delete-file tmp-name
)))
1706 (setq proc
(start-file-process "test3" (current-buffer) "cat"))
1707 (should (processp proc
))
1708 (should (equal (process-status proc
) 'run
))
1711 (lambda (p s
) (with-current-buffer (process-buffer p
) (insert s
))))
1712 (process-send-string proc
"foo")
1713 (process-send-eof proc
)
1715 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
1716 (while (< (- (point-max) (point-min)) (length "foo"))
1717 (accept-process-output proc
0.1)))
1718 (should (string-equal (buffer-string) "foo")))
1721 (ignore-errors (delete-process proc
))))))
1723 (ert-deftest tramp-test28-shell-command
()
1724 "Check `shell-command'."
1725 :tags
'(:expensive-test
)
1726 (skip-unless (tramp--test-enabled))
1727 (skip-unless (tramp--test-sh-p))
1729 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1730 (let ((tmp-name (tramp--test-make-temp-name nil quoted
))
1731 (default-directory tramp-test-temporary-file-directory
)
1732 kill-buffer-query-functions
)
1735 (write-region "foo" nil tmp-name
)
1736 (should (file-exists-p tmp-name
))
1738 (format "ls %s" (file-name-nondirectory tmp-name
))
1740 ;; `ls' could produce colorized output.
1741 (goto-char (point-min))
1743 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
1744 (replace-match "" nil nil
))
1747 (format "%s\n" (file-name-nondirectory tmp-name
))
1751 (ignore-errors (delete-file tmp-name
)))
1755 (write-region "foo" nil tmp-name
)
1756 (should (file-exists-p tmp-name
))
1757 (async-shell-command
1758 (format "ls %s" (file-name-nondirectory tmp-name
))
1760 (set-process-sentinel (get-buffer-process (current-buffer)) nil
)
1762 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1763 (while (< (- (point-max) (point-min))
1764 (1+ (length (file-name-nondirectory tmp-name
))))
1765 (accept-process-output
1766 (get-buffer-process (current-buffer)) 0.1)))
1767 ;; `ls' could produce colorized output.
1768 (goto-char (point-min))
1770 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
1771 (replace-match "" nil nil
))
1772 ;; There might be a nasty "Process *Async Shell* finished" message.
1773 (goto-char (point-min))
1775 (narrow-to-region (point-min) (point))
1778 (format "%s\n" (file-name-nondirectory tmp-name
))
1782 (ignore-errors (delete-file tmp-name
)))
1786 (write-region "foo" nil tmp-name
)
1787 (should (file-exists-p tmp-name
))
1788 (async-shell-command "read line; ls $line" (current-buffer))
1789 (set-process-sentinel (get-buffer-process (current-buffer)) nil
)
1790 (process-send-string
1791 (get-buffer-process (current-buffer))
1792 (format "%s\n" (file-name-nondirectory tmp-name
)))
1794 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1795 (while (< (- (point-max) (point-min))
1796 (1+ (length (file-name-nondirectory tmp-name
))))
1797 (accept-process-output
1798 (get-buffer-process (current-buffer)) 0.1)))
1799 ;; `ls' could produce colorized output.
1800 (goto-char (point-min))
1802 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
1803 (replace-match "" nil nil
))
1804 ;; There might be a nasty "Process *Async Shell* finished" message.
1805 (goto-char (point-min))
1807 (narrow-to-region (point-min) (point))
1810 (format "%s\n" (file-name-nondirectory tmp-name
))
1814 (ignore-errors (delete-file tmp-name
))))))
1816 (defun tramp--test-shell-command-to-string-asynchronously (command)
1817 "Like `shell-command-to-string', but for asynchronous processes."
1819 (async-shell-command command
(current-buffer))
1820 ;; Suppress nasty messages.
1821 (set-process-sentinel (get-buffer-process (current-buffer)) nil
)
1823 (while (get-buffer-process (current-buffer))
1824 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
1825 (accept-process-output nil
0.1)
1826 (buffer-substring-no-properties (point-min) (point-max))))
1828 ;; This test is inspired by Bug#23952.
1829 (ert-deftest tramp-test29-environment-variables
()
1830 "Check that remote processes set / unset environment variables properly."
1831 :tags
'(:expensive-test
)
1832 (skip-unless (tramp--test-enabled))
1833 (skip-unless (tramp--test-sh-p))
1835 (dolist (this-shell-command-to-string
1837 shell-command-to-string
1839 tramp--test-shell-command-to-string-asynchronously
))
1841 (let ((default-directory tramp-test-temporary-file-directory
)
1842 (shell-file-name "/bin/sh")
1843 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
1844 kill-buffer-query-functions
)
1848 (let ((process-environment
1849 (cons (concat envvar
"=foo") process-environment
)))
1855 this-shell-command-to-string
1856 (format "echo -n ${%s:?bla}" envvar
))))))
1859 ;; Set the empty value.
1860 (let ((process-environment
1861 (cons (concat envvar
"=") process-environment
)))
1867 this-shell-command-to-string
1868 (format "echo -n ${%s:?bla}" envvar
))))
1872 (regexp-quote envvar
)
1873 (funcall this-shell-command-to-string
"set")))))
1875 ;; We force a reconnect, in order to have a clean environment.
1876 (tramp-cleanup-connection
1877 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
1878 'keep-debug
'keep-password
)
1880 ;; Unset the variable.
1881 (let ((tramp-remote-process-environment
1882 (cons (concat envvar
"=foo")
1883 tramp-remote-process-environment
)))
1884 ;; Set the initial value, we want to unset below.
1889 this-shell-command-to-string
1890 (format "echo -n ${%s:?bla}" envvar
))))
1891 (let ((process-environment
1892 (cons envvar process-environment
)))
1893 ;; Variable is unset.
1898 this-shell-command-to-string
1899 (format "echo -n ${%s:?bla}" envvar
))))
1900 ;; Variable is unset.
1903 (regexp-quote envvar
)
1904 (funcall this-shell-command-to-string
"set")))))))))
1906 (ert-deftest tramp-test30-vc-registered
()
1907 "Check `vc-registered'."
1908 :tags
'(:expensive-test
)
1909 (skip-unless (tramp--test-enabled))
1910 (skip-unless (tramp--test-sh-p))
1912 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1913 (let* ((default-directory tramp-test-temporary-file-directory
)
1914 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
1915 (tmp-name2 (expand-file-name "foo" tmp-name1
))
1916 (tramp-remote-process-environment tramp-remote-process-environment
)
1917 (vc-handled-backends
1918 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1920 ((tramp-find-executable
1921 v vc-git-program
(tramp-get-remote-path v
))
1923 ((tramp-find-executable
1924 v vc-hg-program
(tramp-get-remote-path v
))
1926 ((tramp-find-executable
1927 v vc-bzr-program
(tramp-get-remote-path v
))
1928 (setq tramp-remote-process-environment
1929 (cons (format "BZR_HOME=%s"
1930 (file-remote-p tmp-name1
'localname
))
1931 tramp-remote-process-environment
))
1932 ;; We must force a reconnect, in order to activate $BZR_HOME.
1933 (tramp-cleanup-connection
1934 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
1938 (skip-unless vc-handled-backends
)
1939 (message "%s" vc-handled-backends
)
1943 (make-directory tmp-name1
)
1944 (write-region "foo" nil tmp-name2
)
1945 (should (file-directory-p tmp-name1
))
1946 (should (file-exists-p tmp-name2
))
1947 (should-not (vc-registered tmp-name1
))
1948 (should-not (vc-registered tmp-name2
))
1950 (let ((default-directory tmp-name1
))
1951 ;; Create empty repository, and register the file.
1952 ;; Sometimes, creation of repository fails (bzr!); we
1953 ;; skip the test then.
1955 (vc-create-repo (car vc-handled-backends
))
1956 (error (skip-unless nil
)))
1957 ;; The structure of VC-FILESET is not documented. Let's
1958 ;; hope it won't change.
1961 (list (car vc-handled-backends
)
1962 (list (file-name-nondirectory tmp-name2
))))
1963 ;; `vc-register' has changed its arguments in Emacs 25.1.
1966 nil
(list (car vc-handled-backends
)
1967 (list (file-name-nondirectory tmp-name2
))))))
1968 ;; vc-git uses an own process sentinel, Tramp's sentinel
1969 ;; for flushing the cache isn't used.
1970 (dired-uncache (concat (file-remote-p default-directory
) "/"))
1971 (should (vc-registered (file-name-nondirectory tmp-name2
)))))
1974 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
1976 (ert-deftest tramp-test31-make-auto-save-file-name
()
1977 "Check `make-auto-save-file-name'."
1978 (skip-unless (tramp--test-enabled))
1980 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1981 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1982 (tmp-name2 (tramp--test-make-temp-name nil quoted
)))
1986 ;; Use default `auto-save-file-name-transforms' mechanism.
1987 (let (tramp-auto-save-directory)
1989 (setq buffer-file-name tmp-name1
)
1992 (make-auto-save-file-name)
1993 ;; This is taken from original `make-auto-save-file-name'.
1994 ;; We call `convert-standard-filename', because on
1995 ;; MS Windows the (local) colons must be replaced by
1996 ;; exclamation marks.
1997 (convert-standard-filename
2001 (subst-char-in-string
2002 ?
/ ?
! (replace-regexp-in-string "!" "!!" tmp-name1
)))
2003 temporary-file-directory
))))))
2006 (let (tramp-auto-save-directory auto-save-file-name-transforms
)
2008 (setq buffer-file-name tmp-name1
)
2011 (make-auto-save-file-name)
2013 (if quoted
'tramp-compat-file-name-quote
'identity
)
2015 (format "#%s#" (file-name-nondirectory tmp-name1
))
2016 tramp-test-temporary-file-directory
))))))
2018 ;; Use default `tramp-auto-save-directory' mechanism.
2019 (let ((tramp-auto-save-directory tmp-name2
))
2021 (setq buffer-file-name tmp-name1
)
2024 (make-auto-save-file-name)
2025 ;; This is taken from Tramp.
2029 (tramp-subst-strs-in-string
2036 (tramp-compat-file-name-unquote tmp-name1
)))
2038 (should (file-directory-p tmp-name2
))))
2040 ;; Relative file names shall work, too.
2041 (let ((tramp-auto-save-directory "."))
2043 (setq buffer-file-name tmp-name1
2044 default-directory tmp-name2
)
2047 (make-auto-save-file-name)
2048 ;; This is taken from Tramp.
2052 (tramp-subst-strs-in-string
2059 (tramp-compat-file-name-unquote tmp-name1
)))
2061 (should (file-directory-p tmp-name2
)))))
2064 (ignore-errors (delete-file tmp-name1
))
2065 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2067 ;; The functions were introduced in Emacs 26.1.
2068 (ert-deftest tramp-test32-make-nearby-temp-file
()
2069 "Check `make-nearby-temp-file' and `temporary-file-directory'."
2070 (skip-unless (tramp--test-enabled))
2072 (and (fboundp 'make-nearby-temp-file
) (fboundp 'temporary-file-directory
)))
2074 (let ((default-directory tramp-test-temporary-file-directory
)
2076 ;; The remote host shall know a temporary file directory.
2077 (should (stringp (temporary-file-directory)))
2080 (file-remote-p default-directory
)
2081 (file-remote-p (temporary-file-directory))))
2083 ;; The temporary file shall be located on the remote host.
2084 (setq tmp-file
(make-nearby-temp-file "tramp-test"))
2085 (should (file-exists-p tmp-file
))
2086 (should (file-regular-p tmp-file
))
2089 (file-remote-p default-directory
)
2090 (file-remote-p tmp-file
)))
2091 (delete-file tmp-file
)
2092 (should-not (file-exists-p tmp-file
))
2094 (setq tmp-file
(make-nearby-temp-file "tramp-test" 'dir
))
2095 (should (file-exists-p tmp-file
))
2096 (should (file-directory-p tmp-file
))
2097 (delete-directory tmp-file
)
2098 (should-not (file-exists-p tmp-file
))))
2100 (defun tramp--test-adb-p ()
2101 "Check, whether the remote host runs Android.
2102 This requires restrictions of file name syntax."
2103 (tramp-adb-file-name-p tramp-test-temporary-file-directory
))
2105 (defun tramp--test-docker-p ()
2106 "Check, whether the docker method is used.
2107 This does not support some special file names."
2109 "docker" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2111 (defun tramp--test-ftp-p ()
2112 "Check, whether an FTP-like method is used.
2113 This does not support globbing characters in file names (yet)."
2114 ;; Globbing characters are ??, ?* and ?\[.
2116 "ftp$" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2118 (defun tramp--test-gvfs-p ()
2119 "Check, whether the remote host runs a GVFS based method.
2120 This requires restrictions of file name syntax."
2121 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory
))
2123 (defun tramp--test-hpux-p ()
2124 "Check, whether the remote host runs HP-UX.
2125 Several special characters do not work properly there."
2126 ;; We must refill the cache. `file-truename' does it.
2127 (with-parsed-tramp-file-name
2128 (file-truename tramp-test-temporary-file-directory
) nil
2129 (string-match "^HP-UX" (tramp-get-connection-property v
"uname" ""))))
2131 (defun tramp--test-rsync-p ()
2132 "Check, whether the rsync method is used.
2133 This does not support special file names."
2135 "rsync" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2137 (defun tramp--test-sh-p ()
2138 "Check, whether the remote host runs a based method from tramp-sh.el."
2140 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
2141 'tramp-sh-file-name-handler
))
2143 (defun tramp--test-windows-nt-and-batch ()
2144 "Check, whether the locale host runs MS Windows in batch mode.
2145 This does not support special characters."
2146 (and (eq system-type
'windows-nt
) noninteractive
))
2148 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
2149 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
2150 This does not support utf8 based file transfer."
2151 (and (eq system-type
'windows-nt
)
2153 (regexp-opt '("pscp" "psftp"))
2154 (file-remote-p tramp-test-temporary-file-directory
'method
))))
2156 (defun tramp--test-windows-nt-or-smb-p ()
2157 "Check, whether the locale or remote host runs MS Windows.
2158 This requires restrictions of file name syntax."
2159 (or (eq system-type
'windows-nt
)
2160 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)))
2162 (defun tramp--test-check-files (&rest files
)
2163 "Run a simple but comprehensive test over every file in FILES."
2164 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2165 ;; We must use `file-truename' for the temporary directory,
2166 ;; because it could be located on a symlinked directory. This
2167 ;; would let the test fail.
2168 (let* ((tramp-test-temporary-file-directory
2169 (file-truename tramp-test-temporary-file-directory
))
2170 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2171 (tmp-name2 (tramp--test-make-temp-name 'local quoted
))
2172 (files (delq nil files
))
2173 (process-environment process-environment
))
2176 (make-directory tmp-name1
)
2177 (make-directory tmp-name2
)
2180 (let* ((file1 (expand-file-name elt tmp-name1
))
2181 (file2 (expand-file-name elt tmp-name2
))
2182 (file3 (expand-file-name (concat elt
"foo") tmp-name1
)))
2183 (write-region elt nil file1
)
2184 (should (file-exists-p file1
))
2186 ;; Check file contents.
2188 (insert-file-contents file1
)
2189 (should (string-equal (buffer-string) elt
)))
2191 ;; Copy file both directions.
2192 (copy-file file1 tmp-name2
)
2193 (should (file-exists-p file2
))
2195 (should-not (file-exists-p file1
))
2196 (copy-file file2 tmp-name1
)
2197 (should (file-exists-p file1
))
2199 ;; Method "smb" supports `make-symbolic-link' only if the
2200 ;; remote host has CIFS capabilities. tramp-adb.el and
2201 ;; tramp-gvfs.el do not support symbolic links at all.
2204 (make-symbolic-link file1 file3
)
2205 (should (file-symlink-p file3
))
2208 (expand-file-name file1
) (file-truename file3
)))
2212 (if quoted
'tramp-compat-file-name-quote
'identity
)
2213 (car (file-attributes file3
)))
2214 (file-remote-p (file-truename file1
) 'localname
)))
2215 ;; Check file contents.
2217 (insert-file-contents file3
)
2218 (should (string-equal (buffer-string) elt
)))
2219 (delete-file file3
))
2222 (string-equal (error-message-string err
)
2223 "make-symbolic-link not supported"))))))
2225 ;; Check file names.
2226 (should (equal (directory-files
2227 tmp-name1 nil directory-files-no-dot-files-regexp
)
2228 (sort (copy-sequence files
) 'string-lessp
)))
2229 (should (equal (directory-files
2230 tmp-name2 nil directory-files-no-dot-files-regexp
)
2231 (sort (copy-sequence files
) 'string-lessp
)))
2233 ;; `substitute-in-file-name' could return different
2234 ;; values. For `adb', there could be strange file
2235 ;; permissions preventing overwriting a file. We don't
2236 ;; care in this testcase.
2239 (substitute-in-file-name (expand-file-name elt tmp-name1
)))
2241 (substitute-in-file-name
2242 (expand-file-name elt tmp-name2
))))
2243 (ignore-errors (write-region elt nil file1
))
2244 (should (file-exists-p file1
))
2245 (ignore-errors (write-region elt nil file2 nil
'nomessage
))
2246 (should (file-exists-p file2
))))
2248 (should (equal (directory-files
2249 tmp-name1 nil directory-files-no-dot-files-regexp
)
2251 tmp-name2 nil directory-files-no-dot-files-regexp
)))
2253 ;; Check directory creation. We use a subdirectory "foo"
2254 ;; in order to avoid conflicts with previous file name tests.
2256 (let* ((elt1 (concat elt
"foo"))
2257 (file1 (expand-file-name (concat "foo/" elt
) tmp-name1
))
2258 (file2 (expand-file-name elt file1
))
2259 (file3 (expand-file-name elt1 file1
)))
2260 (make-directory file1
'parents
)
2261 (should (file-directory-p file1
))
2262 (write-region elt nil file2
)
2263 (should (file-exists-p file2
))
2267 file1 nil directory-files-no-dot-files-regexp
)
2271 (caar (directory-files-and-attributes
2272 file1 nil directory-files-no-dot-files-regexp
))
2275 ;; Check symlink in `directory-files-and-attributes'.
2278 (make-symbolic-link file2 file3
)
2279 (should (file-symlink-p file3
))
2282 (caar (directory-files-and-attributes
2283 file1 nil
(regexp-quote elt1
)))
2288 (if quoted
'tramp-compat-file-name-quote
'identity
)
2289 (cadr (car (directory-files-and-attributes
2290 file1 nil
(regexp-quote elt1
)))))
2291 (file-remote-p (file-truename file2
) 'localname
)))
2293 (should-not (file-exists-p file3
)))
2295 (should (string-equal (error-message-string err
)
2296 "make-symbolic-link not supported"))))
2299 (should-not (file-exists-p file2
))
2300 (delete-directory file1
)
2301 (should-not (file-exists-p file1
))))
2303 ;; Check, that environment variables are set correctly.
2304 (when (and tramp--test-expensive-test
(tramp--test-sh-p))
2306 (let ((envvar (concat "VAR_" (upcase (md5 elt
))))
2307 (default-directory tramp-test-temporary-file-directory
)
2308 (process-environment process-environment
))
2310 ;; The value of PS1 could confuse Tramp's detection
2311 ;; of process output. So we unset it temporarily.
2314 (should (zerop (process-file "env" nil t nil
)))
2315 (goto-char (point-min))
2320 (regexp-quote envvar
)
2321 (regexp-quote (getenv envvar
))))))))))
2324 (ignore-errors (delete-directory tmp-name1
'recursive
))
2325 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2327 (defun tramp--test-special-characters ()
2328 "Perform the test in `tramp-test33-special-characters*'."
2329 ;; Newlines, slashes and backslashes in file names are not
2330 ;; supported. So we don't test. And we don't test the tab
2331 ;; character on Windows or Cygwin, because the backslash is
2332 ;; interpreted as a path separator, preventing "\t" from being
2333 ;; expanded to <TAB>.
2334 (tramp--test-check-files
2335 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2337 (if (or (tramp--test-adb-p)
2338 (tramp--test-docker-p)
2339 (eq system-type
'cygwin
))
2346 (unless (or (tramp--test-ftp-p)
2347 (tramp--test-gvfs-p)
2348 (tramp--test-windows-nt-or-smb-p))
2350 (unless (or (tramp--test-ftp-p)
2351 (tramp--test-gvfs-p)
2352 (tramp--test-windows-nt-or-smb-p))
2354 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2358 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2361 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2364 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2367 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
2370 ;; These tests are inspired by Bug#17238.
2371 (ert-deftest tramp-test33-special-characters
()
2372 "Check special characters in file names."
2373 (skip-unless (tramp--test-enabled))
2374 (skip-unless (not (tramp--test-rsync-p)))
2375 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2377 (tramp--test-special-characters))
2379 (ert-deftest tramp-test33-special-characters-with-stat
()
2380 "Check special characters in file names.
2381 Use the `stat' command."
2382 :tags
'(:expensive-test
)
2383 (skip-unless (tramp--test-enabled))
2384 (skip-unless (tramp--test-sh-p))
2385 (skip-unless (not (tramp--test-rsync-p)))
2386 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2387 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2388 (skip-unless (tramp-get-remote-stat v
)))
2390 (let ((tramp-connection-properties
2392 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2394 tramp-connection-properties
)))
2395 (tramp--test-special-characters)))
2397 (ert-deftest tramp-test33-special-characters-with-perl
()
2398 "Check special characters in file names.
2399 Use the `perl' command."
2400 :tags
'(:expensive-test
)
2401 (skip-unless (tramp--test-enabled))
2402 (skip-unless (tramp--test-sh-p))
2403 (skip-unless (not (tramp--test-rsync-p)))
2404 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2405 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2406 (skip-unless (tramp-get-remote-perl v
)))
2408 (let ((tramp-connection-properties
2410 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2412 ;; See `tramp-sh-handle-file-truename'.
2413 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2415 tramp-connection-properties
)))
2416 (tramp--test-special-characters)))
2418 (ert-deftest tramp-test33-special-characters-with-ls
()
2419 "Check special characters in file names.
2420 Use the `ls' command."
2421 :tags
'(:expensive-test
)
2422 (skip-unless (tramp--test-enabled))
2423 (skip-unless (tramp--test-sh-p))
2424 (skip-unless (not (tramp--test-rsync-p)))
2425 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2426 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2428 (let ((tramp-connection-properties
2430 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2432 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2434 ;; See `tramp-sh-handle-file-truename'.
2435 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2437 tramp-connection-properties
)))
2438 (tramp--test-special-characters)))
2440 (defun tramp--test-utf8 ()
2441 "Perform the test in `tramp-test34-utf8*'."
2442 (let* ((utf8 (if (and (eq system-type
'darwin
)
2443 (memq 'utf-8-hfs
(coding-system-list)))
2445 (coding-system-for-read utf8
)
2446 (coding-system-for-write utf8
)
2447 (file-name-coding-system utf8
))
2448 (tramp--test-check-files
2449 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
2450 (unless (tramp--test-hpux-p)
2451 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
2453 "Автостопом по гала́ктике")))
2455 (ert-deftest tramp-test34-utf8
()
2456 "Check UTF8 encoding in file names and file contents."
2457 (skip-unless (tramp--test-enabled))
2458 (skip-unless (not (tramp--test-docker-p)))
2459 (skip-unless (not (tramp--test-rsync-p)))
2460 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2461 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2465 (ert-deftest tramp-test34-utf8-with-stat
()
2466 "Check UTF8 encoding in file names and file contents.
2467 Use the `stat' command."
2468 :tags
'(:expensive-test
)
2469 (skip-unless (tramp--test-enabled))
2470 (skip-unless (tramp--test-sh-p))
2471 (skip-unless (not (tramp--test-docker-p)))
2472 (skip-unless (not (tramp--test-rsync-p)))
2473 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2474 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2475 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2476 (skip-unless (tramp-get-remote-stat v
)))
2478 (let ((tramp-connection-properties
2480 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2482 tramp-connection-properties
)))
2483 (tramp--test-utf8)))
2485 (ert-deftest tramp-test34-utf8-with-perl
()
2486 "Check UTF8 encoding in file names and file contents.
2487 Use the `perl' command."
2488 :tags
'(:expensive-test
)
2489 (skip-unless (tramp--test-enabled))
2490 (skip-unless (tramp--test-sh-p))
2491 (skip-unless (not (tramp--test-docker-p)))
2492 (skip-unless (not (tramp--test-rsync-p)))
2493 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2494 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2495 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2496 (skip-unless (tramp-get-remote-perl v
)))
2498 (let ((tramp-connection-properties
2500 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2502 ;; See `tramp-sh-handle-file-truename'.
2503 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2505 tramp-connection-properties
)))
2506 (tramp--test-utf8)))
2508 (ert-deftest tramp-test34-utf8-with-ls
()
2509 "Check UTF8 encoding in file names and file contents.
2510 Use the `ls' command."
2511 :tags
'(:expensive-test
)
2512 (skip-unless (tramp--test-enabled))
2513 (skip-unless (tramp--test-sh-p))
2514 (skip-unless (not (tramp--test-docker-p)))
2515 (skip-unless (not (tramp--test-rsync-p)))
2516 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2517 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2519 (let ((tramp-connection-properties
2521 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2523 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2525 ;; See `tramp-sh-handle-file-truename'.
2526 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2528 tramp-connection-properties
)))
2529 (tramp--test-utf8)))
2531 ;; This test is inspired by Bug#16928.
2532 (ert-deftest tramp-test35-asynchronous-requests
()
2533 "Check parallel asynchronous requests.
2534 Such requests could arrive from timers, process filters and
2535 process sentinels. They shall not disturb each other."
2536 ;; Mark as failed until bug has been fixed.
2537 :expected-result
:failed
2538 :tags
'(:expensive-test
)
2539 (skip-unless (tramp--test-enabled))
2540 (skip-unless (tramp--test-sh-p))
2542 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2543 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
2544 ;; This has the side effect, that this test fails instead to
2545 ;; abort. Good for hydra.
2546 (tramp--instrument-test-case 0
2547 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
2548 (default-directory tmp-name
)
2549 (remote-file-name-inhibit-cache t
)
2550 timer buffers kill-buffer-query-functions
)
2554 (make-directory tmp-name
)
2556 ;; Setup a timer in order to raise an ordinary command
2557 ;; again and again. `vc-registered' is well suited,
2558 ;; because there are many checks.
2566 (buffer-name (nth (random (length buffers
)) buffers
)))))))
2568 ;; Create temporary buffers. The number of buffers
2569 ;; corresponds to the number of processes; it could be
2570 ;; increased in order to make pressure on Tramp.
2572 (add-to-list 'buffers
(generate-new-buffer "*temp*")))
2574 ;; Open asynchronous processes. Set process sentinel.
2575 (dolist (buf buffers
)
2576 (async-shell-command "read line; touch $line; echo $line" buf
)
2577 (set-process-sentinel
2578 (get-buffer-process buf
)
2579 (lambda (proc _state
)
2580 (delete-file (buffer-name (process-buffer proc
))))))
2582 ;; Send a string. Use a random order of the buffers. Mix
2583 ;; with regular operation.
2584 (let ((buffers (copy-sequence buffers
))
2587 (setq buf
(nth (random (length buffers
)) buffers
))
2588 (process-send-string
2589 (get-buffer-process buf
) (format "'%s'\n" buf
))
2590 (file-attributes (buffer-name buf
))
2591 (setq buffers
(delq buf buffers
))))
2593 ;; Wait until the whole output has been read.
2594 (with-timeout ((* 10 (length buffers
))
2595 (ert-fail "`async-shell-command' timed out"))
2596 (let ((buffers (copy-sequence buffers
))
2599 (setq buf
(nth (random (length buffers
)) buffers
))
2601 (memq (process-status (get-buffer-process buf
))
2603 (accept-process-output (get-buffer-process buf
) 0.1)
2604 (setq buffers
(delq buf buffers
))))))
2607 (dolist (buf buffers
)
2608 (with-current-buffer buf
2610 (string-equal (format "'%s'\n" buf
) (buffer-string)))))
2613 tmp-name nil directory-files-no-dot-files-regexp
)))
2616 (ignore-errors (cancel-timer timer
))
2617 (ignore-errors (delete-directory tmp-name
'recursive
))
2618 (dolist (buf buffers
)
2619 (ignore-errors (kill-buffer buf
))))))))
2621 (ert-deftest tramp-test36-recursive-load
()
2622 "Check that Tramp does not fail due to recursive load."
2623 (skip-unless (tramp--test-enabled))
2627 (format "(expand-file-name %S)" tramp-test-temporary-file-directory
)
2629 "(let ((default-directory %S)) (expand-file-name %S))"
2630 tramp-test-temporary-file-directory
2631 temporary-file-directory
)))
2635 (shell-command-to-string
2637 "%s -batch -Q -L %s --eval %s"
2638 (expand-file-name invocation-name invocation-directory
)
2639 (mapconcat 'shell-quote-argument load-path
" -L ")
2640 (shell-quote-argument code
)))))))
2642 (ert-deftest tramp-test37-unload
()
2643 "Check that Tramp and its subpackages unload completely.
2644 Since it unloads Tramp, it shall be the last test to run."
2645 ;; Mark as failed until all symbols are unbound.
2646 :expected-result
(if (featurep 'tramp
) :failed
:passed
)
2647 :tags
'(:expensive-test
)
2648 (when (featurep 'tramp
)
2649 (unload-feature 'tramp
'force
)
2650 ;; No Tramp feature must be left.
2651 (should-not (featurep 'tramp
))
2652 (should-not (all-completions "tramp" (delq 'tramp-tests features
)))
2653 ;; `file-name-handler-alist' must be clean.
2654 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist
)))
2655 ;; There shouldn't be left a bound symbol. We do not regard our
2656 ;; test symbols, and the Tramp unload hooks.
2659 (and (or (boundp x
) (functionp x
))
2660 (string-match "^tramp" (symbol-name x
))
2661 (not (string-match "^tramp--?test" (symbol-name x
)))
2662 (not (string-match "unload-hook$" (symbol-name x
)))
2663 (ert-fail (format "`%s' still bound" x
)))))
2664 ;; There shouldn't be left a hook function containing a Tramp
2665 ;; function. We do not regard the Tramp unload hooks.
2669 (string-match "-hooks?$" (symbol-name x
))
2670 (not (string-match "unload-hook$" (symbol-name x
)))
2671 (consp (symbol-value x
))
2672 (ignore-errors (all-completions "tramp" (symbol-value x
)))
2673 (ert-fail (format "Hook `%s' still contains Tramp function" x
)))))))
2677 ;; * dired-compress-file
2680 ;; * file-name-case-insensitive-p
2681 ;; * file-selinux-context
2682 ;; * find-backup-file-name
2684 ;; * set-file-selinux-context
2686 ;; * Work on skipped tests. Make a comment, when it is impossible.
2687 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
2688 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
2689 ;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'.
2690 ;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set
2693 (defun tramp-test-all (&optional interactive
)
2694 "Run all tests for \\[tramp]."
2697 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
2699 (provide 'tramp-tests
)
2700 ;;; tramp-tests.el ends here
