1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2016 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'.
1997 (subst-char-in-string
1998 ?
/ ?
! (replace-regexp-in-string "!" "!!" tmp-name1
)))
1999 temporary-file-directory
)))))
2002 (let (tramp-auto-save-directory auto-save-file-name-transforms
)
2004 (setq buffer-file-name tmp-name1
)
2007 (make-auto-save-file-name)
2009 (if quoted
'tramp-compat-file-name-quote
'identity
)
2011 (format "#%s#" (file-name-nondirectory tmp-name1
))
2012 tramp-test-temporary-file-directory
))))))
2014 ;; Use default `tramp-auto-save-directory' mechanism.
2015 (let ((tramp-auto-save-directory tmp-name2
))
2017 (setq buffer-file-name tmp-name1
)
2020 (make-auto-save-file-name)
2021 ;; This is taken from Tramp.
2025 (tramp-subst-strs-in-string
2032 (tramp-compat-file-name-unquote tmp-name1
)))
2034 (should (file-directory-p tmp-name2
))))
2036 ;; Relative file names shall work, too.
2037 (let ((tramp-auto-save-directory "."))
2039 (setq buffer-file-name tmp-name1
2040 default-directory tmp-name2
)
2043 (make-auto-save-file-name)
2044 ;; This is taken from Tramp.
2048 (tramp-subst-strs-in-string
2055 (tramp-compat-file-name-unquote tmp-name1
)))
2057 (should (file-directory-p tmp-name2
)))))
2060 (ignore-errors (delete-file tmp-name1
))
2061 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2063 ;; The functions were introduced in Emacs 26.1.
2064 (ert-deftest tramp-test32-make-nearby-temp-file
()
2065 "Check `make-nearby-temp-file' and `temporary-file-directory'."
2066 (skip-unless (tramp--test-enabled))
2068 (and (fboundp 'make-nearby-temp-file
) (fboundp 'temporary-file-directory
)))
2070 (let ((default-directory tramp-test-temporary-file-directory
)
2072 ;; The remote host shall know a temporary file directory.
2073 (should (stringp (temporary-file-directory)))
2076 (file-remote-p default-directory
)
2077 (file-remote-p (temporary-file-directory))))
2079 ;; The temporary file shall be located on the remote host.
2080 (setq tmp-file
(make-nearby-temp-file "tramp-test"))
2081 (should (file-exists-p tmp-file
))
2082 (should (file-regular-p tmp-file
))
2085 (file-remote-p default-directory
)
2086 (file-remote-p tmp-file
)))
2087 (delete-file tmp-file
)
2088 (should-not (file-exists-p tmp-file
))
2090 (setq tmp-file
(make-nearby-temp-file "tramp-test" 'dir
))
2091 (should (file-exists-p tmp-file
))
2092 (should (file-directory-p tmp-file
))
2093 (delete-directory tmp-file
)
2094 (should-not (file-exists-p tmp-file
))))
2096 (defun tramp--test-adb-p ()
2097 "Check, whether the remote host runs Android.
2098 This requires restrictions of file name syntax."
2099 (tramp-adb-file-name-p tramp-test-temporary-file-directory
))
2101 (defun tramp--test-docker-p ()
2102 "Check, whether the docker method is used.
2103 This does not support some special file names."
2105 "docker" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2107 (defun tramp--test-ftp-p ()
2108 "Check, whether an FTP-like method is used.
2109 This does not support globbing characters in file names (yet)."
2110 ;; Globbing characters are ??, ?* and ?\[.
2112 "ftp$" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2114 (defun tramp--test-gvfs-p ()
2115 "Check, whether the remote host runs a GVFS based method.
2116 This requires restrictions of file name syntax."
2117 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory
))
2119 (defun tramp--test-hpux-p ()
2120 "Check, whether the remote host runs HP-UX.
2121 Several special characters do not work properly there."
2122 ;; We must refill the cache. `file-truename' does it.
2123 (with-parsed-tramp-file-name
2124 (file-truename tramp-test-temporary-file-directory
) nil
2125 (string-match "^HP-UX" (tramp-get-connection-property v
"uname" ""))))
2127 (defun tramp--test-rsync-p ()
2128 "Check, whether the rsync method is used.
2129 This does not support special file names."
2131 "rsync" (file-remote-p tramp-test-temporary-file-directory
'method
)))
2133 (defun tramp--test-sh-p ()
2134 "Check, whether the remote host runs a based method from tramp-sh.el."
2136 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
2137 'tramp-sh-file-name-handler
))
2139 (defun tramp--test-windows-nt-and-batch ()
2140 "Check, whether the locale host runs MS Windows in batch mode.
2141 This does not support special characters."
2142 (and (eq system-type
'windows-nt
) noninteractive
))
2144 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
2145 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
2146 This does not support utf8 based file transfer."
2147 (and (eq system-type
'windows-nt
)
2149 (regexp-opt '("pscp" "psftp"))
2150 (file-remote-p tramp-test-temporary-file-directory
'method
))))
2152 (defun tramp--test-windows-nt-or-smb-p ()
2153 "Check, whether the locale or remote host runs MS Windows.
2154 This requires restrictions of file name syntax."
2155 (or (eq system-type
'windows-nt
)
2156 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)))
2158 (defun tramp--test-check-files (&rest files
)
2159 "Run a simple but comprehensive test over every file in FILES."
2160 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2161 ;; We must use `file-truename' for the temporary directory,
2162 ;; because it could be located on a symlinked directory. This
2163 ;; would let the test fail.
2164 (let* ((tramp-test-temporary-file-directory
2165 (file-truename tramp-test-temporary-file-directory
))
2166 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2167 (tmp-name2 (tramp--test-make-temp-name 'local quoted
))
2168 (files (delq nil files
))
2169 (process-environment process-environment
))
2172 ;; Add environment variables.
2174 ;; The check command (heredoc file) does not support
2175 ;; environment variables with leading spaces.
2176 (let* ((elt (replace-regexp-in-string "^\\s-+" "" elt
))
2177 (envvar (concat "VAR_" (upcase (md5 elt
)))))
2178 (setenv envvar elt
)))
2180 ;; We force a reconnect, in order to have a clean environment.
2181 (tramp-cleanup-connection
2182 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
2183 'keep-debug
'keep-password
)
2184 (make-directory tmp-name1
)
2185 (make-directory tmp-name2
)
2188 (let* ((file1 (expand-file-name elt tmp-name1
))
2189 (file2 (expand-file-name elt tmp-name2
))
2190 (file3 (expand-file-name (concat elt
"foo") tmp-name1
)))
2191 (write-region elt nil file1
)
2192 (should (file-exists-p file1
))
2194 ;; Check file contents.
2196 (insert-file-contents file1
)
2197 (should (string-equal (buffer-string) elt
)))
2199 ;; Copy file both directions.
2200 (copy-file file1 tmp-name2
)
2201 (should (file-exists-p file2
))
2203 (should-not (file-exists-p file1
))
2204 (copy-file file2 tmp-name1
)
2205 (should (file-exists-p file1
))
2207 ;; Method "smb" supports `make-symbolic-link' only if the
2208 ;; remote host has CIFS capabilities. tramp-adb.el and
2209 ;; tramp-gvfs.el do not support symbolic links at all.
2212 (make-symbolic-link file1 file3
)
2213 (should (file-symlink-p file3
))
2216 (expand-file-name file1
) (file-truename file3
)))
2220 (if quoted
'tramp-compat-file-name-quote
'identity
)
2221 (car (file-attributes file3
)))
2222 (file-remote-p (file-truename file1
) 'localname
)))
2223 ;; Check file contents.
2225 (insert-file-contents file3
)
2226 (should (string-equal (buffer-string) elt
)))
2227 (delete-file file3
))
2230 (string-equal (error-message-string err
)
2231 "make-symbolic-link not supported"))))))
2233 ;; Check file names.
2234 (should (equal (directory-files
2235 tmp-name1 nil directory-files-no-dot-files-regexp
)
2236 (sort (copy-sequence files
) 'string-lessp
)))
2237 (should (equal (directory-files
2238 tmp-name2 nil directory-files-no-dot-files-regexp
)
2239 (sort (copy-sequence files
) 'string-lessp
)))
2241 ;; `substitute-in-file-name' could return different
2242 ;; values. For `adb', there could be strange file
2243 ;; permissions preventing overwriting a file. We don't
2244 ;; care in this testcase.
2247 (substitute-in-file-name (expand-file-name elt tmp-name1
)))
2249 (substitute-in-file-name
2250 (expand-file-name elt tmp-name2
))))
2251 (ignore-errors (write-region elt nil file1
))
2252 (should (file-exists-p file1
))
2253 (ignore-errors (write-region elt nil file2 nil
'nomessage
))
2254 (should (file-exists-p file2
))))
2256 (should (equal (directory-files
2257 tmp-name1 nil directory-files-no-dot-files-regexp
)
2259 tmp-name2 nil directory-files-no-dot-files-regexp
)))
2261 ;; Check directory creation. We use a subdirectory "foo"
2262 ;; in order to avoid conflicts with previous file name tests.
2264 (let* ((elt1 (concat elt
"foo"))
2265 (file1 (expand-file-name (concat "foo/" elt
) tmp-name1
))
2266 (file2 (expand-file-name elt file1
))
2267 (file3 (expand-file-name elt1 file1
)))
2268 (make-directory file1
'parents
)
2269 (should (file-directory-p file1
))
2270 (write-region elt nil file2
)
2271 (should (file-exists-p file2
))
2275 file1 nil directory-files-no-dot-files-regexp
)
2279 (caar (directory-files-and-attributes
2280 file1 nil directory-files-no-dot-files-regexp
))
2283 ;; Check symlink in `directory-files-and-attributes'.
2286 (make-symbolic-link file2 file3
)
2287 (should (file-symlink-p file3
))
2290 (caar (directory-files-and-attributes
2291 file1 nil
(regexp-quote elt1
)))
2296 (if quoted
'tramp-compat-file-name-quote
'identity
)
2297 (cadr (car (directory-files-and-attributes
2298 file1 nil
(regexp-quote elt1
)))))
2299 (file-remote-p (file-truename file2
) 'localname
)))
2301 (should-not (file-exists-p file3
)))
2303 (should (string-equal (error-message-string err
)
2304 "make-symbolic-link not supported"))))
2307 (should-not (file-exists-p file2
))
2308 (delete-directory file1
)
2309 (should-not (file-exists-p file1
))))
2311 ;; Check, that environment variables are set correctly.
2312 (when (and tramp--test-expensive-test
(tramp--test-sh-p))
2313 (dolist (elt process-environment
)
2314 (when (string-match "^VAR_" elt
)
2315 (let* ((default-directory tramp-test-temporary-file-directory
)
2316 (shell-file-name "/bin/sh")
2317 (heredoc (md5 (current-time-string)))
2318 (envvar (car (split-string elt
"=" t
)))
2319 (file1 (tramp-compat-file-name-unquote
2320 (expand-file-name "bar" tmp-name1
))))
2322 (ignore-errors (delete-file file1
))
2323 ;; Save the variable in a file. The echo command
2324 ;; does not work properly, it suppresses leading/
2325 ;; trailing spaces as well as tabs.
2326 (shell-command-to-string
2328 "cat <<%s >%s\n$%s\n%s"
2329 heredoc
(file-remote-p file1
'localname
) envvar heredoc
))
2331 (insert-file-contents file1
)
2334 (buffer-string) (concat (getenv envvar
) "\n"))))
2336 (should-not (file-exists-p file1
)))))))
2339 (ignore-errors (delete-directory tmp-name1
'recursive
))
2340 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2342 (defun tramp--test-special-characters ()
2343 "Perform the test in `tramp-test33-special-characters*'."
2344 ;; Newlines, slashes and backslashes in file names are not
2345 ;; supported. So we don't test. And we don't test the tab
2346 ;; character on Windows or Cygwin, because the backslash is
2347 ;; interpreted as a path separator, preventing "\t" from being
2348 ;; expanded to <TAB>.
2349 (tramp--test-check-files
2350 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2352 (if (or (tramp--test-adb-p)
2353 (tramp--test-docker-p)
2354 (eq system-type
'cygwin
))
2361 (unless (or (tramp--test-ftp-p)
2362 (tramp--test-gvfs-p)
2363 (tramp--test-windows-nt-or-smb-p))
2365 (unless (or (tramp--test-ftp-p)
2366 (tramp--test-gvfs-p)
2367 (tramp--test-windows-nt-or-smb-p))
2369 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2373 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2376 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2379 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
2382 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
2385 ;; These tests are inspired by Bug#17238.
2386 (ert-deftest tramp-test33-special-characters
()
2387 "Check special characters in file names."
2388 (skip-unless (tramp--test-enabled))
2389 (skip-unless (not (tramp--test-rsync-p)))
2390 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2392 (tramp--test-special-characters))
2394 (ert-deftest tramp-test33-special-characters-with-stat
()
2395 "Check special characters in file names.
2396 Use the `stat' command."
2397 :tags
'(:expensive-test
)
2398 (skip-unless (tramp--test-enabled))
2399 (skip-unless (tramp--test-sh-p))
2400 (skip-unless (not (tramp--test-rsync-p)))
2401 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2402 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2403 (skip-unless (tramp-get-remote-stat v
)))
2405 (let ((tramp-connection-properties
2407 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2409 tramp-connection-properties
)))
2410 (tramp--test-special-characters)))
2412 (ert-deftest tramp-test33-special-characters-with-perl
()
2413 "Check special characters in file names.
2414 Use the `perl' command."
2415 :tags
'(:expensive-test
)
2416 (skip-unless (tramp--test-enabled))
2417 (skip-unless (tramp--test-sh-p))
2418 (skip-unless (not (tramp--test-rsync-p)))
2419 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2420 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2421 (skip-unless (tramp-get-remote-perl v
)))
2423 (let ((tramp-connection-properties
2425 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2427 ;; See `tramp-sh-handle-file-truename'.
2428 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2430 tramp-connection-properties
)))
2431 (tramp--test-special-characters)))
2433 (ert-deftest tramp-test33-special-characters-with-ls
()
2434 "Check special characters in file names.
2435 Use the `ls' command."
2436 :tags
'(:expensive-test
)
2437 (skip-unless (tramp--test-enabled))
2438 (skip-unless (tramp--test-sh-p))
2439 (skip-unless (not (tramp--test-rsync-p)))
2440 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2441 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2443 (let ((tramp-connection-properties
2445 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2447 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2449 ;; See `tramp-sh-handle-file-truename'.
2450 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2452 tramp-connection-properties
)))
2453 (tramp--test-special-characters)))
2455 (defun tramp--test-utf8 ()
2456 "Perform the test in `tramp-test34-utf8*'."
2457 (let* ((utf8 (if (and (eq system-type
'darwin
)
2458 (memq 'utf-8-hfs
(coding-system-list)))
2460 (coding-system-for-read utf8
)
2461 (coding-system-for-write utf8
)
2462 (file-name-coding-system utf8
))
2463 (tramp--test-check-files
2464 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
2465 (unless (tramp--test-hpux-p)
2466 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
2468 "Автостопом по гала́ктике")))
2470 (ert-deftest tramp-test34-utf8
()
2471 "Check UTF8 encoding in file names and file contents."
2472 (skip-unless (tramp--test-enabled))
2473 (skip-unless (not (tramp--test-docker-p)))
2474 (skip-unless (not (tramp--test-rsync-p)))
2475 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2476 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2480 (ert-deftest tramp-test34-utf8-with-stat
()
2481 "Check UTF8 encoding in file names and file contents.
2482 Use the `stat' command."
2483 :tags
'(:expensive-test
)
2484 (skip-unless (tramp--test-enabled))
2485 (skip-unless (tramp--test-sh-p))
2486 (skip-unless (not (tramp--test-docker-p)))
2487 (skip-unless (not (tramp--test-rsync-p)))
2488 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2489 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2490 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2491 (skip-unless (tramp-get-remote-stat v
)))
2493 (let ((tramp-connection-properties
2495 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2497 tramp-connection-properties
)))
2498 (tramp--test-utf8)))
2500 (ert-deftest tramp-test34-utf8-with-perl
()
2501 "Check UTF8 encoding in file names and file contents.
2502 Use the `perl' command."
2503 :tags
'(:expensive-test
)
2504 (skip-unless (tramp--test-enabled))
2505 (skip-unless (tramp--test-sh-p))
2506 (skip-unless (not (tramp--test-docker-p)))
2507 (skip-unless (not (tramp--test-rsync-p)))
2508 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2509 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2510 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
2511 (skip-unless (tramp-get-remote-perl v
)))
2513 (let ((tramp-connection-properties
2515 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2517 ;; See `tramp-sh-handle-file-truename'.
2518 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2520 tramp-connection-properties
)))
2521 (tramp--test-utf8)))
2523 (ert-deftest tramp-test34-utf8-with-ls
()
2524 "Check UTF8 encoding in file names and file contents.
2525 Use the `ls' command."
2526 :tags
'(:expensive-test
)
2527 (skip-unless (tramp--test-enabled))
2528 (skip-unless (tramp--test-sh-p))
2529 (skip-unless (not (tramp--test-docker-p)))
2530 (skip-unless (not (tramp--test-rsync-p)))
2531 (skip-unless (not (tramp--test-windows-nt-and-batch)))
2532 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
2534 (let ((tramp-connection-properties
2536 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2538 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2540 ;; See `tramp-sh-handle-file-truename'.
2541 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
2543 tramp-connection-properties
)))
2544 (tramp--test-utf8)))
2546 ;; This test is inspired by Bug#16928.
2547 (ert-deftest tramp-test35-asynchronous-requests
()
2548 "Check parallel asynchronous requests.
2549 Such requests could arrive from timers, process filters and
2550 process sentinels. They shall not disturb each other."
2551 ;; Mark as failed until bug has been fixed.
2552 :expected-result
:failed
2553 :tags
'(:expensive-test
)
2554 (skip-unless (tramp--test-enabled))
2555 (skip-unless (tramp--test-sh-p))
2557 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2558 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
2559 ;; This has the side effect, that this test fails instead to
2560 ;; abort. Good for hydra.
2561 (tramp--instrument-test-case 0
2562 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
2563 (default-directory tmp-name
)
2564 (remote-file-name-inhibit-cache t
)
2565 timer buffers kill-buffer-query-functions
)
2569 (make-directory tmp-name
)
2571 ;; Setup a timer in order to raise an ordinary command
2572 ;; again and again. `vc-registered' is well suited,
2573 ;; because there are many checks.
2581 (buffer-name (nth (random (length buffers
)) buffers
)))))))
2583 ;; Create temporary buffers. The number of buffers
2584 ;; corresponds to the number of processes; it could be
2585 ;; increased in order to make pressure on Tramp.
2587 (add-to-list 'buffers
(generate-new-buffer "*temp*")))
2589 ;; Open asynchronous processes. Set process sentinel.
2590 (dolist (buf buffers
)
2591 (async-shell-command "read line; touch $line; echo $line" buf
)
2592 (set-process-sentinel
2593 (get-buffer-process buf
)
2594 (lambda (proc _state
)
2595 (delete-file (buffer-name (process-buffer proc
))))))
2597 ;; Send a string. Use a random order of the buffers. Mix
2598 ;; with regular operation.
2599 (let ((buffers (copy-sequence buffers
))
2602 (setq buf
(nth (random (length buffers
)) buffers
))
2603 (process-send-string
2604 (get-buffer-process buf
) (format "'%s'\n" buf
))
2605 (file-attributes (buffer-name buf
))
2606 (setq buffers
(delq buf buffers
))))
2608 ;; Wait until the whole output has been read.
2609 (with-timeout ((* 10 (length buffers
))
2610 (ert-fail "`async-shell-command' timed out"))
2611 (let ((buffers (copy-sequence buffers
))
2614 (setq buf
(nth (random (length buffers
)) buffers
))
2616 (memq (process-status (get-buffer-process buf
))
2618 (accept-process-output (get-buffer-process buf
) 0.1)
2619 (setq buffers
(delq buf buffers
))))))
2622 (dolist (buf buffers
)
2623 (with-current-buffer buf
2625 (string-equal (format "'%s'\n" buf
) (buffer-string)))))
2628 tmp-name nil directory-files-no-dot-files-regexp
)))
2631 (ignore-errors (cancel-timer timer
))
2632 (ignore-errors (delete-directory tmp-name
'recursive
))
2633 (dolist (buf buffers
)
2634 (ignore-errors (kill-buffer buf
))))))))
2636 (ert-deftest tramp-test36-recursive-load
()
2637 "Check that Tramp does not fail due to recursive load."
2638 (skip-unless (tramp--test-enabled))
2642 (format "(expand-file-name %S)" tramp-test-temporary-file-directory
)
2644 "(let ((default-directory %S)) (expand-file-name %S))"
2645 tramp-test-temporary-file-directory
2646 temporary-file-directory
)))
2650 (shell-command-to-string
2652 "%s -batch -Q -L %s --eval %s"
2653 (expand-file-name invocation-name invocation-directory
)
2654 (mapconcat 'shell-quote-argument load-path
" -L ")
2655 (shell-quote-argument code
)))))))
2657 (ert-deftest tramp-test37-unload
()
2658 "Check that Tramp and its subpackages unload completely.
2659 Since it unloads Tramp, it shall be the last test to run."
2660 ;; Mark as failed until all symbols are unbound.
2661 :expected-result
(if (featurep 'tramp
) :failed
:passed
)
2662 :tags
'(:expensive-test
)
2663 (when (featurep 'tramp
)
2664 (unload-feature 'tramp
'force
)
2665 ;; No Tramp feature must be left.
2666 (should-not (featurep 'tramp
))
2667 (should-not (all-completions "tramp" (delq 'tramp-tests features
)))
2668 ;; `file-name-handler-alist' must be clean.
2669 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist
)))
2670 ;; There shouldn't be left a bound symbol. We do not regard our
2671 ;; test symbols, and the Tramp unload hooks.
2674 (and (or (boundp x
) (functionp x
))
2675 (string-match "^tramp" (symbol-name x
))
2676 (not (string-match "^tramp--?test" (symbol-name x
)))
2677 (not (string-match "unload-hook$" (symbol-name x
)))
2678 (ert-fail (format "`%s' still bound" x
)))))
2679 ;; There shouldn't be left a hook function containing a Tramp
2680 ;; function. We do not regard the Tramp unload hooks.
2684 (string-match "-hooks?$" (symbol-name x
))
2685 (not (string-match "unload-hook$" (symbol-name x
)))
2686 (consp (symbol-value x
))
2687 (ignore-errors (all-completions "tramp" (symbol-value x
)))
2688 (ert-fail (format "Hook `%s' still contains Tramp function" x
)))))))
2692 ;; * dired-compress-file
2695 ;; * file-name-case-insensitive-p
2696 ;; * file-selinux-context
2697 ;; * find-backup-file-name
2699 ;; * set-file-selinux-context
2701 ;; * Work on skipped tests. Make a comment, when it is impossible.
2702 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
2703 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
2704 ;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'.
2705 ;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set
2708 (defun tramp-test-all (&optional interactive
)
2709 "Run all tests for \\[tramp]."
2712 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
2714 (provide 'tramp-tests
)
2715 ;;; tramp-tests.el ends here