1 ;;; tramp-tests.el --- Tests of remote file access
3 ;; Copyright (C) 2013-2014 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. Set
25 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order
26 ;; to overwrite the default value. If you want to skip tests
27 ;; accessing a remote host, set this environment variable to
28 ;; "/dev/null" or whatever is appropriate on your system.
30 ;; When running the tests in batch mode, it must NOT require an
31 ;; interactive password prompt unless the environment variable
32 ;; $REMOTE_ALLOW_PASSWORD is set.
34 ;; A whole test run can be performed calling the command `tramp-test-all'.
45 (declare-function tramp-find-executable
"tramp-sh")
46 (declare-function tramp-get-remote-path
"tramp-sh")
47 (defvar tramp-copy-size-limit
)
49 ;; There is no default value on w32 systems, which could work out of the box.
50 (defconst tramp-test-temporary-file-directory
52 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
53 ((eq system-type
'windows-nt
) null-device
)
54 (t (format "/ssh::%s" temporary-file-directory
)))
55 "Temporary directory for Tramp tests.")
57 (setq password-cache-expiry nil
59 tramp-message-show-message nil
)
61 ;; Disable interactive passwords in batch mode.
62 (when (and noninteractive
(not (getenv "REMOTE_ALLOW_PASSWORD")))
63 (defalias 'tramp-read-passwd
'ignore
))
65 ;; This shall happen on hydra only.
66 (when (getenv "NIX_STORE")
67 (add-to-list 'tramp-remote-path
'tramp-own-remote-path
))
69 (defvar tramp--test-enabled-checked nil
70 "Cached result of `tramp--test-enabled'.
71 If the function did run, the value is a cons cell, the `cdr'
74 (defun tramp--test-enabled ()
75 "Whether remote file access is enabled."
76 (unless (consp tramp--test-enabled-checked
)
78 tramp--test-enabled-checked
82 (file-remote-p tramp-test-temporary-file-directory
)
83 (file-directory-p tramp-test-temporary-file-directory
)
84 (file-writable-p tramp-test-temporary-file-directory
))))))
86 (when (cdr tramp--test-enabled-checked
)
87 ;; Cleanup connection.
88 (tramp-cleanup-connection
89 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
93 (cdr tramp--test-enabled-checked
))
95 (defun tramp--test-make-temp-name ()
96 "Create a temporary file name for test."
98 (make-temp-name "tramp-test") tramp-test-temporary-file-directory
))
100 (defmacro tramp--instrument-test-case
(verbose &rest body
)
101 "Run BODY with `tramp-verbose' equal VERBOSE.
102 Print the the content of the Tramp debug buffer, if BODY does not
103 eval properly in `should', `should-not' or `should-error'."
104 (declare (indent 1) (debug (natnump body
)))
105 `(let ((tramp-verbose ,verbose
)
106 (tramp-debug-on-error t
))
110 (signal (car err
) (cdr err
)))
112 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
113 (with-current-buffer (tramp-get-connection-buffer v
)
114 (message "%s" (buffer-string)))
115 (with-current-buffer (tramp-get-debug-buffer v
)
116 (message "%s" (buffer-string))))
118 (signal (car err
) (cdr err
))))))
120 (ert-deftest tramp-test00-availability
()
121 "Test availability of Tramp functions."
122 :expected-result
(if (tramp--test-enabled) :passed
:failed
)
123 (should (ignore-errors
125 (file-remote-p tramp-test-temporary-file-directory
)
126 (file-directory-p tramp-test-temporary-file-directory
)
127 (file-writable-p tramp-test-temporary-file-directory
)))))
129 (ert-deftest tramp-test01-file-name-syntax
()
130 "Check remote file name syntax."
132 (should (tramp-tramp-file-p "/method::"))
133 (should (tramp-tramp-file-p "/host:"))
134 (should (tramp-tramp-file-p "/user@:"))
135 (should (tramp-tramp-file-p "/user@host:"))
136 (should (tramp-tramp-file-p "/method:host:"))
137 (should (tramp-tramp-file-p "/method:user@:"))
138 (should (tramp-tramp-file-p "/method:user@host:"))
139 (should (tramp-tramp-file-p "/method:user@email@host:"))
142 (should (tramp-tramp-file-p "/host#1234:"))
143 (should (tramp-tramp-file-p "/user@host#1234:"))
144 (should (tramp-tramp-file-p "/method:host#1234:"))
145 (should (tramp-tramp-file-p "/method:user@host#1234:"))
147 ;; Using an IPv4 address.
148 (should (tramp-tramp-file-p "/1.2.3.4:"))
149 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
150 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
151 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
153 ;; Using an IPv6 address.
154 (should (tramp-tramp-file-p "/[]:"))
155 (should (tramp-tramp-file-p "/[::1]:"))
156 (should (tramp-tramp-file-p "/user@[::1]:"))
157 (should (tramp-tramp-file-p "/method:[::1]:"))
158 (should (tramp-tramp-file-p "/method:user@[::1]:"))
160 ;; Local file name part.
161 (should (tramp-tramp-file-p "/host:/:"))
162 (should (tramp-tramp-file-p "/method:::"))
163 (should (tramp-tramp-file-p "/method::/path/to/file"))
164 (should (tramp-tramp-file-p "/method::file"))
167 (should (tramp-tramp-file-p "/method1:|method2::"))
168 (should (tramp-tramp-file-p "/method1:host1|host2:"))
169 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
170 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
171 (should (tramp-tramp-file-p
172 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
175 (should-not (tramp-tramp-file-p nil
))
176 (should-not (tramp-tramp-file-p 'symbol
))
177 ;; "/:" suppresses file name handlers.
178 (should-not (tramp-tramp-file-p "/::"))
179 (should-not (tramp-tramp-file-p "/:@:"))
180 (should-not (tramp-tramp-file-p "/:[]:"))
181 ;; Multihops require a method.
182 (should-not (tramp-tramp-file-p "/host1|host2:"))
183 ;; Methods or hostnames shall be at least two characters on MS Windows.
184 (when (memq system-type
'(cygwin windows-nt
))
185 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
186 (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
188 (ert-deftest tramp-test02-file-name-dissect
()
189 "Check remote file name components."
190 (let ((tramp-default-method "default-method")
191 (tramp-default-user "default-user")
192 (tramp-default-host "default-host"))
193 ;; Expand `tramp-default-user' and `tramp-default-host'.
194 (should (string-equal
195 (file-remote-p "/method::")
196 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
197 (should (string-equal (file-remote-p "/method::" 'method
) "method"))
198 (should (string-equal (file-remote-p "/method::" 'user
) "default-user"))
199 (should (string-equal (file-remote-p "/method::" 'host
) "default-host"))
200 (should (string-equal (file-remote-p "/method::" 'localname
) ""))
202 ;; Expand `tramp-default-method' and `tramp-default-user'.
203 (should (string-equal
204 (file-remote-p "/host:")
205 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
206 (should (string-equal (file-remote-p "/host:" 'method
) "default-method"))
207 (should (string-equal (file-remote-p "/host:" 'user
) "default-user"))
208 (should (string-equal (file-remote-p "/host:" 'host
) "host"))
209 (should (string-equal (file-remote-p "/host:" 'localname
) ""))
211 ;; Expand `tramp-default-method' and `tramp-default-host'.
212 (should (string-equal
213 (file-remote-p "/user@:")
214 (format "/%s:%s@%s:" "default-method""user" "default-host")))
215 (should (string-equal (file-remote-p "/user@:" 'method
) "default-method"))
216 (should (string-equal (file-remote-p "/user@:" 'user
) "user"))
217 (should (string-equal (file-remote-p "/user@:" 'host
) "default-host"))
218 (should (string-equal (file-remote-p "/user@:" 'localname
) ""))
220 ;; Expand `tramp-default-method'.
221 (should (string-equal
222 (file-remote-p "/user@host:")
223 (format "/%s:%s@%s:" "default-method" "user" "host")))
224 (should (string-equal
225 (file-remote-p "/user@host:" 'method
) "default-method"))
226 (should (string-equal (file-remote-p "/user@host:" 'user
) "user"))
227 (should (string-equal (file-remote-p "/user@host:" 'host
) "host"))
228 (should (string-equal (file-remote-p "/user@host:" 'localname
) ""))
230 ;; Expand `tramp-default-user'.
231 (should (string-equal
232 (file-remote-p "/method:host:")
233 (format "/%s:%s@%s:" "method" "default-user" "host")))
234 (should (string-equal (file-remote-p "/method:host:" 'method
) "method"))
235 (should (string-equal (file-remote-p "/method:host:" 'user
) "default-user"))
236 (should (string-equal (file-remote-p "/method:host:" 'host
) "host"))
237 (should (string-equal (file-remote-p "/method:host:" 'localname
) ""))
239 ;; Expand `tramp-default-host'.
240 (should (string-equal
241 (file-remote-p "/method:user@:")
242 (format "/%s:%s@%s:" "method" "user" "default-host")))
243 (should (string-equal (file-remote-p "/method:user@:" 'method
) "method"))
244 (should (string-equal (file-remote-p "/method:user@:" 'user
) "user"))
245 (should (string-equal (file-remote-p "/method:user@:" 'host
)
247 (should (string-equal (file-remote-p "/method:user@:" 'localname
) ""))
250 (should (string-equal
251 (file-remote-p "/method:user@host:")
252 (format "/%s:%s@%s:" "method" "user" "host")))
253 (should (string-equal
254 (file-remote-p "/method:user@host:" 'method
) "method"))
255 (should (string-equal (file-remote-p "/method:user@host:" 'user
) "user"))
256 (should (string-equal (file-remote-p "/method:user@host:" 'host
) "host"))
257 (should (string-equal (file-remote-p "/method:user@host:" 'localname
) ""))
260 (should (string-equal
261 (file-remote-p "/method:user@email@host:")
262 (format "/%s:%s@%s:" "method" "user@email" "host")))
263 (should (string-equal
264 (file-remote-p "/method:user@email@host:" 'method
) "method"))
265 (should (string-equal
266 (file-remote-p "/method:user@email@host:" 'user
) "user@email"))
267 (should (string-equal
268 (file-remote-p "/method:user@email@host:" 'host
) "host"))
269 (should (string-equal
270 (file-remote-p "/method:user@email@host:" 'localname
) ""))
272 ;; Expand `tramp-default-method' and `tramp-default-user'.
273 (should (string-equal
274 (file-remote-p "/host#1234:")
275 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
276 (should (string-equal
277 (file-remote-p "/host#1234:" 'method
) "default-method"))
278 (should (string-equal (file-remote-p "/host#1234:" 'user
) "default-user"))
279 (should (string-equal (file-remote-p "/host#1234:" 'host
) "host#1234"))
280 (should (string-equal (file-remote-p "/host#1234:" 'localname
) ""))
282 ;; Expand `tramp-default-method'.
283 (should (string-equal
284 (file-remote-p "/user@host#1234:")
285 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
286 (should (string-equal
287 (file-remote-p "/user@host#1234:" 'method
) "default-method"))
288 (should (string-equal (file-remote-p "/user@host#1234:" 'user
) "user"))
289 (should (string-equal (file-remote-p "/user@host#1234:" 'host
) "host#1234"))
290 (should (string-equal (file-remote-p "/user@host#1234:" 'localname
) ""))
292 ;; Expand `tramp-default-user'.
293 (should (string-equal
294 (file-remote-p "/method:host#1234:")
295 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
296 (should (string-equal
297 (file-remote-p "/method:host#1234:" 'method
) "method"))
298 (should (string-equal
299 (file-remote-p "/method:host#1234:" 'user
) "default-user"))
300 (should (string-equal
301 (file-remote-p "/method:host#1234:" 'host
) "host#1234"))
302 (should (string-equal (file-remote-p "/method:host#1234:" 'localname
) ""))
305 (should (string-equal
306 (file-remote-p "/method:user@host#1234:")
307 (format "/%s:%s@%s:" "method" "user" "host#1234")))
308 (should (string-equal
309 (file-remote-p "/method:user@host#1234:" 'method
) "method"))
310 (should (string-equal
311 (file-remote-p "/method:user@host#1234:" 'user
) "user"))
312 (should (string-equal
313 (file-remote-p "/method:user@host#1234:" 'host
) "host#1234"))
314 (should (string-equal
315 (file-remote-p "/method:user@host#1234:" 'localname
) ""))
317 ;; Expand `tramp-default-method' and `tramp-default-user'.
318 (should (string-equal
319 (file-remote-p "/1.2.3.4:")
320 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
321 (should (string-equal (file-remote-p "/1.2.3.4:" 'method
) "default-method"))
322 (should (string-equal (file-remote-p "/1.2.3.4:" 'user
) "default-user"))
323 (should (string-equal (file-remote-p "/1.2.3.4:" 'host
) "1.2.3.4"))
324 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname
) ""))
326 ;; Expand `tramp-default-method'.
327 (should (string-equal
328 (file-remote-p "/user@1.2.3.4:")
329 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
330 (should (string-equal
331 (file-remote-p "/user@1.2.3.4:" 'method
) "default-method"))
332 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user
) "user"))
333 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host
) "1.2.3.4"))
334 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname
) ""))
336 ;; Expand `tramp-default-user'.
337 (should (string-equal
338 (file-remote-p "/method:1.2.3.4:")
339 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
340 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method
) "method"))
341 (should (string-equal
342 (file-remote-p "/method:1.2.3.4:" 'user
) "default-user"))
343 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host
) "1.2.3.4"))
344 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname
) ""))
347 (should (string-equal
348 (file-remote-p "/method:user@1.2.3.4:")
349 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
350 (should (string-equal
351 (file-remote-p "/method:user@1.2.3.4:" 'method
) "method"))
352 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user
) "user"))
353 (should (string-equal
354 (file-remote-p "/method:user@1.2.3.4:" 'host
) "1.2.3.4"))
355 (should (string-equal
356 (file-remote-p "/method:user@1.2.3.4:" 'localname
) ""))
358 ;; Expand `tramp-default-method', `tramp-default-user' and
359 ;; `tramp-default-host'.
360 (should (string-equal
361 (file-remote-p "/[]:")
363 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
364 (should (string-equal (file-remote-p "/[]:" 'method
) "default-method"))
365 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
366 (should (string-equal (file-remote-p "/[]:" 'host
) "default-host"))
367 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
369 ;; Expand `tramp-default-method' and `tramp-default-user'.
370 (let ((tramp-default-host "::1"))
371 (should (string-equal
372 (file-remote-p "/[]:")
373 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
374 (should (string-equal (file-remote-p "/[]:" 'method
) "default-method"))
375 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
376 (should (string-equal (file-remote-p "/[]:" 'host
) "::1"))
377 (should (string-equal (file-remote-p "/[]:" 'localname
) "")))
379 ;; Expand `tramp-default-method' and `tramp-default-user'.
380 (should (string-equal
381 (file-remote-p "/[::1]:")
382 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
383 (should (string-equal (file-remote-p "/[::1]:" 'method
) "default-method"))
384 (should (string-equal (file-remote-p "/[::1]:" 'user
) "default-user"))
385 (should (string-equal (file-remote-p "/[::1]:" 'host
) "::1"))
386 (should (string-equal (file-remote-p "/[::1]:" 'localname
) ""))
388 ;; Expand `tramp-default-method'.
389 (should (string-equal
390 (file-remote-p "/user@[::1]:")
391 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
392 (should (string-equal
393 (file-remote-p "/user@[::1]:" 'method
) "default-method"))
394 (should (string-equal (file-remote-p "/user@[::1]:" 'user
) "user"))
395 (should (string-equal (file-remote-p "/user@[::1]:" 'host
) "::1"))
396 (should (string-equal (file-remote-p "/user@[::1]:" 'localname
) ""))
398 ;; Expand `tramp-default-user'.
399 (should (string-equal
400 (file-remote-p "/method:[::1]:")
401 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
402 (should (string-equal (file-remote-p "/method:[::1]:" 'method
) "method"))
403 (should (string-equal
404 (file-remote-p "/method:[::1]:" 'user
) "default-user"))
405 (should (string-equal (file-remote-p "/method:[::1]:" 'host
) "::1"))
406 (should (string-equal (file-remote-p "/method:[::1]:" 'localname
) ""))
409 (should (string-equal
410 (file-remote-p "/method:user@[::1]:")
411 (format "/%s:%s@%s:" "method" "user" "[::1]")))
412 (should (string-equal
413 (file-remote-p "/method:user@[::1]:" 'method
) "method"))
414 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user
) "user"))
415 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host
) "::1"))
416 (should (string-equal
417 (file-remote-p "/method:user@[::1]:" 'localname
) ""))
419 ;; Local file name part.
420 (should (string-equal (file-remote-p "/host:/:" 'localname
) "/:"))
421 (should (string-equal (file-remote-p "/method:::" 'localname
) ":"))
422 (should (string-equal (file-remote-p "/method:: " 'localname
) " "))
423 (should (string-equal (file-remote-p "/method::file" 'localname
) "file"))
424 (should (string-equal
425 (file-remote-p "/method::/path/to/file" 'localname
)
431 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
432 (format "/%s:%s@%s:" "method2" "user2" "host2")))
436 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method
)
441 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user
)
446 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host
)
451 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname
)
457 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
458 (format "/%s:%s@%s:" "method3" "user3" "host3")))
462 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
468 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
474 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
480 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
484 (ert-deftest tramp-test03-file-name-defaults
()
485 "Check default values for some methods."
486 ;; Default values in tramp-adb.el.
487 (should (string-equal (file-remote-p "/adb::" 'host
) ""))
488 ;; Default values in tramp-ftp.el.
489 (should (string-equal (file-remote-p "/ftp.host:" 'method
) "ftp"))
490 (dolist (u '("ftp" "anonymous"))
491 (should (string-equal (file-remote-p (format "/%s@:" u
) 'method
) "ftp")))
492 ;; Default values in tramp-gvfs.el.
493 (when (and (load "tramp-gvfs" 'noerror
'nomessage
)
494 (symbol-value 'tramp-gvfs-enabled
))
495 (should (string-equal (file-remote-p "/synce::" 'user
) nil
)))
496 ;; Default values in tramp-gw.el.
497 (dolist (m '("tunnel" "socks"))
499 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
500 ;; Default values in tramp-sh.el.
501 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
502 (should (string-equal (file-remote-p (format "/root@%s:" h
) 'method
) "su")))
503 (dolist (m '("su" "sudo" "ksu"))
504 (should (string-equal (file-remote-p (format "/%s::" m
) 'user
) "root")))
505 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
507 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
508 ;; Default values in tramp-smb.el.
509 (should (string-equal (file-remote-p "/user%domain@host:" 'method
) "smb"))
510 (should (string-equal (file-remote-p "/smb::" 'user
) nil
)))
512 (ert-deftest tramp-test04-substitute-in-file-name
()
513 "Check `substitute-in-file-name'."
514 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
517 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
519 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
522 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
524 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
525 (let (process-environment)
528 (substitute-in-file-name "/method:host:/path/$FOO")
529 "/method:host:/path/$FOO"))
533 (substitute-in-file-name "/method:host:/path/$FOO")
534 "/method:host:/path/bla"))
537 (substitute-in-file-name "/method:host:/path/$$FOO")
538 "/method:host:/path/$FOO"))))
540 (ert-deftest tramp-test05-expand-file-name
()
541 "Check `expand-file-name'."
544 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
547 (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
549 (ert-deftest tramp-test06-directory-file-name
()
550 "Check `directory-file-name'.
551 This checks also `file-name-as-directory', `file-name-directory'
552 and `file-name-nondirectory'."
555 (directory-file-name "/method:host:/path/to/file")
556 "/method:host:/path/to/file"))
559 (directory-file-name "/method:host:/path/to/file/")
560 "/method:host:/path/to/file"))
563 (file-name-as-directory "/method:host:/path/to/file")
564 "/method:host:/path/to/file/"))
567 (file-name-as-directory "/method:host:/path/to/file/")
568 "/method:host:/path/to/file/"))
571 (file-name-directory "/method:host:/path/to/file")
572 "/method:host:/path/to/"))
575 (file-name-directory "/method:host:/path/to/file/")
576 "/method:host:/path/to/file/"))
578 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
580 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
583 (unhandled-file-name-directory "/method:host:/path/to/file"))))
585 (ert-deftest tramp-test07-file-exists-p
()
586 "Check `file-exist-p', `write-region' and `delete-file'."
587 (skip-unless (tramp--test-enabled))
589 (let ((tmp-name (tramp--test-make-temp-name)))
590 (should-not (file-exists-p tmp-name
))
591 (write-region "foo" nil tmp-name
)
592 (should (file-exists-p tmp-name
))
593 (delete-file tmp-name
)
594 (should-not (file-exists-p tmp-name
))))
596 (ert-deftest tramp-test08-file-local-copy
()
597 "Check `file-local-copy'."
598 (skip-unless (tramp--test-enabled))
600 (let ((tmp-name1 (tramp--test-make-temp-name))
604 (write-region "foo" nil tmp-name1
)
605 (should (setq tmp-name2
(file-local-copy tmp-name1
)))
607 (insert-file-contents tmp-name2
)
608 (should (string-equal (buffer-string) "foo"))))
610 (delete-file tmp-name1
)
611 (delete-file tmp-name2
)))))
613 (ert-deftest tramp-test09-insert-file-contents
()
614 "Check `insert-file-contents'."
615 (skip-unless (tramp--test-enabled))
617 (let ((tmp-name (tramp--test-make-temp-name)))
620 (write-region "foo" nil tmp-name
)
622 (insert-file-contents tmp-name
)
623 (should (string-equal (buffer-string) "foo"))
624 (insert-file-contents tmp-name
)
625 (should (string-equal (buffer-string) "foofoo"))
627 (insert-file-contents tmp-name nil
1 3)
628 (should (string-equal (buffer-string) "oofoofoo"))
630 (insert-file-contents tmp-name nil nil nil
'replace
)
631 (should (string-equal (buffer-string) "foo"))))
632 (ignore-errors (delete-file tmp-name
)))))
634 (ert-deftest tramp-test10-write-region
()
635 "Check `write-region'."
636 (skip-unless (tramp--test-enabled))
638 (let ((tmp-name (tramp--test-make-temp-name)))
643 (write-region nil nil tmp-name
))
645 (insert-file-contents tmp-name
)
646 (should (string-equal (buffer-string) "foo")))
650 (write-region nil nil tmp-name
'append
))
652 (insert-file-contents tmp-name
)
653 (should (string-equal (buffer-string) "foobla")))
655 (write-region "foo" nil tmp-name
)
657 (insert-file-contents tmp-name
)
658 (should (string-equal (buffer-string) "foo")))
662 (write-region 3 5 tmp-name
))
664 (insert-file-contents tmp-name
)
665 (should (string-equal (buffer-string) "34")))
666 ;; Trigger out-of-band copy.
668 (while (<= (length string
) tramp-copy-size-limit
)
669 (setq string
(concat string
(md5 string
))))
670 (write-region string nil tmp-name
)
672 (insert-file-contents tmp-name
)
673 (should (string-equal (buffer-string) string
)))))
674 (ignore-errors (delete-file tmp-name
)))))
676 (ert-deftest tramp-test11-copy-file
()
678 (skip-unless (tramp--test-enabled))
680 (let ((tmp-name1 (tramp--test-make-temp-name))
681 (tmp-name2 (tramp--test-make-temp-name)))
684 (write-region "foo" nil tmp-name1
)
685 (copy-file tmp-name1 tmp-name2
)
686 (should (file-exists-p tmp-name2
))
688 (insert-file-contents tmp-name2
)
689 (should (string-equal (buffer-string) "foo"))))
691 (delete-file tmp-name1
)
692 (delete-file tmp-name2
)))))
694 (ert-deftest tramp-test12-rename-file
()
695 "Check `rename-file'."
696 (skip-unless (tramp--test-enabled))
698 (let ((tmp-name1 (tramp--test-make-temp-name))
699 (tmp-name2 (tramp--test-make-temp-name)))
702 (write-region "foo" nil tmp-name1
)
703 (rename-file tmp-name1 tmp-name2
)
704 (should-not (file-exists-p tmp-name1
))
705 (should (file-exists-p tmp-name2
))
707 (insert-file-contents tmp-name2
)
708 (should (string-equal (buffer-string) "foo"))))
709 (ignore-errors (delete-file tmp-name2
)))))
711 (ert-deftest tramp-test13-make-directory
()
712 "Check `make-directory'.
713 This tests also `file-directory-p' and `file-accessible-directory-p'."
714 (skip-unless (tramp--test-enabled))
716 (let ((tmp-name (tramp--test-make-temp-name)))
719 (make-directory tmp-name
)
720 (should (file-directory-p tmp-name
))
721 (should (file-accessible-directory-p tmp-name
)))
722 (ignore-errors (delete-directory tmp-name
)))))
724 (ert-deftest tramp-test14-delete-directory
()
725 "Check `delete-directory'."
726 (skip-unless (tramp--test-enabled))
728 (let ((tmp-name (tramp--test-make-temp-name)))
729 ;; Delete empty directory.
730 (make-directory tmp-name
)
731 (should (file-directory-p tmp-name
))
732 (delete-directory tmp-name
)
733 (should-not (file-directory-p tmp-name
))
734 ;; Delete non-empty directory.
735 (make-directory tmp-name
)
736 (write-region "foo" nil
(expand-file-name "bla" tmp-name
))
737 (should-error (delete-directory tmp-name
) :type
'file-error
)
738 (delete-directory tmp-name
'recursive
)
739 (should-not (file-directory-p tmp-name
))))
741 (ert-deftest tramp-test15-copy-directory
()
742 "Check `copy-directory'."
743 (skip-unless (tramp--test-enabled))
745 (let* ((tmp-name1 (tramp--test-make-temp-name))
746 (tmp-name2 (tramp--test-make-temp-name))
747 (tmp-name3 (expand-file-name
748 (file-name-nondirectory tmp-name1
) tmp-name2
))
749 (tmp-name4 (expand-file-name "foo" tmp-name1
))
750 (tmp-name5 (expand-file-name "foo" tmp-name2
))
751 (tmp-name6 (expand-file-name "foo" tmp-name3
)))
754 ;; Copy empty directory.
755 (make-directory tmp-name1
)
756 (write-region "foo" nil tmp-name4
)
757 (should (file-directory-p tmp-name1
))
758 (should (file-exists-p tmp-name4
))
759 (copy-directory tmp-name1 tmp-name2
)
760 (should (file-directory-p tmp-name2
))
761 (should (file-exists-p tmp-name5
))
762 ;; Target directory does exist already.
763 (copy-directory tmp-name1 tmp-name2
)
764 (should (file-directory-p tmp-name3
))
765 (should (file-exists-p tmp-name6
)))
767 (delete-directory tmp-name1
'recursive
)
768 (delete-directory tmp-name2
'recursive
)))))
770 (ert-deftest tramp-test16-directory-files
()
771 "Check `directory-files'."
772 (skip-unless (tramp--test-enabled))
774 (let* ((tmp-name1 (tramp--test-make-temp-name))
775 (tmp-name2 (expand-file-name "bla" tmp-name1
))
776 (tmp-name3 (expand-file-name "foo" tmp-name1
)))
779 (make-directory tmp-name1
)
780 (write-region "foo" nil tmp-name2
)
781 (write-region "bla" nil tmp-name3
)
782 (should (file-directory-p tmp-name1
))
783 (should (file-exists-p tmp-name2
))
784 (should (file-exists-p tmp-name3
))
785 (should (equal (directory-files tmp-name1
) '("." ".." "bla" "foo")))
786 (should (equal (directory-files tmp-name1
'full
)
787 `(,(concat tmp-name1
"/.")
788 ,(concat tmp-name1
"/..")
789 ,tmp-name2
,tmp-name3
)))
790 (should (equal (directory-files
791 tmp-name1 nil directory-files-no-dot-files-regexp
)
793 (should (equal (directory-files
794 tmp-name1
'full directory-files-no-dot-files-regexp
)
795 `(,tmp-name2
,tmp-name3
))))
796 (ignore-errors (delete-directory tmp-name1
'recursive
)))))
798 (ert-deftest tramp-test17-insert-directory
()
799 "Check `insert-directory'."
800 (skip-unless (tramp--test-enabled))
802 (let* ((tmp-name1 (tramp--test-make-temp-name))
803 (tmp-name2 (expand-file-name "foo" tmp-name1
)))
806 (make-directory tmp-name1
)
807 (write-region "foo" nil tmp-name2
)
808 (should (file-directory-p tmp-name1
))
809 (should (file-exists-p tmp-name2
))
811 (insert-directory tmp-name1 nil
)
812 (goto-char (point-min))
813 (should (looking-at-p (regexp-quote tmp-name1
))))
815 (insert-directory tmp-name1
"-al")
816 (goto-char (point-min))
817 (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1
)))))
819 (insert-directory (file-name-as-directory tmp-name1
) "-al")
820 (goto-char (point-min))
822 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1
)))))
825 (file-name-as-directory tmp-name1
) "-al" nil
'full-directory-p
)
826 (goto-char (point-min))
829 "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$"))))
830 (ignore-errors (delete-directory tmp-name1
'recursive
)))))
832 (ert-deftest tramp-test18-file-attributes
()
833 "Check `file-attributes'.
834 This tests also `file-readable-p' and `file-regular-p'."
835 (skip-unless (tramp--test-enabled))
837 (let ((tmp-name (tramp--test-make-temp-name))
841 (write-region "foo" nil tmp-name
)
842 (should (file-exists-p tmp-name
))
843 (setq attr
(file-attributes tmp-name
))
844 (should (consp attr
))
845 (should (file-exists-p tmp-name
))
846 (should (file-readable-p tmp-name
))
847 (should (file-regular-p tmp-name
))
848 ;; We do not test inodes and device numbers.
849 (should (null (car attr
)))
850 (should (numberp (nth 1 attr
))) ;; Link.
851 (should (numberp (nth 2 attr
))) ;; Uid.
852 (should (numberp (nth 3 attr
))) ;; Gid.
854 (should (stringp (current-time-string (nth 4 attr
))))
855 ;; Last modification time.
856 (should (stringp (current-time-string (nth 5 attr
))))
857 ;; Last status change time.
858 (should (stringp (current-time-string (nth 6 attr
))))
859 (should (numberp (nth 7 attr
))) ;; Size.
860 (should (stringp (nth 8 attr
))) ;; Modes.
862 (setq attr
(file-attributes tmp-name
'string
))
863 (should (stringp (nth 2 attr
))) ;; Uid.
864 (should (stringp (nth 3 attr
))) ;; Gid.
865 (delete-file tmp-name
)
867 (make-directory tmp-name
)
868 (should (file-exists-p tmp-name
))
869 (should (file-readable-p tmp-name
))
870 (should-not (file-regular-p tmp-name
))
871 (setq attr
(file-attributes tmp-name
))
872 (should (eq (car attr
) t
)))
873 (ignore-errors (delete-directory tmp-name
)))))
875 (ert-deftest tramp-test19-directory-files-and-attributes
()
876 "Check `directory-files-and-attributes'."
877 (skip-unless (tramp--test-enabled))
879 ;; `directory-files-and-attributes' contains also values for "../".
880 ;; Ensure that this doesn't change during tests, for
881 ;; example due to handling temporary files.
882 (let* ((tmp-name1 (tramp--test-make-temp-name))
883 (tmp-name2 (expand-file-name "bla" tmp-name1
))
887 (make-directory tmp-name1
)
888 (should (file-directory-p tmp-name1
))
889 (make-directory tmp-name2
)
890 (should (file-directory-p tmp-name2
))
891 (write-region "foo" nil
(expand-file-name "foo" tmp-name2
))
892 (write-region "bar" nil
(expand-file-name "bar" tmp-name2
))
893 (write-region "boz" nil
(expand-file-name "boz" tmp-name2
))
894 (setq attr
(directory-files-and-attributes tmp-name2
))
895 (should (consp attr
))
898 (equal (file-attributes (expand-file-name (car elt
) tmp-name2
))
900 (setq attr
(directory-files-and-attributes tmp-name2
'full
))
903 (equal (file-attributes (car elt
)) (cdr elt
))))
904 (setq attr
(directory-files-and-attributes tmp-name2 nil
"^b"))
905 (should (equal (mapcar 'car attr
) '("bar" "boz"))))
906 (ignore-errors (delete-directory tmp-name1
'recursive
)))))
908 (ert-deftest tramp-test20-file-modes
()
910 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
911 (skip-unless (tramp--test-enabled))
915 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
916 '(tramp-adb-file-name-handler
917 tramp-gvfs-file-name-handler
918 tramp-smb-file-name-handler
))))
920 (let ((tmp-name (tramp--test-make-temp-name)))
923 (write-region "foo" nil tmp-name
)
924 (should (file-exists-p tmp-name
))
925 (set-file-modes tmp-name
#o777
)
926 (should (= (file-modes tmp-name
) #o777
))
927 (should (file-executable-p tmp-name
))
928 (should (file-writable-p tmp-name
))
929 (set-file-modes tmp-name
#o444
)
930 (should (= (file-modes tmp-name
) #o444
))
931 (should-not (file-executable-p tmp-name
))
932 ;; A file is always writable for user "root".
933 (when (not (string-equal (file-remote-p tmp-name
'user
) "root"))
934 (should-not (file-writable-p tmp-name
))))
935 (ignore-errors (delete-file tmp-name
)))))
937 (ert-deftest tramp-test21-file-links
()
938 "Check `file-symlink-p'.
939 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
940 (skip-unless (tramp--test-enabled))
942 (let ((tmp-name1 (tramp--test-make-temp-name))
943 (tmp-name2 (tramp--test-make-temp-name))
944 (tmp-name3 (make-temp-name "tramp-")))
947 (write-region "foo" nil tmp-name1
)
948 (should (file-exists-p tmp-name1
))
949 ;; Method "smb" supports `make-symbolic-link' only if the
950 ;; remote host has CIFS capabilities. tramp-adb.el and
951 ;; tramp-gvfs.el do not support symbolic links at all.
953 (make-symbolic-link tmp-name1 tmp-name2
)
956 (not (string-equal (error-message-string err
)
957 "make-symbolic-link not supported")))))
958 (should (file-symlink-p tmp-name2
))
959 (should-error (make-symbolic-link tmp-name1 tmp-name2
))
960 (make-symbolic-link tmp-name1 tmp-name2
'ok-if-already-exists
)
961 (should (file-symlink-p tmp-name2
))
962 ;; `tmp-name3' is a local file name.
963 (should-error (make-symbolic-link tmp-name1 tmp-name3
)))
965 (delete-file tmp-name1
)
966 (delete-file tmp-name2
)))
970 (write-region "foo" nil tmp-name1
)
971 (should (file-exists-p tmp-name1
))
972 (add-name-to-file tmp-name1 tmp-name2
)
973 (should-not (file-symlink-p tmp-name2
))
974 (should-error (add-name-to-file tmp-name1 tmp-name2
))
975 (add-name-to-file tmp-name1 tmp-name2
'ok-if-already-exists
)
976 (should-not (file-symlink-p tmp-name2
))
977 ;; `tmp-name3' is a local file name.
978 (should-error (add-name-to-file tmp-name1 tmp-name3
)))
980 (delete-file tmp-name1
)
981 (delete-file tmp-name2
)))
985 (write-region "foo" nil tmp-name1
)
986 (should (file-exists-p tmp-name1
))
987 (make-symbolic-link tmp-name1 tmp-name2
)
988 (should (file-symlink-p tmp-name2
))
989 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
991 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
))))
993 (delete-file tmp-name1
)
994 (delete-file tmp-name2
)))
996 ;; `file-truename' shall preserve trailing link of directories.
997 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory
))
998 (dir2 (file-name-as-directory dir1
)))
999 (should (string-equal (file-truename dir1
) (expand-file-name dir1
)))
1000 (should (string-equal (file-truename dir2
) (expand-file-name dir2
))))))
1002 (ert-deftest tramp-test22-file-times
()
1003 "Check `set-file-times' and `file-newer-than-file-p'."
1004 (skip-unless (tramp--test-enabled))
1008 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1009 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler
))))
1011 (let ((tmp-name1 (tramp--test-make-temp-name))
1012 (tmp-name2 (tramp--test-make-temp-name))
1013 (tmp-name3 (tramp--test-make-temp-name)))
1016 (write-region "foo" nil tmp-name1
)
1017 (should (file-exists-p tmp-name1
))
1018 (should (consp (nth 5 (file-attributes tmp-name1
))))
1019 ;; '(0 0) means don't know, and will be replaced by
1020 ;; `current-time'. Therefore, we use '(0 1).
1021 ;; We skip the test, if the remote handler is not able to
1022 ;; set the correct time.
1023 (skip-unless (set-file-times tmp-name1
'(0 1)))
1024 ;; Dumb busyboxes are not able to return the date correctly.
1025 ;; They say "don't know.
1026 (skip-unless (not (equal (nth 5 (file-attributes tmp-name1
)) '(0 0))))
1027 (should (equal (nth 5 (file-attributes tmp-name1
)) '(0 1)))
1028 (write-region "bla" nil tmp-name2
)
1029 (should (file-exists-p tmp-name2
))
1030 (should (file-newer-than-file-p tmp-name2 tmp-name1
))
1031 ;; `tmp-name3' does not exist.
1032 (should (file-newer-than-file-p tmp-name2 tmp-name3
))
1033 (should-not (file-newer-than-file-p tmp-name3 tmp-name1
)))
1035 (delete-file tmp-name1
)
1036 (delete-file tmp-name2
)))))
1038 (ert-deftest tramp-test23-visited-file-modtime
()
1039 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1040 (skip-unless (tramp--test-enabled))
1042 (let ((tmp-name (tramp--test-make-temp-name)))
1045 (write-region "foo" nil tmp-name
)
1046 (should (file-exists-p tmp-name
))
1048 (insert-file-contents tmp-name
)
1049 (should (verify-visited-file-modtime))
1050 (set-visited-file-modtime '(0 1))
1051 (should (verify-visited-file-modtime))
1052 (should (equal (visited-file-modtime) '(0 1 0 0)))))
1053 (ignore-errors (delete-file tmp-name
)))))
1055 (ert-deftest tramp-test24-file-name-completion
()
1056 "Check `file-name-completion' and `file-name-all-completions'."
1057 (skip-unless (tramp--test-enabled))
1059 (let ((tmp-name (tramp--test-make-temp-name)))
1062 (make-directory tmp-name
)
1063 (should (file-directory-p tmp-name
))
1064 (write-region "foo" nil
(expand-file-name "foo" tmp-name
))
1065 (write-region "bar" nil
(expand-file-name "bold" tmp-name
))
1066 (make-directory (expand-file-name "boz" tmp-name
))
1067 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
1068 (should (equal (file-name-completion "b" tmp-name
) "bo"))
1070 (equal (file-name-completion "b" tmp-name
'file-directory-p
) "boz/"))
1071 (should (equal (file-name-all-completions "fo" tmp-name
) '("foo")))
1073 (equal (sort (file-name-all-completions "b" tmp-name
) 'string-lessp
)
1075 (ignore-errors (delete-directory tmp-name
'recursive
)))))
1077 (ert-deftest tramp-test25-load
()
1079 (skip-unless (tramp--test-enabled))
1081 (let ((tmp-name (tramp--test-make-temp-name)))
1084 (load tmp-name
'noerror
'nomessage
)
1085 (should-not (featurep 'tramp-test-load
))
1086 (write-region "(provide 'tramp-test-load)" nil tmp-name
)
1087 ;; `load' in lread.c does not pass `must-suffix'. Why?
1088 ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1089 (load tmp-name nil
'nomessage
'nosuffix
)
1090 (should (featurep 'tramp-test-load
)))
1092 (and (featurep 'tramp-test-load
) (unload-feature 'tramp-test-load
))
1093 (delete-file tmp-name
)))))
1095 (ert-deftest tramp-test26-process-file
()
1096 "Check `process-file'."
1097 (skip-unless (tramp--test-enabled))
1101 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1102 '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler
))))
1104 (let ((tmp-name (tramp--test-make-temp-name))
1105 (default-directory tramp-test-temporary-file-directory
)
1106 kill-buffer-query-functions
)
1109 ;; We cannot use "/bin/true" and "/bin/false"; those paths
1110 ;; do not exist on hydra.
1111 (should (zerop (process-file "true")))
1112 (should-not (zerop (process-file "false")))
1113 (should-not (zerop (process-file "binary-does-not-exist")))
1115 (write-region "foo" nil tmp-name
)
1116 (should (file-exists-p tmp-name
))
1119 (process-file "ls" nil t nil
(file-name-nondirectory tmp-name
))))
1120 ;; `ls' could produce colorized output.
1121 (goto-char (point-min))
1122 (while (re-search-forward tramp-color-escape-sequence-regexp nil t
)
1123 (replace-match "" nil nil
))
1126 (format "%s\n" (file-name-nondirectory tmp-name
))
1128 (ignore-errors (delete-file tmp-name
)))))
1130 (ert-deftest tramp-test27-start-file-process
()
1131 "Check `start-file-process'."
1132 (skip-unless (tramp--test-enabled))
1136 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1137 '(tramp-adb-file-name-handler
1138 tramp-gvfs-file-name-handler
1139 tramp-smb-file-name-handler
))))
1141 (let ((default-directory tramp-test-temporary-file-directory
)
1142 (tmp-name (tramp--test-make-temp-name))
1143 kill-buffer-query-functions proc
)
1146 (setq proc
(start-file-process "test1" (current-buffer) "cat"))
1147 (should (processp proc
))
1148 (should (equal (process-status proc
) 'run
))
1149 (process-send-string proc
"foo")
1150 (process-send-eof proc
)
1151 (accept-process-output proc
1)
1152 (should (string-equal (buffer-string) "foo")))
1153 (ignore-errors (delete-process proc
)))
1157 (write-region "foo" nil tmp-name
)
1158 (should (file-exists-p tmp-name
))
1161 "test2" (current-buffer)
1162 "cat" (file-name-nondirectory tmp-name
)))
1163 (should (processp proc
))
1164 (accept-process-output proc
1)
1165 (should (string-equal (buffer-string) "foo")))
1167 (delete-process proc
)
1168 (delete-file tmp-name
)))
1172 (setq proc
(start-file-process "test3" nil
"cat"))
1173 (should (processp proc
))
1174 (should (equal (process-status proc
) 'run
))
1176 proc
(lambda (_p s
) (should (string-equal s
"foo"))))
1177 (process-send-string proc
"foo")
1178 (process-send-eof proc
)
1179 (accept-process-output proc
1))
1180 (ignore-errors (delete-process proc
)))))
1182 (ert-deftest tramp-test28-shell-command
()
1183 "Check `shell-command'."
1184 (skip-unless (tramp--test-enabled))
1188 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1189 '(tramp-adb-file-name-handler
1190 tramp-gvfs-file-name-handler
1191 tramp-smb-file-name-handler
))))
1193 (let ((tmp-name (tramp--test-make-temp-name))
1194 (default-directory tramp-test-temporary-file-directory
)
1195 kill-buffer-query-functions
)
1198 (write-region "foo" nil tmp-name
)
1199 (should (file-exists-p tmp-name
))
1201 (format "ls %s" (file-name-nondirectory tmp-name
)) (current-buffer))
1202 ;; `ls' could produce colorized output.
1203 (goto-char (point-min))
1204 (while (re-search-forward tramp-color-escape-sequence-regexp nil t
)
1205 (replace-match "" nil nil
))
1208 (format "%s\n" (file-name-nondirectory tmp-name
)) (buffer-string))))
1209 (ignore-errors (delete-file tmp-name
)))
1213 (write-region "foo" nil tmp-name
)
1214 (should (file-exists-p tmp-name
))
1215 (async-shell-command
1216 (format "ls %s" (file-name-nondirectory tmp-name
)) (current-buffer))
1217 (accept-process-output (get-buffer-process (current-buffer)) 1)
1218 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1221 (memq (process-status (get-buffer-process (current-buffer)))
1223 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1224 ;; `ls' could produce colorized output.
1225 (goto-char (point-min))
1226 (while (re-search-forward tramp-color-escape-sequence-regexp nil t
)
1227 (replace-match "" nil nil
))
1230 (format "%s\n" (file-name-nondirectory tmp-name
)) (buffer-string))))
1231 (ignore-errors (delete-file tmp-name
)))
1235 (write-region "foo" nil tmp-name
)
1236 (should (file-exists-p tmp-name
))
1237 (async-shell-command "read line; ls $line" (current-buffer))
1238 (process-send-string
1239 (get-buffer-process (current-buffer))
1240 (format "%s\n" (file-name-nondirectory tmp-name
)))
1241 (accept-process-output (get-buffer-process (current-buffer)) 1)
1242 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1245 (memq (process-status (get-buffer-process (current-buffer)))
1247 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1250 (format "%s\n" (file-name-nondirectory tmp-name
)) (buffer-string))))
1251 (ignore-errors (delete-file tmp-name
)))))
1253 (ert-deftest tramp-test29-vc-registered
()
1254 "Check `vc-registered'."
1255 (skip-unless (tramp--test-enabled))
1258 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1259 'tramp-sh-file-name-handler
))
1261 (let* ((default-directory tramp-test-temporary-file-directory
)
1262 (tmp-name1 (tramp--test-make-temp-name))
1263 (tmp-name2 (expand-file-name "foo" tmp-name1
))
1264 (vc-handled-backends
1265 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1267 ((tramp-find-executable v vc-bzr-program
(tramp-get-remote-path v
))
1269 ((tramp-find-executable v vc-git-program
(tramp-get-remote-path v
))
1271 ((tramp-find-executable v vc-hg-program
(tramp-get-remote-path v
))
1274 (skip-unless vc-handled-backends
)
1275 (message "%s" vc-handled-backends
)
1279 (make-directory tmp-name1
)
1280 (write-region "foo" nil tmp-name2
)
1281 (should (file-directory-p tmp-name1
))
1282 (should (file-exists-p tmp-name2
))
1283 (should-not (vc-registered tmp-name1
))
1284 (should-not (vc-registered tmp-name2
))
1286 (let ((default-directory tmp-name1
))
1287 ;; Create empty repository, and register the file.
1288 (vc-create-repo (car vc-handled-backends
))
1289 ;; The structure of VC-FILESET is not documented. Let's
1290 ;; hope it won't change.
1292 nil
(list (car vc-handled-backends
)
1293 (list (file-name-nondirectory tmp-name2
)))))
1294 (should (vc-registered tmp-name2
)))
1296 (ignore-errors (delete-directory tmp-name1
'recursive
)))))
1298 (ert-deftest tramp-test30-utf8
()
1299 "Check UTF8 encoding in file names and file contents."
1300 (skip-unless (tramp--test-enabled))
1302 (let ((tmp-name (tramp--test-make-temp-name))
1303 (coding-system-for-read 'utf-8
)
1304 (coding-system-for-write 'utf-8
)
1305 (arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
1306 (chinese "银河系漫游指南系列")
1307 (russian "Автостопом по гала́ктике"))
1310 (make-directory tmp-name
)
1311 (dolist (lang `(,arabic
,chinese
,russian
))
1312 (let ((file (expand-file-name lang tmp-name
)))
1313 (write-region lang nil file
)
1314 (should (file-exists-p file
))
1315 ;; Check file contents.
1317 (insert-file-contents file
)
1318 (should (string-equal (buffer-string) lang
)))))
1319 ;; Check file names.
1320 (should (equal (directory-files
1321 tmp-name nil directory-files-no-dot-files-regexp
)
1322 (sort `(,arabic
,chinese
,russian
) 'string-lessp
))))
1323 (ignore-errors (delete-directory tmp-name
'recursive
)))))
1325 ;; This test is inspired by Bug#16928.
1326 (ert-deftest tramp-test31-asynchronous-requests
()
1327 "Check parallel asynchronous requests.
1328 Such requests could arrive from timers, process filters and
1329 process sentinels. They shall not disturb each other."
1330 ;; Mark as failed until bug has been fixed.
1331 :expected-result
:failed
1332 (skip-unless (tramp--test-enabled))
1335 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
1336 'tramp-sh-file-name-handler
))
1338 ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
1339 ;; has the side effect, that this test fails instead to abort. Good
1341 (tramp--instrument-test-case 0
1342 (let* ((tmp-name (tramp--test-make-temp-name))
1343 (default-directory tmp-name
)
1344 (remote-file-name-inhibit-cache t
)
1345 timer buffers kill-buffer-query-functions
)
1349 (make-directory tmp-name
)
1351 ;; Setup a timer in order to raise an ordinary command again
1352 ;; and again. `vc-registered' is well suited, because there
1361 (buffer-name (nth (random (length buffers
)) buffers
)))))))
1363 ;; Create temporary buffers. The number of buffers
1364 ;; corresponds to the number of processes; it could be
1365 ;; increased in order to make pressure on Tramp.
1367 (add-to-list 'buffers
(generate-new-buffer "*temp*")))
1369 ;; Open asynchronous processes. Set process sentinel.
1370 (dolist (buf buffers
)
1371 (async-shell-command "read line; touch $line; echo $line" buf
)
1372 (set-process-sentinel
1373 (get-buffer-process buf
)
1374 (lambda (proc _state
)
1375 (delete-file (buffer-name (process-buffer proc
))))))
1377 ;; Send a string. Use a random order of the buffers. Mix
1378 ;; with regular operation.
1379 (let ((buffers (copy-sequence buffers
))
1382 (setq buf
(nth (random (length buffers
)) buffers
))
1383 (process-send-string
1384 (get-buffer-process buf
) (format "'%s'\n" buf
))
1385 (file-attributes (buffer-name buf
))
1386 (setq buffers
(delq buf buffers
))))
1388 ;; Wait until the whole output has been read.
1389 (with-timeout ((* 10 (length buffers
))
1390 (ert-fail "`async-shell-command' timed out"))
1391 (let ((buffers (copy-sequence buffers
))
1394 (setq buf
(nth (random (length buffers
)) buffers
))
1396 (memq (process-status (get-buffer-process buf
))
1398 (accept-process-output (get-buffer-process buf
) 0.1)
1399 (setq buffers
(delq buf buffers
))))))
1402 (dolist (buf buffers
)
1403 (with-current-buffer buf
1405 (string-equal (format "'%s'\n" buf
) (buffer-string)))))
1407 (directory-files tmp-name nil directory-files-no-dot-files-regexp
)))
1410 (ignore-errors (cancel-timer timer
))
1411 (ignore-errors (delete-directory tmp-name
'recursive
))
1412 (dolist (buf buffers
)
1413 (ignore-errors (kill-buffer buf
)))))))
1417 ;; * dired-compress-file
1420 ;; * file-ownership-preserved-p
1421 ;; * file-selinux-context
1422 ;; * find-backup-file-name
1423 ;; * make-auto-save-file-name
1425 ;; * set-file-selinux-context
1427 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
1428 ;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
1429 ;; * Fix `tramp-test30-utf8' on MS Windows. Seems to be in `directory-files'.
1430 ;; * Fix Bug#16928. Set expected error of `tramp-test31-asynchronous-requests'.
1432 (defun tramp-test-all (&optional interactive
)
1433 "Run all tests for \\[tramp]."
1436 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
1438 (provide 'tramp-tests
)
1439 ;;; tramp-tests.el ends here