1 ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see `http://www.gnu.org/licenses/'.
22 ;; The tests require a recent ert.el from Emacs 24.4.
24 ;; Some of the tests require access to a remote host files. Since
25 ;; this could be problematic, a mock-up connection method "mock" is
26 ;; used. Emulating a remote connection, it simply calls "sh -i".
27 ;; Tramp's file name handlers still run, so this test is sufficient
28 ;; except for connection establishing.
30 ;; If you want to test a real Tramp connection, set
31 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
32 ;; overwrite the default value. If you want to skip tests accessing a
33 ;; remote host, set this environment variable to "/dev/null" or
34 ;; whatever is appropriate on your system.
36 ;; A whole test run can be performed calling the command `tramp-test-all'.
49 (declare-function tramp-find-executable
"tramp-sh")
50 (declare-function tramp-get-remote-path
"tramp-sh")
51 (declare-function tramp-get-remote-stat
"tramp-sh")
52 (declare-function tramp-get-remote-perl
"tramp-sh")
53 (defvar auto-save-file-name-transforms
)
54 (defvar tramp-copy-size-limit
)
55 (defvar tramp-persistency-file-name
)
56 (defvar tramp-remote-process-environment
)
57 ;; Suppress nasty messages.
58 (fset 'shell-command-sentinel
'ignore
)
60 ;; There is no default value on w32 systems, which could work out of the box.
61 (defconst tramp-test-temporary-file-directory
63 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
64 ((eq system-type
'windows-nt
) null-device
)
68 (tramp-login-program "sh")
69 (tramp-login-args (("-i")))
70 (tramp-remote-shell "/bin/sh")
71 (tramp-remote-shell-args ("-c"))
72 (tramp-connection-timeout 10)))
74 'tramp-default-host-alist
75 `("\\`mock\\'" nil
,(system-name)))
76 ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
77 ;; batch mode only, therefore.
78 (unless (and (null noninteractive
) (file-directory-p "~/"))
79 (setenv "HOME" temporary-file-directory
))
80 (format "/mock::%s" temporary-file-directory
)))
81 "Temporary directory for Tramp tests.")
83 (setq password-cache-expiry nil
85 tramp-cache-read-persistent-data t
;; For auth-sources.
86 tramp-copy-size-limit nil
87 tramp-message-show-message nil
88 tramp-persistency-file-name nil
)
90 ;; This should happen on hydra only.
91 (when (getenv "EMACS_HYDRA_CI")
92 (add-to-list 'tramp-remote-path
'tramp-own-remote-path
))
94 (defvar tramp--test-expensive-test
96 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
97 "Whether expensive tests are run.")
99 (defvar tramp--test-enabled-checked nil
100 "Cached result of `tramp--test-enabled'.
101 If the function did run, the value is a cons cell, the `cdr'
104 (defun tramp--test-enabled ()
105 "Whether remote file access is enabled."
106 (unless (consp tramp--test-enabled-checked
)
108 tramp--test-enabled-checked
112 (file-remote-p tramp-test-temporary-file-directory
)
113 (file-directory-p tramp-test-temporary-file-directory
)
114 (file-writable-p tramp-test-temporary-file-directory
))))))
116 (when (cdr tramp--test-enabled-checked
)
117 ;; Cleanup connection.
119 (tramp-cleanup-connection
120 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
121 nil
'keep-password
)))
124 (cdr tramp--test-enabled-checked
))
126 (defun tramp--test-make-temp-name (&optional local quoted
)
127 "Return a temporary file name for test.
128 If LOCAL is non-nil, a local file name is returned.
129 If QUOTED is non-nil, the local part of the file name is quoted.
130 The temporary file is not created."
132 (if quoted
'tramp-compat-file-name-quote
'identity
)
134 (make-temp-name "tramp-test")
135 (if local temporary-file-directory tramp-test-temporary-file-directory
))))
137 ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
138 (defvar tramp--test-instrument-test-case-p nil
139 "Whether `tramp--test-instrument-test-case' run.
140 This shall used dynamically bound only.")
142 (defmacro tramp--test-instrument-test-case
(verbose &rest body
)
143 "Run BODY with `tramp-verbose' equal VERBOSE.
144 Print the the content of the Tramp debug buffer, if BODY does not
145 eval properly in `should' or `should-not'. `should-error' is not
146 handled properly. BODY shall not contain a timeout."
147 (declare (indent 1) (debug (natnump body
)))
148 `(let ((tramp-verbose (max (or ,verbose
0) (or tramp-verbose
0)))
149 (tramp-message-show-message t
)
150 (tramp-debug-on-error t
)
151 (debug-ignored-errors
152 (cons "^make-symbolic-link not supported$" debug-ignored-errors
))
155 (let ((tramp--test-instrument-test-case-p t
)) ,@body
)
157 (when (and (null tramp--test-instrument-test-case-p
) (> tramp-verbose
3))
158 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
159 (with-current-buffer (tramp-get-connection-buffer v
)
160 (message "%s" (buffer-string)))
161 (with-current-buffer (tramp-get-debug-buffer v
)
162 (message "%s" (buffer-string))))))))
164 (defsubst tramp--test-message
(fmt-string &rest arguments
)
165 "Emit a message into ERT *Messages*."
166 (tramp--test-instrument-test-case 0
169 (tramp-dissect-file-name tramp-test-temporary-file-directory
) 0
170 fmt-string arguments
)))
172 (defsubst tramp--test-backtrace
()
173 "Dump a backtrace into ERT *Messages*."
174 (tramp--test-instrument-test-case 10
176 (tramp-dissect-file-name tramp-test-temporary-file-directory
))))
178 (ert-deftest tramp-test00-availability
()
179 "Test availability of Tramp functions."
180 :expected-result
(if (tramp--test-enabled) :passed
:failed
)
182 "Remote directory: `%s'" tramp-test-temporary-file-directory
)
183 (should (ignore-errors
185 (file-remote-p tramp-test-temporary-file-directory
)
186 (file-directory-p tramp-test-temporary-file-directory
)
187 (file-writable-p tramp-test-temporary-file-directory
)))))
189 (ert-deftest tramp-test01-file-name-syntax
()
190 "Check remote file name syntax."
192 (should (tramp-tramp-file-p "/method::"))
193 (should (tramp-tramp-file-p "/method:host:"))
194 (should (tramp-tramp-file-p "/method:user@:"))
195 (should (tramp-tramp-file-p "/method:user@host:"))
196 (should (tramp-tramp-file-p "/method:user@email@host:"))
199 (should (tramp-tramp-file-p "/method:host#1234:"))
200 (should (tramp-tramp-file-p "/method:user@host#1234:"))
202 ;; Using an IPv4 address.
203 (should (tramp-tramp-file-p "/method:1.2.3.4:"))
204 (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
206 ;; Using an IPv6 address.
207 (should (tramp-tramp-file-p "/method:[::1]:"))
208 (should (tramp-tramp-file-p "/method:user@[::1]:"))
210 ;; Local file name part.
211 (should (tramp-tramp-file-p "/method:::"))
212 (should (tramp-tramp-file-p "/method::/:"))
213 (should (tramp-tramp-file-p "/method::/path/to/file"))
214 (should (tramp-tramp-file-p "/method::/:/path/to/file"))
215 (should (tramp-tramp-file-p "/method::file"))
216 (should (tramp-tramp-file-p "/method::/:file"))
219 (should (tramp-tramp-file-p "/method1:|method2::"))
220 (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
221 (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
222 (should (tramp-tramp-file-p
223 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
226 (should-not (tramp-tramp-file-p nil
))
227 (should-not (tramp-tramp-file-p 'symbol
))
229 (should-not (tramp-tramp-file-p "/host:"))
230 (should-not (tramp-tramp-file-p "/user@host:"))
231 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
232 (should-not (tramp-tramp-file-p "/[]:"))
233 (should-not (tramp-tramp-file-p "/[::1]:"))
234 (should-not (tramp-tramp-file-p "/host:/:"))
235 (should-not (tramp-tramp-file-p "/host1|host2:"))
236 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
237 ;; Quote with "/:" suppresses file name handlers.
238 (should-not (tramp-tramp-file-p "/::"))
239 (should-not (tramp-tramp-file-p "/:@:"))
240 (should-not (tramp-tramp-file-p "/:[]:"))
241 ;; Methods shall be at least two characters on MS Windows, except
242 ;; the default method.
243 (let ((system-type 'windows-nt
))
244 (should-not (tramp-tramp-file-p "/c:/path/to/file"))
245 (should-not (tramp-tramp-file-p "/c::/path/to/file"))
246 (should (tramp-tramp-file-p "/-::/path/to/file")))
247 (let ((system-type 'gnu
/linux
))
248 (should (tramp-tramp-file-p "/-:h:/path/to/file"))
249 (should (tramp-tramp-file-p "/m::/path/to/file"))))
251 (ert-deftest tramp-test01-file-name-syntax-simplified
()
252 "Check simplified file name syntax."
253 :tags
'(:expensive-test
)
254 (let ((syntax tramp-syntax
))
257 (tramp-change-syntax 'simplified
)
259 (should (tramp-tramp-file-p "/host:"))
260 (should (tramp-tramp-file-p "/user@:"))
261 (should (tramp-tramp-file-p "/user@host:"))
262 (should (tramp-tramp-file-p "/user@email@host:"))
265 (should (tramp-tramp-file-p "/host#1234:"))
266 (should (tramp-tramp-file-p "/user@host#1234:"))
268 ;; Using an IPv4 address.
269 (should (tramp-tramp-file-p "/1.2.3.4:"))
270 (should (tramp-tramp-file-p "/user@1.2.3.4:"))
272 ;; Using an IPv6 address.
273 (should (tramp-tramp-file-p "/[::1]:"))
274 (should (tramp-tramp-file-p "/user@[::1]:"))
276 ;; Local file name part.
277 (should (tramp-tramp-file-p "/host::"))
278 (should (tramp-tramp-file-p "/host:/:"))
279 (should (tramp-tramp-file-p "/host:/path/to/file"))
280 (should (tramp-tramp-file-p "/host:/:/path/to/file"))
281 (should (tramp-tramp-file-p "/host:file"))
282 (should (tramp-tramp-file-p "/host:/:file"))
285 (should (tramp-tramp-file-p "/host1|host2:"))
286 (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
287 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
290 (should-not (tramp-tramp-file-p nil
))
291 (should-not (tramp-tramp-file-p 'symbol
))
292 ;; Quote with "/:" suppresses file name handlers.
293 (should-not (tramp-tramp-file-p "/::"))
294 (should-not (tramp-tramp-file-p "/:@:"))
295 (should-not (tramp-tramp-file-p "/:[]:")))
298 (tramp-change-syntax syntax
))))
300 (ert-deftest tramp-test01-file-name-syntax-separate
()
301 "Check separate file name syntax."
302 :tags
'(:expensive-test
)
303 (let ((syntax tramp-syntax
))
306 (tramp-change-syntax 'separate
)
308 (should (tramp-tramp-file-p "/[method/]"))
309 (should (tramp-tramp-file-p "/[method/host]"))
310 (should (tramp-tramp-file-p "/[method/user@]"))
311 (should (tramp-tramp-file-p "/[method/user@host]"))
312 (should (tramp-tramp-file-p "/[method/user@email@host]"))
315 (should (tramp-tramp-file-p "/[method/host#1234]"))
316 (should (tramp-tramp-file-p "/[method/user@host#1234]"))
318 ;; Using an IPv4 address.
319 (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
320 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
322 ;; Using an IPv6 address.
323 (should (tramp-tramp-file-p "/[method/::1]"))
324 (should (tramp-tramp-file-p "/[method/user@::1]"))
326 ;; Local file name part.
327 (should (tramp-tramp-file-p "/[method/]"))
328 (should (tramp-tramp-file-p "/[method/]/:"))
329 (should (tramp-tramp-file-p "/[method/]/path/to/file"))
330 (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
331 (should (tramp-tramp-file-p "/[method/]file"))
332 (should (tramp-tramp-file-p "/[method/]/:file"))
335 (should (tramp-tramp-file-p "/[method1/|method2/]"))
336 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
339 "/[method1/user1@host1|method2/user2@host2]"))
342 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
345 (should-not (tramp-tramp-file-p nil
))
346 (should-not (tramp-tramp-file-p 'symbol
))
348 (should-not (tramp-tramp-file-p "/host:"))
349 (should-not (tramp-tramp-file-p "/user@host:"))
350 (should-not (tramp-tramp-file-p "/1.2.3.4:"))
351 (should-not (tramp-tramp-file-p "/host:/:"))
352 (should-not (tramp-tramp-file-p "/host1|host2:"))
353 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
354 ;; Quote with "/:" suppresses file name handlers.
355 (should-not (tramp-tramp-file-p "/:[]")))
358 (tramp-change-syntax syntax
))))
360 (ert-deftest tramp-test02-file-name-dissect
()
361 "Check remote file name components."
362 (let ((tramp-default-method "default-method")
363 (tramp-default-user "default-user")
364 (tramp-default-host "default-host"))
365 ;; Expand `tramp-default-user' and `tramp-default-host'.
366 (should (string-equal
367 (file-remote-p "/method::")
368 (format "/%s:%s@%s:" "method" "default-user" "default-host")))
369 (should (string-equal (file-remote-p "/method::" 'method
) "method"))
370 (should (string-equal (file-remote-p "/method::" 'user
) "default-user"))
371 (should (string-equal (file-remote-p "/method::" 'host
) "default-host"))
372 (should (string-equal (file-remote-p "/method::" 'localname
) ""))
373 (should (string-equal (file-remote-p "/method::" 'hop
) nil
))
375 ;; Expand `tramp-default-method' and `tramp-default-user'.
376 (should (string-equal
377 (file-remote-p "/-:host:")
378 (format "/%s:%s@%s:" "default-method" "default-user" "host")))
379 (should (string-equal (file-remote-p "/-:host:" 'method
) "default-method"))
380 (should (string-equal (file-remote-p "/-:host:" 'user
) "default-user"))
381 (should (string-equal (file-remote-p "/-:host:" 'host
) "host"))
382 (should (string-equal (file-remote-p "/-:host:" 'localname
) ""))
383 (should (string-equal (file-remote-p "/-:host:" 'hop
) nil
))
385 ;; Expand `tramp-default-method' and `tramp-default-host'.
386 (should (string-equal
387 (file-remote-p "/-:user@:")
388 (format "/%s:%s@%s:" "default-method" "user" "default-host")))
389 (should (string-equal (file-remote-p "/-:user@:" 'method
) "default-method"))
390 (should (string-equal (file-remote-p "/-:user@:" 'user
) "user"))
391 (should (string-equal (file-remote-p "/-:user@:" 'host
) "default-host"))
392 (should (string-equal (file-remote-p "/-:user@:" 'localname
) ""))
393 (should (string-equal (file-remote-p "/-:user@:" 'hop
) nil
))
395 ;; Expand `tramp-default-method'.
396 (should (string-equal
397 (file-remote-p "/-:user@host:")
398 (format "/%s:%s@%s:" "default-method" "user" "host")))
399 (should (string-equal
400 (file-remote-p "/-:user@host:" 'method
) "default-method"))
401 (should (string-equal (file-remote-p "/-:user@host:" 'user
) "user"))
402 (should (string-equal (file-remote-p "/-:user@host:" 'host
) "host"))
403 (should (string-equal (file-remote-p "/-:user@host:" 'localname
) ""))
404 (should (string-equal (file-remote-p "/-:user@host:" 'hop
) nil
))
406 ;; Expand `tramp-default-user'.
407 (should (string-equal
408 (file-remote-p "/method:host:")
409 (format "/%s:%s@%s:" "method" "default-user" "host")))
410 (should (string-equal (file-remote-p "/method:host:" 'method
) "method"))
411 (should (string-equal (file-remote-p "/method:host:" 'user
) "default-user"))
412 (should (string-equal (file-remote-p "/method:host:" 'host
) "host"))
413 (should (string-equal (file-remote-p "/method:host:" 'localname
) ""))
414 (should (string-equal (file-remote-p "/method:host:" 'hop
) nil
))
416 ;; Expand `tramp-default-host'.
417 (should (string-equal
418 (file-remote-p "/method:user@:")
419 (format "/%s:%s@%s:" "method" "user" "default-host")))
420 (should (string-equal (file-remote-p "/method:user@:" 'method
) "method"))
421 (should (string-equal (file-remote-p "/method:user@:" 'user
) "user"))
422 (should (string-equal (file-remote-p "/method:user@:" 'host
)
424 (should (string-equal (file-remote-p "/method:user@:" 'localname
) ""))
425 (should (string-equal (file-remote-p "/method:user@:" 'hop
) nil
))
428 (should (string-equal
429 (file-remote-p "/method:user@host:")
430 (format "/%s:%s@%s:" "method" "user" "host")))
431 (should (string-equal
432 (file-remote-p "/method:user@host:" 'method
) "method"))
433 (should (string-equal (file-remote-p "/method:user@host:" 'user
) "user"))
434 (should (string-equal (file-remote-p "/method:user@host:" 'host
) "host"))
435 (should (string-equal (file-remote-p "/method:user@host:" 'localname
) ""))
436 (should (string-equal (file-remote-p "/method:user@host:" 'hop
) nil
))
439 (should (string-equal
440 (file-remote-p "/method:user@email@host:")
441 (format "/%s:%s@%s:" "method" "user@email" "host")))
442 (should (string-equal
443 (file-remote-p "/method:user@email@host:" 'method
) "method"))
444 (should (string-equal
445 (file-remote-p "/method:user@email@host:" 'user
) "user@email"))
446 (should (string-equal
447 (file-remote-p "/method:user@email@host:" 'host
) "host"))
448 (should (string-equal
449 (file-remote-p "/method:user@email@host:" 'localname
) ""))
450 (should (string-equal
451 (file-remote-p "/method:user@email@host:" 'hop
) nil
))
453 ;; Expand `tramp-default-method' and `tramp-default-user'.
454 (should (string-equal
455 (file-remote-p "/-:host#1234:")
456 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
457 (should (string-equal
458 (file-remote-p "/-:host#1234:" 'method
) "default-method"))
459 (should (string-equal (file-remote-p "/-:host#1234:" 'user
) "default-user"))
460 (should (string-equal (file-remote-p "/-:host#1234:" 'host
) "host#1234"))
461 (should (string-equal (file-remote-p "/-:host#1234:" 'localname
) ""))
462 (should (string-equal (file-remote-p "/-:host#1234:" 'hop
) nil
))
464 ;; Expand `tramp-default-method'.
465 (should (string-equal
466 (file-remote-p "/-:user@host#1234:")
467 (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
468 (should (string-equal
469 (file-remote-p "/-:user@host#1234:" 'method
) "default-method"))
470 (should (string-equal (file-remote-p "/-:user@host#1234:" 'user
) "user"))
471 (should (string-equal (file-remote-p "/-:user@host#1234:" 'host
) "host#1234"))
472 (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname
) ""))
473 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop
) nil
))
475 ;; Expand `tramp-default-user'.
476 (should (string-equal
477 (file-remote-p "/method:host#1234:")
478 (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
479 (should (string-equal
480 (file-remote-p "/method:host#1234:" 'method
) "method"))
481 (should (string-equal
482 (file-remote-p "/method:host#1234:" 'user
) "default-user"))
483 (should (string-equal
484 (file-remote-p "/method:host#1234:" 'host
) "host#1234"))
485 (should (string-equal (file-remote-p "/method:host#1234:" 'localname
) ""))
486 (should (string-equal (file-remote-p "/method:host#1234:" 'hop
) nil
))
489 (should (string-equal
490 (file-remote-p "/method:user@host#1234:")
491 (format "/%s:%s@%s:" "method" "user" "host#1234")))
492 (should (string-equal
493 (file-remote-p "/method:user@host#1234:" 'method
) "method"))
494 (should (string-equal
495 (file-remote-p "/method:user@host#1234:" 'user
) "user"))
496 (should (string-equal
497 (file-remote-p "/method:user@host#1234:" 'host
) "host#1234"))
498 (should (string-equal
499 (file-remote-p "/method:user@host#1234:" 'localname
) ""))
500 (should (string-equal
501 (file-remote-p "/method:user@host#1234:" 'hop
) nil
))
503 ;; Expand `tramp-default-method' and `tramp-default-user'.
504 (should (string-equal
505 (file-remote-p "/-:1.2.3.4:")
506 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
507 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method
) "default-method"))
508 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user
) "default-user"))
509 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host
) "1.2.3.4"))
510 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname
) ""))
511 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop
) nil
))
513 ;; Expand `tramp-default-method'.
514 (should (string-equal
515 (file-remote-p "/-:user@1.2.3.4:")
516 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
517 (should (string-equal
518 (file-remote-p "/-:user@1.2.3.4:" 'method
) "default-method"))
519 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user
) "user"))
520 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host
) "1.2.3.4"))
521 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname
) ""))
522 (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop
) nil
))
524 ;; Expand `tramp-default-user'.
525 (should (string-equal
526 (file-remote-p "/method:1.2.3.4:")
527 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
528 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method
) "method"))
529 (should (string-equal
530 (file-remote-p "/method:1.2.3.4:" 'user
) "default-user"))
531 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host
) "1.2.3.4"))
532 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname
) ""))
533 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop
) nil
))
536 (should (string-equal
537 (file-remote-p "/method:user@1.2.3.4:")
538 (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
539 (should (string-equal
540 (file-remote-p "/method:user@1.2.3.4:" 'method
) "method"))
541 (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user
) "user"))
542 (should (string-equal
543 (file-remote-p "/method:user@1.2.3.4:" 'host
) "1.2.3.4"))
544 (should (string-equal
545 (file-remote-p "/method:user@1.2.3.4:" 'localname
) ""))
546 (should (string-equal
547 (file-remote-p "/method:user@1.2.3.4:" 'hop
) nil
))
549 ;; Expand `tramp-default-method', `tramp-default-user' and
550 ;; `tramp-default-host'.
551 (should (string-equal
552 (file-remote-p "/-:[]:")
554 "/%s:%s@%s:" "default-method" "default-user" "default-host")))
555 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
556 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
557 (should (string-equal (file-remote-p "/-:[]:" 'host
) "default-host"))
558 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
559 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
))
561 ;; Expand `tramp-default-method' and `tramp-default-user'.
562 (let ((tramp-default-host "::1"))
563 (should (string-equal
564 (file-remote-p "/-:[]:")
565 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
566 (should (string-equal (file-remote-p "/-:[]:" 'method
) "default-method"))
567 (should (string-equal (file-remote-p "/-:[]:" 'user
) "default-user"))
568 (should (string-equal (file-remote-p "/-:[]:" 'host
) "::1"))
569 (should (string-equal (file-remote-p "/-:[]:" 'localname
) ""))
570 (should (string-equal (file-remote-p "/-:[]:" 'hop
) nil
)))
572 ;; Expand `tramp-default-method' and `tramp-default-user'.
573 (should (string-equal
574 (file-remote-p "/-:[::1]:")
575 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
576 (should (string-equal (file-remote-p "/-:[::1]:" 'method
) "default-method"))
577 (should (string-equal (file-remote-p "/-:[::1]:" 'user
) "default-user"))
578 (should (string-equal (file-remote-p "/-:[::1]:" 'host
) "::1"))
579 (should (string-equal (file-remote-p "/-:[::1]:" 'localname
) ""))
580 (should (string-equal (file-remote-p "/-:[::1]:" 'hop
) nil
))
582 ;; Expand `tramp-default-method'.
583 (should (string-equal
584 (file-remote-p "/-:user@[::1]:")
585 (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
586 (should (string-equal
587 (file-remote-p "/-:user@[::1]:" 'method
) "default-method"))
588 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user
) "user"))
589 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host
) "::1"))
590 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname
) ""))
591 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop
) nil
))
593 ;; Expand `tramp-default-user'.
594 (should (string-equal
595 (file-remote-p "/method:[::1]:")
596 (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
597 (should (string-equal (file-remote-p "/method:[::1]:" 'method
) "method"))
598 (should (string-equal
599 (file-remote-p "/method:[::1]:" 'user
) "default-user"))
600 (should (string-equal (file-remote-p "/method:[::1]:" 'host
) "::1"))
601 (should (string-equal (file-remote-p "/method:[::1]:" 'localname
) ""))
602 (should (string-equal (file-remote-p "/method:[::1]:" 'hop
) nil
))
605 (should (string-equal
606 (file-remote-p "/method:user@[::1]:")
607 (format "/%s:%s@%s:" "method" "user" "[::1]")))
608 (should (string-equal
609 (file-remote-p "/method:user@[::1]:" 'method
) "method"))
610 (should (string-equal (file-remote-p "/method:user@[::1]:" 'user
) "user"))
611 (should (string-equal (file-remote-p "/method:user@[::1]:" 'host
) "::1"))
612 (should (string-equal
613 (file-remote-p "/method:user@[::1]:" 'localname
) ""))
614 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop
) nil
))
616 ;; Local file name part.
617 (should (string-equal (file-remote-p "/-:host:/:" 'localname
) "/:"))
618 (should (string-equal (file-remote-p "/method:::" 'localname
) ":"))
619 (should (string-equal (file-remote-p "/method:: " 'localname
) " "))
620 (should (string-equal (file-remote-p "/method::file" 'localname
) "file"))
621 (should (string-equal
622 (file-remote-p "/method::/path/to/file" 'localname
)
628 (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
629 (format "/%s:%s@%s|%s:%s@%s:"
630 "method1" "user1" "host1" "method2" "user2" "host2")))
634 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method
)
639 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user
)
644 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host
)
649 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname
)
654 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop
)
656 "method1" "user1" "host1")))
662 "/method1:user1@host1"
663 "|method2:user2@host2"
664 "|method3:user3@host3:/path/to/file"))
665 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
666 "method1" "user1" "host1"
667 "method2" "user2" "host2"
668 "method3" "user3" "host3")))
673 "/method1:user1@host1"
674 "|method2:user2@host2"
675 "|method3:user3@host3:/path/to/file")
682 "/method1:user1@host1"
683 "|method2:user2@host2"
684 "|method3:user3@host3:/path/to/file")
691 "/method1:user1@host1"
692 "|method2:user2@host2"
693 "|method3:user3@host3:/path/to/file")
700 "/method1:user1@host1"
701 "|method2:user2@host2"
702 "|method3:user3@host3:/path/to/file")
709 "/method1:user1@host1"
710 "|method2:user2@host2"
711 "|method3:user3@host3:/path/to/file")
713 (format "%s:%s@%s|%s:%s@%s|"
714 "method1" "user1" "host1" "method2" "user2" "host2")))))
716 (ert-deftest tramp-test02-file-name-dissect-simplified
()
717 "Check simplified file name components."
718 :tags
'(:expensive-test
)
719 (let ((tramp-default-method "default-method")
720 (tramp-default-user "default-user")
721 (tramp-default-host "default-host")
722 (syntax tramp-syntax
))
725 (tramp-change-syntax 'simplified
)
726 ;; Expand `tramp-default-method' and `tramp-default-user'.
727 (should (string-equal
728 (file-remote-p "/host:")
729 (format "/%s@%s:" "default-user" "host")))
730 (should (string-equal
731 (file-remote-p "/host:" 'method
) "default-method"))
732 (should (string-equal (file-remote-p "/host:" 'user
) "default-user"))
733 (should (string-equal (file-remote-p "/host:" 'host
) "host"))
734 (should (string-equal (file-remote-p "/host:" 'localname
) ""))
735 (should (string-equal (file-remote-p "/host:" 'hop
) nil
))
737 ;; Expand `tramp-default-method' and `tramp-default-host'.
738 (should (string-equal
739 (file-remote-p "/user@:")
740 (format "/%s@%s:" "user" "default-host")))
741 (should (string-equal
742 (file-remote-p "/user@:" 'method
) "default-method"))
743 (should (string-equal (file-remote-p "/user@:" 'user
) "user"))
744 (should (string-equal (file-remote-p "/user@:" 'host
) "default-host"))
745 (should (string-equal (file-remote-p "/user@:" 'localname
) ""))
746 (should (string-equal (file-remote-p "/user@:" 'hop
) nil
))
748 ;; Expand `tramp-default-method'.
749 (should (string-equal
750 (file-remote-p "/user@host:")
751 (format "/%s@%s:" "user" "host")))
752 (should (string-equal
753 (file-remote-p "/user@host:" 'method
) "default-method"))
754 (should (string-equal (file-remote-p "/user@host:" 'user
) "user"))
755 (should (string-equal (file-remote-p "/user@host:" 'host
) "host"))
756 (should (string-equal (file-remote-p "/user@host:" 'localname
) ""))
757 (should (string-equal (file-remote-p "/user@host:" 'hop
) nil
))
760 (should (string-equal
761 (file-remote-p "/user@email@host:")
762 (format "/%s@%s:" "user@email" "host")))
763 (should (string-equal
765 "/user@email@host:" 'method
) "default-method"))
766 (should (string-equal
767 (file-remote-p "/user@email@host:" 'user
) "user@email"))
768 (should (string-equal
769 (file-remote-p "/user@email@host:" 'host
) "host"))
770 (should (string-equal
771 (file-remote-p "/user@email@host:" 'localname
) ""))
772 (should (string-equal
773 (file-remote-p "/user@email@host:" 'hop
) nil
))
775 ;; Expand `tramp-default-method' and `tramp-default-user'.
776 (should (string-equal
777 (file-remote-p "/host#1234:")
778 (format "/%s@%s:" "default-user" "host#1234")))
779 (should (string-equal
780 (file-remote-p "/host#1234:" 'method
) "default-method"))
781 (should (string-equal
782 (file-remote-p "/host#1234:" 'user
) "default-user"))
783 (should (string-equal
784 (file-remote-p "/host#1234:" 'host
) "host#1234"))
785 (should (string-equal (file-remote-p "/host#1234:" 'localname
) ""))
786 (should (string-equal (file-remote-p "/host#1234:" 'hop
) nil
))
788 ;; Expand `tramp-default-method'.
789 (should (string-equal
790 (file-remote-p "/user@host#1234:")
791 (format "/%s@%s:" "user" "host#1234")))
792 (should (string-equal
793 (file-remote-p "/user@host#1234:" 'method
) "default-method"))
794 (should (string-equal
795 (file-remote-p "/user@host#1234:" 'user
) "user"))
796 (should (string-equal
797 (file-remote-p "/user@host#1234:" 'host
) "host#1234"))
798 (should (string-equal
799 (file-remote-p "/user@host#1234:" 'localname
) ""))
800 (should (string-equal (file-remote-p "/user@host#1234:" 'hop
) nil
))
802 ;; Expand `tramp-default-method' and `tramp-default-user'.
803 (should (string-equal
804 (file-remote-p "/1.2.3.4:")
805 (format "/%s@%s:" "default-user" "1.2.3.4")))
806 (should (string-equal
807 (file-remote-p "/1.2.3.4:" 'method
) "default-method"))
808 (should (string-equal
809 (file-remote-p "/1.2.3.4:" 'user
) "default-user"))
810 (should (string-equal (file-remote-p "/1.2.3.4:" 'host
) "1.2.3.4"))
811 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname
) ""))
812 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop
) nil
))
814 ;; Expand `tramp-default-method'.
815 (should (string-equal
816 (file-remote-p "/user@1.2.3.4:")
817 (format "/%s@%s:" "user" "1.2.3.4")))
818 (should (string-equal
819 (file-remote-p "/user@1.2.3.4:" 'method
) "default-method"))
820 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user
) "user"))
821 (should (string-equal
822 (file-remote-p "/user@1.2.3.4:" 'host
) "1.2.3.4"))
823 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname
) ""))
824 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop
) nil
))
826 ;; Expand `tramp-default-method', `tramp-default-user' and
827 ;; `tramp-default-host'.
828 (should (string-equal
829 (file-remote-p "/[]:")
831 "/%s@%s:" "default-user" "default-host")))
832 (should (string-equal
833 (file-remote-p "/[]:" 'method
) "default-method"))
834 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
835 (should (string-equal (file-remote-p "/[]:" 'host
) "default-host"))
836 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
837 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
))
839 ;; Expand `tramp-default-method' and `tramp-default-user'.
840 (let ((tramp-default-host "::1"))
841 (should (string-equal
842 (file-remote-p "/[]:")
843 (format "/%s@%s:" "default-user" "[::1]")))
844 (should (string-equal
845 (file-remote-p "/[]:" 'method
) "default-method"))
846 (should (string-equal (file-remote-p "/[]:" 'user
) "default-user"))
847 (should (string-equal (file-remote-p "/[]:" 'host
) "::1"))
848 (should (string-equal (file-remote-p "/[]:" 'localname
) ""))
849 (should (string-equal (file-remote-p "/[]:" 'hop
) nil
)))
851 ;; Expand `tramp-default-method' and `tramp-default-user'.
852 (should (string-equal
853 (file-remote-p "/[::1]:")
854 (format "/%s@%s:" "default-user" "[::1]")))
855 (should (string-equal
856 (file-remote-p "/[::1]:" 'method
) "default-method"))
857 (should (string-equal (file-remote-p "/[::1]:" 'user
) "default-user"))
858 (should (string-equal (file-remote-p "/[::1]:" 'host
) "::1"))
859 (should (string-equal (file-remote-p "/[::1]:" 'localname
) ""))
860 (should (string-equal (file-remote-p "/[::1]:" 'hop
) nil
))
862 ;; Expand `tramp-default-method'.
863 (should (string-equal
864 (file-remote-p "/user@[::1]:")
865 (format "/%s@%s:" "user" "[::1]")))
866 (should (string-equal
867 (file-remote-p "/user@[::1]:" 'method
) "default-method"))
868 (should (string-equal (file-remote-p "/user@[::1]:" 'user
) "user"))
869 (should (string-equal (file-remote-p "/user@[::1]:" 'host
) "::1"))
870 (should (string-equal (file-remote-p "/user@[::1]:" 'localname
) ""))
871 (should (string-equal (file-remote-p "/user@[::1]:" 'hop
) nil
))
873 ;; Local file name part.
874 (should (string-equal (file-remote-p "/host:/:" 'localname
) "/:"))
875 (should (string-equal (file-remote-p "/host::" 'localname
) ":"))
876 (should (string-equal (file-remote-p "/host: " 'localname
) " "))
877 (should (string-equal (file-remote-p "/host:file" 'localname
) "file"))
878 (should (string-equal
879 (file-remote-p "/host:/path/to/file" 'localname
)
885 (file-remote-p "/user1@host1|user2@host2:/path/to/file")
886 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
890 "/user1@host1|user2@host2:/path/to/file" 'method
)
895 "/user1@host1|user2@host2:/path/to/file" 'user
)
900 "/user1@host1|user2@host2:/path/to/file" 'host
)
905 "/user1@host1|user2@host2:/path/to/file" 'localname
)
910 "/user1@host1|user2@host2:/path/to/file" 'hop
)
911 (format "%s@%s|" "user1" "host1")))
919 "|user3@host3:/path/to/file"))
920 (format "/%s@%s|%s@%s|%s@%s:"
930 "|user3@host3:/path/to/file")
939 "|user3@host3:/path/to/file")
948 "|user3@host3:/path/to/file")
957 "|user3@host3:/path/to/file")
966 "|user3@host3:/path/to/file")
968 (format "%s@%s|%s@%s|"
969 "user1" "host1" "user2" "host2"))))
972 (tramp-change-syntax syntax
))))
974 (ert-deftest tramp-test02-file-name-dissect-separate
()
975 "Check separate file name components."
976 :tags
'(:expensive-test
)
977 (let ((tramp-default-method "default-method")
978 (tramp-default-user "default-user")
979 (tramp-default-host "default-host")
980 (syntax tramp-syntax
))
983 (tramp-change-syntax 'separate
)
984 ;; Expand `tramp-default-user' and `tramp-default-host'.
985 (should (string-equal
986 (file-remote-p "/[method/]")
988 "/[%s/%s@%s]" "method" "default-user" "default-host")))
989 (should (string-equal (file-remote-p "/[method/]" 'method
) "method"))
990 (should (string-equal
991 (file-remote-p "/[method/]" 'user
) "default-user"))
992 (should (string-equal
993 (file-remote-p "/[method/]" 'host
) "default-host"))
994 (should (string-equal (file-remote-p "/[method/]" 'localname
) ""))
995 (should (string-equal (file-remote-p "/[method/]" 'hop
) nil
))
997 ;; Expand `tramp-default-method' and `tramp-default-user'.
998 (should (string-equal
999 (file-remote-p "/[/host]")
1001 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1002 (should (string-equal
1003 (file-remote-p "/[/host]" 'method
) "default-method"))
1004 (should (string-equal
1005 (file-remote-p "/[/host]" 'user
) "default-user"))
1006 (should (string-equal (file-remote-p "/[/host]" 'host
) "host"))
1007 (should (string-equal (file-remote-p "/[/host]" 'localname
) ""))
1008 (should (string-equal (file-remote-p "/[/host]" 'hop
) nil
))
1010 ;; Expand `tramp-default-method' and `tramp-default-host'.
1011 (should (string-equal
1012 (file-remote-p "/[/user@]")
1014 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1015 (should (string-equal
1016 (file-remote-p "/[/user@]" 'method
) "default-method"))
1017 (should (string-equal (file-remote-p "/[/user@]" 'user
) "user"))
1018 (should (string-equal
1019 (file-remote-p "/[/user@]" 'host
) "default-host"))
1020 (should (string-equal (file-remote-p "/[/user@]" 'localname
) ""))
1021 (should (string-equal (file-remote-p "/[/user@]" 'hop
) nil
))
1023 ;; Expand `tramp-default-method'.
1024 (should (string-equal
1025 (file-remote-p "/[/user@host]")
1026 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1027 (should (string-equal
1028 (file-remote-p "/[/user@host]" 'method
) "default-method"))
1029 (should (string-equal (file-remote-p "/[/user@host]" 'user
) "user"))
1030 (should (string-equal (file-remote-p "/[/user@host]" 'host
) "host"))
1031 (should (string-equal (file-remote-p "/[/user@host]" 'localname
) ""))
1032 (should (string-equal (file-remote-p "/[/user@host]" 'hop
) nil
))
1034 ;; Expand `tramp-default-method' and `tramp-default-user'.
1035 (should (string-equal
1036 (file-remote-p "/[-/host]")
1038 "/[%s/%s@%s]" "default-method" "default-user" "host")))
1039 (should (string-equal
1040 (file-remote-p "/[-/host]" 'method
) "default-method"))
1041 (should (string-equal
1042 (file-remote-p "/[-/host]" 'user
) "default-user"))
1043 (should (string-equal (file-remote-p "/[-/host]" 'host
) "host"))
1044 (should (string-equal (file-remote-p "/[-/host]" 'localname
) ""))
1045 (should (string-equal (file-remote-p "/[-/host]" 'hop
) nil
))
1047 ;; Expand `tramp-default-method' and `tramp-default-host'.
1048 (should (string-equal
1049 (file-remote-p "/[-/user@]")
1051 "/[%s/%s@%s]" "default-method" "user" "default-host")))
1052 (should (string-equal
1053 (file-remote-p "/[-/user@]" 'method
) "default-method"))
1054 (should (string-equal (file-remote-p "/[-/user@]" 'user
) "user"))
1055 (should (string-equal
1056 (file-remote-p "/[-/user@]" 'host
) "default-host"))
1057 (should (string-equal (file-remote-p "/[-/user@]" 'localname
) ""))
1058 (should (string-equal (file-remote-p "/[-/user@]" 'hop
) nil
))
1060 ;; Expand `tramp-default-method'.
1061 (should (string-equal
1062 (file-remote-p "/[-/user@host]")
1063 (format "/[%s/%s@%s]" "default-method" "user" "host")))
1064 (should (string-equal
1065 (file-remote-p "/[-/user@host]" 'method
) "default-method"))
1066 (should (string-equal (file-remote-p "/[-/user@host]" 'user
) "user"))
1067 (should (string-equal (file-remote-p "/[-/user@host]" 'host
) "host"))
1068 (should (string-equal (file-remote-p "/[-/user@host]" 'localname
) ""))
1069 (should (string-equal (file-remote-p "/[-/user@host]" 'hop
) nil
))
1071 ;; Expand `tramp-default-user'.
1072 (should (string-equal
1073 (file-remote-p "/[method/host]")
1074 (format "/[%s/%s@%s]" "method" "default-user" "host")))
1075 (should (string-equal
1076 (file-remote-p "/[method/host]" 'method
) "method"))
1077 (should (string-equal
1078 (file-remote-p "/[method/host]" 'user
) "default-user"))
1079 (should (string-equal (file-remote-p "/[method/host]" 'host
) "host"))
1080 (should (string-equal (file-remote-p "/[method/host]" 'localname
) ""))
1081 (should (string-equal (file-remote-p "/[method/host]" 'hop
) nil
))
1083 ;; Expand `tramp-default-host'.
1084 (should (string-equal
1085 (file-remote-p "/[method/user@]")
1086 (format "/[%s/%s@%s]" "method" "user" "default-host")))
1087 (should (string-equal
1088 (file-remote-p "/[method/user@]" 'method
) "method"))
1089 (should (string-equal (file-remote-p "/[method/user@]" 'user
) "user"))
1090 (should (string-equal
1091 (file-remote-p "/[method/user@]" 'host
) "default-host"))
1092 (should (string-equal
1093 (file-remote-p "/[method/user@]" 'localname
) ""))
1094 (should (string-equal (file-remote-p "/[method/user@]" 'hop
) nil
))
1097 (should (string-equal
1098 (file-remote-p "/[method/user@host]")
1099 (format "/[%s/%s@%s]" "method" "user" "host")))
1100 (should (string-equal
1101 (file-remote-p "/[method/user@host]" 'method
) "method"))
1102 (should (string-equal
1103 (file-remote-p "/[method/user@host]" 'user
) "user"))
1104 (should (string-equal
1105 (file-remote-p "/[method/user@host]" 'host
) "host"))
1106 (should (string-equal
1107 (file-remote-p "/[method/user@host]" 'localname
) ""))
1108 (should (string-equal
1109 (file-remote-p "/[method/user@host]" 'hop
) nil
))
1112 (should (string-equal
1113 (file-remote-p "/[method/user@email@host]")
1114 (format "/[%s/%s@%s]" "method" "user@email" "host")))
1115 (should (string-equal
1117 "/[method/user@email@host]" 'method
) "method"))
1118 (should (string-equal
1120 "/[method/user@email@host]" 'user
) "user@email"))
1121 (should (string-equal
1122 (file-remote-p "/[method/user@email@host]" 'host
) "host"))
1123 (should (string-equal
1124 (file-remote-p "/[method/user@email@host]" 'localname
) ""))
1125 (should (string-equal
1126 (file-remote-p "/[method/user@email@host]" 'hop
) nil
))
1128 ;; Expand `tramp-default-method' and `tramp-default-user'.
1129 (should (string-equal
1130 (file-remote-p "/[/host#1234]")
1132 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1133 (should (string-equal
1134 (file-remote-p "/[/host#1234]" 'method
) "default-method"))
1135 (should (string-equal
1136 (file-remote-p "/[/host#1234]" 'user
) "default-user"))
1137 (should (string-equal
1138 (file-remote-p "/[/host#1234]" 'host
) "host#1234"))
1139 (should (string-equal (file-remote-p "/[/host#1234]" 'localname
) ""))
1140 (should (string-equal (file-remote-p "/[/host#1234]" 'hop
) nil
))
1142 ;; Expand `tramp-default-method'.
1143 (should (string-equal
1144 (file-remote-p "/[/user@host#1234]")
1145 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1146 (should (string-equal
1148 "/[/user@host#1234]" 'method
) "default-method"))
1149 (should (string-equal
1151 "/[/user@host#1234]" 'user
) "user"))
1152 (should (string-equal
1153 (file-remote-p "/[/user@host#1234]" 'host
) "host#1234"))
1154 (should (string-equal
1155 (file-remote-p "/[/user@host#1234]" 'localname
) ""))
1156 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop
) nil
))
1158 ;; Expand `tramp-default-method' and `tramp-default-user'.
1159 (should (string-equal
1160 (file-remote-p "/[-/host#1234]")
1162 "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1163 (should (string-equal
1164 (file-remote-p "/[-/host#1234]" 'method
) "default-method"))
1165 (should (string-equal
1166 (file-remote-p "/[-/host#1234]" 'user
) "default-user"))
1167 (should (string-equal
1168 (file-remote-p "/[-/host#1234]" 'host
) "host#1234"))
1169 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname
) ""))
1170 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop
) nil
))
1172 ;; Expand `tramp-default-method'.
1173 (should (string-equal
1174 (file-remote-p "/[-/user@host#1234]")
1175 (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1176 (should (string-equal
1178 "/[-/user@host#1234]" 'method
) "default-method"))
1179 (should (string-equal
1181 "/[-/user@host#1234]" 'user
) "user"))
1182 (should (string-equal
1183 (file-remote-p "/[-/user@host#1234]" 'host
) "host#1234"))
1184 (should (string-equal
1185 (file-remote-p "/[-/user@host#1234]" 'localname
) ""))
1186 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop
) nil
))
1188 ;; Expand `tramp-default-user'.
1189 (should (string-equal
1190 (file-remote-p "/[method/host#1234]")
1191 (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1192 (should (string-equal
1193 (file-remote-p "/[method/host#1234]" 'method
) "method"))
1194 (should (string-equal
1195 (file-remote-p "/[method/host#1234]" 'user
) "default-user"))
1196 (should (string-equal
1197 (file-remote-p "/[method/host#1234]" 'host
) "host#1234"))
1198 (should (string-equal
1199 (file-remote-p "/[method/host#1234]" 'localname
) ""))
1200 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop
) nil
))
1203 (should (string-equal
1204 (file-remote-p "/[method/user@host#1234]")
1205 (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1206 (should (string-equal
1207 (file-remote-p "/[method/user@host#1234]" 'method
) "method"))
1208 (should (string-equal
1209 (file-remote-p "/[method/user@host#1234]" 'user
) "user"))
1210 (should (string-equal
1212 "/[method/user@host#1234]" 'host
) "host#1234"))
1213 (should (string-equal
1214 (file-remote-p "/[method/user@host#1234]" 'localname
) ""))
1215 (should (string-equal
1216 (file-remote-p "/[method/user@host#1234]" 'hop
) nil
))
1218 ;; Expand `tramp-default-method' and `tramp-default-user'.
1219 (should (string-equal
1220 (file-remote-p "/[/1.2.3.4]")
1222 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1223 (should (string-equal
1224 (file-remote-p "/[/1.2.3.4]" 'method
) "default-method"))
1225 (should (string-equal
1226 (file-remote-p "/[/1.2.3.4]" 'user
) "default-user"))
1227 (should (string-equal
1228 (file-remote-p "/[/1.2.3.4]" 'host
) "1.2.3.4"))
1229 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname
) ""))
1230 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop
) nil
))
1232 ;; Expand `tramp-default-method'.
1233 (should (string-equal
1234 (file-remote-p "/[/user@1.2.3.4]")
1235 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1236 (should (string-equal
1238 "/[/user@1.2.3.4]" 'method
) "default-method"))
1239 (should (string-equal
1240 (file-remote-p "/[/user@1.2.3.4]" 'user
) "user"))
1241 (should (string-equal
1242 (file-remote-p "/[/user@1.2.3.4]" 'host
) "1.2.3.4"))
1243 (should (string-equal
1244 (file-remote-p "/[/user@1.2.3.4]" 'localname
) ""))
1245 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop
) nil
))
1247 ;; Expand `tramp-default-method' and `tramp-default-user'.
1248 (should (string-equal
1249 (file-remote-p "/[-/1.2.3.4]")
1251 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1252 (should (string-equal
1253 (file-remote-p "/[-/1.2.3.4]" 'method
) "default-method"))
1254 (should (string-equal
1255 (file-remote-p "/[-/1.2.3.4]" 'user
) "default-user"))
1256 (should (string-equal
1257 (file-remote-p "/[-/1.2.3.4]" 'host
) "1.2.3.4"))
1258 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname
) ""))
1259 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop
) nil
))
1261 ;; Expand `tramp-default-method'.
1262 (should (string-equal
1263 (file-remote-p "/[-/user@1.2.3.4]")
1264 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1265 (should (string-equal
1267 "/[-/user@1.2.3.4]" 'method
) "default-method"))
1268 (should (string-equal
1269 (file-remote-p "/[-/user@1.2.3.4]" 'user
) "user"))
1270 (should (string-equal
1271 (file-remote-p "/[-/user@1.2.3.4]" 'host
) "1.2.3.4"))
1272 (should (string-equal
1273 (file-remote-p "/[-/user@1.2.3.4]" 'localname
) ""))
1274 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop
) nil
))
1276 ;; Expand `tramp-default-user'.
1277 (should (string-equal
1278 (file-remote-p "/[method/1.2.3.4]")
1279 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1280 (should (string-equal
1281 (file-remote-p "/[method/1.2.3.4]" 'method
) "method"))
1282 (should (string-equal
1283 (file-remote-p "/[method/1.2.3.4]" 'user
) "default-user"))
1284 (should (string-equal
1285 (file-remote-p "/[method/1.2.3.4]" 'host
) "1.2.3.4"))
1286 (should (string-equal
1287 (file-remote-p "/[method/1.2.3.4]" 'localname
) ""))
1288 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop
) nil
))
1291 (should (string-equal
1292 (file-remote-p "/[method/user@1.2.3.4]")
1293 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1294 (should (string-equal
1295 (file-remote-p "/[method/user@1.2.3.4]" 'method
) "method"))
1296 (should (string-equal
1297 (file-remote-p "/[method/user@1.2.3.4]" 'user
) "user"))
1298 (should (string-equal
1299 (file-remote-p "/[method/user@1.2.3.4]" 'host
) "1.2.3.4"))
1300 (should (string-equal
1301 (file-remote-p "/[method/user@1.2.3.4]" 'localname
) ""))
1302 (should (string-equal
1303 (file-remote-p "/[method/user@1.2.3.4]" 'hop
) nil
))
1305 ;; Expand `tramp-default-method', `tramp-default-user' and
1306 ;; `tramp-default-host'.
1307 (should (string-equal
1308 (file-remote-p "/[/]")
1311 "default-method" "default-user" "default-host")))
1312 (should (string-equal
1313 (file-remote-p "/[/]" 'method
) "default-method"))
1314 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1315 (should (string-equal (file-remote-p "/[/]" 'host
) "default-host"))
1316 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1317 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
))
1319 ;; Expand `tramp-default-method' and `tramp-default-user'.
1320 (let ((tramp-default-host "::1"))
1321 (should (string-equal
1322 (file-remote-p "/[/]")
1325 "default-method" "default-user" "::1")))
1326 (should (string-equal
1327 (file-remote-p "/[/]" 'method
) "default-method"))
1328 (should (string-equal (file-remote-p "/[/]" 'user
) "default-user"))
1329 (should (string-equal (file-remote-p "/[/]" 'host
) "::1"))
1330 (should (string-equal (file-remote-p "/[/]" 'localname
) ""))
1331 (should (string-equal (file-remote-p "/[/]" 'hop
) nil
)))
1333 ;; Expand `tramp-default-method' and `tramp-default-user'.
1334 (should (string-equal
1335 (file-remote-p "/[/::1]")
1337 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1338 (should (string-equal
1339 (file-remote-p "/[/::1]" 'method
) "default-method"))
1340 (should (string-equal
1341 (file-remote-p "/[/::1]" 'user
) "default-user"))
1342 (should (string-equal (file-remote-p "/[/::1]" 'host
) "::1"))
1343 (should (string-equal (file-remote-p "/[/::1]" 'localname
) ""))
1344 (should (string-equal (file-remote-p "/[/::1]" 'hop
) nil
))
1346 ;; Expand `tramp-default-method'.
1347 (should (string-equal
1348 (file-remote-p "/[/user@::1]")
1349 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1350 (should (string-equal
1351 (file-remote-p "/[/user@::1]" 'method
) "default-method"))
1352 (should (string-equal (file-remote-p "/[/user@::1]" 'user
) "user"))
1353 (should (string-equal (file-remote-p "/[/user@::1]" 'host
) "::1"))
1354 (should (string-equal (file-remote-p "/[/user@::1]" 'localname
) ""))
1355 (should (string-equal (file-remote-p "/[/user@::1]" 'hop
) nil
))
1357 ;; Expand `tramp-default-method', `tramp-default-user' and
1358 ;; `tramp-default-host'.
1359 (should (string-equal
1360 (file-remote-p "/[-/]")
1363 "default-method" "default-user" "default-host")))
1364 (should (string-equal
1365 (file-remote-p "/[-/]" 'method
) "default-method"))
1366 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1367 (should (string-equal (file-remote-p "/[-/]" 'host
) "default-host"))
1368 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1369 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
))
1371 ;; Expand `tramp-default-method' and `tramp-default-user'.
1372 (let ((tramp-default-host "::1"))
1373 (should (string-equal
1374 (file-remote-p "/[-/]")
1377 "default-method" "default-user" "::1")))
1378 (should (string-equal
1379 (file-remote-p "/[-/]" 'method
) "default-method"))
1380 (should (string-equal (file-remote-p "/[-/]" 'user
) "default-user"))
1381 (should (string-equal (file-remote-p "/[-/]" 'host
) "::1"))
1382 (should (string-equal (file-remote-p "/[-/]" 'localname
) ""))
1383 (should (string-equal (file-remote-p "/[-/]" 'hop
) nil
)))
1385 ;; Expand `tramp-default-method' and `tramp-default-user'.
1386 (should (string-equal
1387 (file-remote-p "/[-/::1]")
1389 "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1390 (should (string-equal
1391 (file-remote-p "/[-/::1]" 'method
) "default-method"))
1392 (should (string-equal
1393 (file-remote-p "/[-/::1]" 'user
) "default-user"))
1394 (should (string-equal (file-remote-p "/[-/::1]" 'host
) "::1"))
1395 (should (string-equal (file-remote-p "/[-/::1]" 'localname
) ""))
1396 (should (string-equal (file-remote-p "/[-/::1]" 'hop
) nil
))
1398 ;; Expand `tramp-default-method'.
1399 (should (string-equal
1400 (file-remote-p "/[-/user@::1]")
1401 (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1402 (should (string-equal
1403 (file-remote-p "/[-/user@::1]" 'method
) "default-method"))
1404 (should (string-equal (file-remote-p "/[-/user@::1]" 'user
) "user"))
1405 (should (string-equal (file-remote-p "/[-/user@::1]" 'host
) "::1"))
1406 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname
) ""))
1407 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop
) nil
))
1409 ;; Expand `tramp-default-user'.
1410 (should (string-equal
1411 (file-remote-p "/[method/::1]")
1412 (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1413 (should (string-equal
1414 (file-remote-p "/[method/::1]" 'method
) "method"))
1415 (should (string-equal
1416 (file-remote-p "/[method/::1]" 'user
) "default-user"))
1417 (should (string-equal (file-remote-p "/[method/::1]" 'host
) "::1"))
1418 (should (string-equal (file-remote-p "/[method/::1]" 'localname
) ""))
1419 (should (string-equal (file-remote-p "/[method/::1]" 'hop
) nil
))
1422 (should (string-equal
1423 (file-remote-p "/[method/user@::1]")
1424 (format "/[%s/%s@%s]" "method" "user" "::1")))
1425 (should (string-equal
1426 (file-remote-p "/[method/user@::1]" 'method
) "method"))
1427 (should (string-equal
1428 (file-remote-p "/[method/user@::1]" 'user
) "user"))
1429 (should (string-equal
1430 (file-remote-p "/[method/user@::1]" 'host
) "::1"))
1431 (should (string-equal
1432 (file-remote-p "/[method/user@::1]" 'localname
) ""))
1433 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop
) nil
))
1435 ;; Local file name part.
1436 (should (string-equal (file-remote-p "/[/host]/:" 'localname
) "/:"))
1437 (should (string-equal (file-remote-p "/[-/host]/:" 'localname
) "/:"))
1438 (should (string-equal (file-remote-p "/[method/]:" 'localname
) ":"))
1439 (should (string-equal (file-remote-p "/[method/] " 'localname
) " "))
1440 (should (string-equal
1441 (file-remote-p "/[method/]file" 'localname
) "file"))
1442 (should (string-equal
1443 (file-remote-p "/[method/]/path/to/file" 'localname
)
1450 "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1451 (format "/[%s/%s@%s|%s/%s@%s]"
1452 "method1" "user1" "host1" "method2" "user2" "host2")))
1456 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method
)
1461 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user
)
1466 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host
)
1471 "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1477 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop
)
1479 "method1" "user1" "host1")))
1485 "/[method1/user1@host1"
1486 "|method2/user2@host2"
1487 "|method3/user3@host3]/path/to/file"))
1488 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1489 "method1" "user1" "host1"
1490 "method2" "user2" "host2"
1491 "method3" "user3" "host3")))
1496 "/[method1/user1@host1"
1497 "|method2/user2@host2"
1498 "|method3/user3@host3]/path/to/file")
1505 "/[method1/user1@host1"
1506 "|method2/user2@host2"
1507 "|method3/user3@host3]/path/to/file")
1514 "/[method1/user1@host1"
1515 "|method2/user2@host2"
1516 "|method3/user3@host3]/path/to/file")
1523 "/[method1/user1@host1"
1524 "|method2/user2@host2"
1525 "|method3/user3@host3]/path/to/file")
1532 "/[method1/user1@host1"
1533 "|method2/user2@host2"
1534 "|method3/user3@host3]/path/to/file")
1536 (format "%s/%s@%s|%s/%s@%s|"
1537 "method1" "user1" "host1" "method2" "user2" "host2"))))
1540 (tramp-change-syntax syntax
))))
1542 (ert-deftest tramp-test03-file-name-defaults
()
1543 "Check default values for some methods."
1544 ;; Default values in tramp-adb.el.
1545 (should (string-equal (file-remote-p "/adb::" 'host
) ""))
1546 ;; Default values in tramp-ftp.el.
1547 (should (string-equal (file-remote-p "/-:ftp.host:" 'method
) "ftp"))
1548 (dolist (u '("ftp" "anonymous"))
1549 (should (string-equal (file-remote-p (format "/-:%s@:" u
) 'method
) "ftp")))
1550 ;; Default values in tramp-gvfs.el.
1551 (when (and (load "tramp-gvfs" 'noerror
'nomessage
)
1552 (symbol-value 'tramp-gvfs-enabled
))
1553 (should (string-equal (file-remote-p "/synce::" 'user
) nil
)))
1554 ;; Default values in tramp-sh.el.
1555 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1557 (string-equal (file-remote-p (format "/-:root@%s:" h
) 'method
) "su")))
1558 (dolist (m '("su" "sudo" "ksu"))
1559 (should (string-equal (file-remote-p (format "/%s::" m
) 'user
) "root")))
1560 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1562 (string-equal (file-remote-p (format "/%s::" m
) 'user
) (user-login-name))))
1563 ;; Default values in tramp-smb.el.
1564 (should (string-equal (file-remote-p "/smb::" 'user
) nil
)))
1566 (ert-deftest tramp-test04-substitute-in-file-name
()
1567 "Check `substitute-in-file-name'."
1568 (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
1571 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1573 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1574 ;; Quoting local part.
1577 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1580 (substitute-in-file-name "/method:host:/:/path//foo")
1581 "/method:host:/:/path//foo"))
1584 (substitute-in-file-name "/method:host:/:/path///foo")
1585 "/method:host:/:/path///foo"))
1589 (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
1591 (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
1592 ;; Quoting local part.
1595 (substitute-in-file-name "/method:host:/:/path/~/foo")
1596 "/method:host:/:/path/~/foo"))
1599 (substitute-in-file-name "/method:host:/:/path//~/foo")
1600 "/method:host:/:/path//~/foo"))
1602 (let (process-environment)
1605 (substitute-in-file-name "/method:host:/path/$FOO")
1606 "/method:host:/path/$FOO"))
1607 (setenv "FOO" "bla")
1610 (substitute-in-file-name "/method:host:/path/$FOO")
1611 "/method:host:/path/bla"))
1614 (substitute-in-file-name "/method:host:/path/$$FOO")
1615 "/method:host:/path/$FOO"))
1616 ;; Quoting local part.
1619 (substitute-in-file-name "/method:host:/:/path/$FOO")
1620 "/method:host:/:/path/$FOO"))
1621 (setenv "FOO" "bla")
1624 (substitute-in-file-name "/method:host:/:/path/$FOO")
1625 "/method:host:/:/path/$FOO"))
1628 (substitute-in-file-name "/method:host:/:/path/$$FOO")
1629 "/method:host:/:/path/$$FOO"))))
1631 (ert-deftest tramp-test05-expand-file-name
()
1632 "Check `expand-file-name'."
1635 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1638 (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1639 ;; Quoting local part.
1642 (expand-file-name "/method:host:/:/path/./file")
1643 "/method:host:/:/path/file"))
1646 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1649 (expand-file-name "/method:host:/:/~/path/./file")
1650 "/method:host:/:/~/path/file")))
1652 ;; The following test is inspired by Bug#26911. It is rather a bug in
1653 ;; `expand-file-name', and it fails for all Emacs versions. Test
1654 ;; added for later, when it is fixed.
1655 (ert-deftest tramp-test05-expand-file-name-relative
()
1656 "Check `expand-file-name'."
1657 ;; Mark as failed until bug has been fixed.
1658 :expected-result
:failed
1659 (skip-unless (tramp--test-enabled))
1660 ;; These are the methods the test doesn't fail.
1661 (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1662 (tramp-smb-file-name-p tramp-test-temporary-file-directory
))
1663 (setf (ert-test-expected-result-type
1664 (ert-get-test 'tramp-test05-expand-file-name-relative
))
1669 (let ((default-directory
1671 (file-remote-p tramp-test-temporary-file-directory
) "/path")))
1672 (expand-file-name ".." "./"))
1673 (concat (file-remote-p tramp-test-temporary-file-directory
) "/"))))
1675 (ert-deftest tramp-test06-directory-file-name
()
1676 "Check `directory-file-name'.
1677 This checks also `file-name-as-directory', `file-name-directory',
1678 `file-name-nondirectory' and `unhandled-file-name-directory'."
1681 (directory-file-name "/method:host:/path/to/file")
1682 "/method:host:/path/to/file"))
1685 (directory-file-name "/method:host:/path/to/file/")
1686 "/method:host:/path/to/file"))
1689 (file-name-as-directory "/method:host:/path/to/file")
1690 "/method:host:/path/to/file/"))
1693 (file-name-as-directory "/method:host:/path/to/file/")
1694 "/method:host:/path/to/file/"))
1697 (file-name-directory "/method:host:/path/to/file")
1698 "/method:host:/path/to/"))
1701 (file-name-directory "/method:host:/path/to/file/")
1702 "/method:host:/path/to/file/"))
1704 (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1706 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1708 (unhandled-file-name-directory "/method:host:/path/to/file"))
1711 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1712 (dolist (n-e '(nil t
))
1713 ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1714 ;; which ruins the tests.
1715 (let ((non-essential n-e
)
1716 tramp-default-method
)
1721 (file-remote-p tramp-test-temporary-file-directory
'method
))
1724 (file-remote-p tramp-test-temporary-file-directory
'host
))))
1725 (should (string-equal (directory-file-name file
) file
))
1728 (file-name-as-directory file
)
1729 (if (tramp-completion-mode-p)
1730 file
(concat file
"./"))))
1731 (should (string-equal (file-name-directory file
) file
))
1732 (should (string-equal (file-name-nondirectory file
) "")))))))
1734 (ert-deftest tramp-test07-file-exists-p
()
1735 "Check `file-exist-p', `write-region' and `delete-file'."
1736 (skip-unless (tramp--test-enabled))
1738 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1739 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1740 (should-not (file-exists-p tmp-name
))
1741 (write-region "foo" nil tmp-name
)
1742 (should (file-exists-p tmp-name
))
1743 (delete-file tmp-name
)
1744 (should-not (file-exists-p tmp-name
)))))
1746 (ert-deftest tramp-test08-file-local-copy
()
1747 "Check `file-local-copy'."
1748 (skip-unless (tramp--test-enabled))
1750 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1751 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1755 (write-region "foo" nil tmp-name1
)
1756 (should (setq tmp-name2
(file-local-copy tmp-name1
)))
1758 (insert-file-contents tmp-name2
)
1759 (should (string-equal (buffer-string) "foo")))
1760 ;; Check also that a file transfer with compression works.
1761 (let ((default-directory tramp-test-temporary-file-directory
)
1762 (tramp-copy-size-limit 4)
1763 (tramp-inline-compress-start-size 2))
1764 (delete-file tmp-name2
)
1765 (should (setq tmp-name2
(file-local-copy tmp-name1
))))
1767 (delete-file tmp-name1
)
1768 (delete-file tmp-name2
)
1770 (setq tmp-name2
(file-local-copy tmp-name1
))
1771 :type tramp-file-missing
))
1775 (delete-file tmp-name1
)
1776 (delete-file tmp-name2
))))))
1778 (ert-deftest tramp-test09-insert-file-contents
()
1779 "Check `insert-file-contents'."
1780 (skip-unless (tramp--test-enabled))
1782 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1783 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1786 (write-region "foo" nil tmp-name
)
1787 (insert-file-contents tmp-name
)
1788 (should (string-equal (buffer-string) "foo"))
1789 (insert-file-contents tmp-name
)
1790 (should (string-equal (buffer-string) "foofoo"))
1792 (insert-file-contents tmp-name nil
1 3)
1793 (should (string-equal (buffer-string) "oofoofoo"))
1795 (insert-file-contents tmp-name nil nil nil
'replace
)
1796 (should (string-equal (buffer-string) "foo"))
1798 (delete-file tmp-name
)
1800 (insert-file-contents tmp-name
)
1801 :type tramp-file-missing
))
1804 (ignore-errors (delete-file tmp-name
))))))
1806 (ert-deftest tramp-test10-write-region
()
1807 "Check `write-region'."
1808 (skip-unless (tramp--test-enabled))
1810 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
1811 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
1814 ;; Write buffer. Use absolute and relative file name.
1817 (write-region nil nil tmp-name
))
1819 (insert-file-contents tmp-name
)
1820 (should (string-equal (buffer-string) "foo")))
1821 (delete-file tmp-name
)
1824 (should-not (file-exists-p tmp-name
))
1825 (let ((default-directory (file-name-directory tmp-name
)))
1826 (should-not (file-exists-p (file-name-nondirectory tmp-name
)))
1827 (write-region nil nil
(file-name-nondirectory tmp-name
))
1828 (should (file-exists-p (file-name-nondirectory tmp-name
))))
1829 (should (file-exists-p tmp-name
)))
1831 (insert-file-contents tmp-name
)
1832 (should (string-equal (buffer-string) "foo")))
1837 (write-region nil nil tmp-name
'append
))
1839 (insert-file-contents tmp-name
)
1840 (should (string-equal (buffer-string) "foobla")))
1843 (write-region nil nil tmp-name
3))
1845 (insert-file-contents tmp-name
)
1846 (should (string-equal (buffer-string) "foobaz")))
1849 (write-region "foo" nil tmp-name
)
1851 (insert-file-contents tmp-name
)
1852 (should (string-equal (buffer-string) "foo")))
1856 (insert "123456789")
1857 (write-region 3 5 tmp-name
))
1859 (insert-file-contents tmp-name
)
1860 (should (string-equal (buffer-string) "34")))
1862 ;; Do not overwrite if excluded.
1863 (cl-letf (((symbol-function 'y-or-n-p
) (lambda (_prompt) t
)))
1864 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
1865 ;; `mustbenew' is passed to Tramp since Emacs 26.1. We
1866 ;; have no test for this, so we check function
1867 ;; `temporary-file-directory', which has been added to
1868 ;; Emacs 26.1 as well.
1869 (when (fboundp 'temporary-file-directory
)
1871 (cl-letf (((symbol-function 'y-or-n-p
) 'ignore
))
1872 (write-region "foo" nil tmp-name nil nil nil
'mustbenew
))
1873 :type
'file-already-exists
)
1875 (write-region "foo" nil tmp-name nil nil nil
'excl
)
1876 :type
'file-already-exists
)))
1879 (ignore-errors (delete-file tmp-name
))))))
1881 (ert-deftest tramp-test11-copy-file
()
1882 "Check `copy-file'."
1883 (skip-unless (tramp--test-enabled))
1885 ;; TODO: The quoted case does not work.
1886 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1888 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1889 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1890 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
1891 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
1892 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
1894 ;; Copy on remote side.
1897 (write-region "foo" nil tmp-name1
)
1898 (copy-file tmp-name1 tmp-name2
)
1899 (should (file-exists-p tmp-name2
))
1901 (insert-file-contents tmp-name2
)
1902 (should (string-equal (buffer-string) "foo")))
1904 (copy-file tmp-name1 tmp-name2
)
1905 :type
'file-already-exists
)
1906 (copy-file tmp-name1 tmp-name2
'ok
)
1907 (make-directory tmp-name3
)
1909 (copy-file tmp-name1 tmp-name3
)
1910 :type
'file-already-exists
)
1911 (copy-file tmp-name1
(file-name-as-directory tmp-name3
))
1914 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
1917 (ignore-errors (delete-file tmp-name1
))
1918 (ignore-errors (delete-file tmp-name2
))
1919 (ignore-errors (delete-directory tmp-name3
'recursive
)))
1921 ;; Copy from remote side to local side.
1924 (write-region "foo" nil tmp-name1
)
1925 (copy-file tmp-name1 tmp-name4
)
1926 (should (file-exists-p tmp-name4
))
1928 (insert-file-contents tmp-name4
)
1929 (should (string-equal (buffer-string) "foo")))
1931 (copy-file tmp-name1 tmp-name4
)
1932 :type
'file-already-exists
)
1933 (copy-file tmp-name1 tmp-name4
'ok
)
1934 (make-directory tmp-name5
)
1936 (copy-file tmp-name1 tmp-name5
)
1937 :type
'file-already-exists
)
1938 (copy-file tmp-name1
(file-name-as-directory tmp-name5
))
1941 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
1944 (ignore-errors (delete-file tmp-name1
))
1945 (ignore-errors (delete-file tmp-name4
))
1946 (ignore-errors (delete-directory tmp-name5
'recursive
)))
1948 ;; Copy from local side to remote side.
1951 (write-region "foo" nil tmp-name4 nil
'nomessage
)
1952 (copy-file tmp-name4 tmp-name1
)
1953 (should (file-exists-p tmp-name1
))
1955 (insert-file-contents tmp-name1
)
1956 (should (string-equal (buffer-string) "foo")))
1958 (copy-file tmp-name4 tmp-name1
)
1959 :type
'file-already-exists
)
1960 (copy-file tmp-name4 tmp-name1
'ok
)
1961 (make-directory tmp-name3
)
1963 (copy-file tmp-name4 tmp-name3
)
1964 :type
'file-already-exists
)
1965 (copy-file tmp-name4
(file-name-as-directory tmp-name3
))
1968 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
1971 (ignore-errors (delete-file tmp-name1
))
1972 (ignore-errors (delete-file tmp-name4
))
1973 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
1975 (ert-deftest tramp-test12-rename-file
()
1976 "Check `rename-file'."
1977 (skip-unless (tramp--test-enabled))
1979 ;; TODO: The quoted case does not work.
1980 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1982 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
1983 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
1984 (tmp-name3 (tramp--test-make-temp-name nil quoted
))
1985 (tmp-name4 (tramp--test-make-temp-name 'local quoted
))
1986 (tmp-name5 (tramp--test-make-temp-name 'local quoted
)))
1988 ;; Rename on remote side.
1991 (write-region "foo" nil tmp-name1
)
1992 (rename-file tmp-name1 tmp-name2
)
1993 (should-not (file-exists-p tmp-name1
))
1994 (should (file-exists-p tmp-name2
))
1996 (insert-file-contents tmp-name2
)
1997 (should (string-equal (buffer-string) "foo")))
1998 (write-region "foo" nil tmp-name1
)
2000 (rename-file tmp-name1 tmp-name2
)
2001 :type
'file-already-exists
)
2002 (rename-file tmp-name1 tmp-name2
'ok
)
2003 (should-not (file-exists-p tmp-name1
))
2004 (write-region "foo" nil tmp-name1
)
2005 (make-directory tmp-name3
)
2007 (rename-file tmp-name1 tmp-name3
)
2008 :type
'file-already-exists
)
2009 (rename-file tmp-name1
(file-name-as-directory tmp-name3
))
2010 (should-not (file-exists-p tmp-name1
))
2013 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name3
))))
2016 (ignore-errors (delete-file tmp-name1
))
2017 (ignore-errors (delete-file tmp-name2
))
2018 (ignore-errors (delete-directory tmp-name3
'recursive
)))
2020 ;; Rename from remote side to local side.
2023 (write-region "foo" nil tmp-name1
)
2024 (rename-file tmp-name1 tmp-name4
)
2025 (should-not (file-exists-p tmp-name1
))
2026 (should (file-exists-p tmp-name4
))
2028 (insert-file-contents tmp-name4
)
2029 (should (string-equal (buffer-string) "foo")))
2030 (write-region "foo" nil tmp-name1
)
2032 (rename-file tmp-name1 tmp-name4
)
2033 :type
'file-already-exists
)
2034 (rename-file tmp-name1 tmp-name4
'ok
)
2035 (should-not (file-exists-p tmp-name1
))
2036 (write-region "foo" nil tmp-name1
)
2037 (make-directory tmp-name5
)
2039 (rename-file tmp-name1 tmp-name5
)
2040 :type
'file-already-exists
)
2041 (rename-file tmp-name1
(file-name-as-directory tmp-name5
))
2042 (should-not (file-exists-p tmp-name1
))
2045 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name5
))))
2048 (ignore-errors (delete-file tmp-name1
))
2049 (ignore-errors (delete-file tmp-name4
))
2050 (ignore-errors (delete-directory tmp-name5
'recursive
)))
2052 ;; Rename from local side to remote side.
2055 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2056 (rename-file tmp-name4 tmp-name1
)
2057 (should-not (file-exists-p tmp-name4
))
2058 (should (file-exists-p tmp-name1
))
2060 (insert-file-contents tmp-name1
)
2061 (should (string-equal (buffer-string) "foo")))
2062 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2064 (rename-file tmp-name4 tmp-name1
)
2065 :type
'file-already-exists
)
2066 (rename-file tmp-name4 tmp-name1
'ok
)
2067 (should-not (file-exists-p tmp-name4
))
2068 (write-region "foo" nil tmp-name4 nil
'nomessage
)
2069 (make-directory tmp-name3
)
2071 (rename-file tmp-name4 tmp-name3
)
2072 :type
'file-already-exists
)
2073 (rename-file tmp-name4
(file-name-as-directory tmp-name3
))
2074 (should-not (file-exists-p tmp-name4
))
2077 (expand-file-name (file-name-nondirectory tmp-name4
) tmp-name3
))))
2080 (ignore-errors (delete-file tmp-name1
))
2081 (ignore-errors (delete-file tmp-name4
))
2082 (ignore-errors (delete-directory tmp-name3
'recursive
))))))
2084 (ert-deftest tramp-test13-make-directory
()
2085 "Check `make-directory'.
2086 This tests also `file-directory-p' and `file-accessible-directory-p'."
2087 (skip-unless (tramp--test-enabled))
2089 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2090 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2091 (tmp-name2 (expand-file-name "foo/bar" tmp-name1
)))
2094 (make-directory tmp-name1
)
2095 (should (file-directory-p tmp-name1
))
2096 (should (file-accessible-directory-p tmp-name1
))
2097 (should-error (make-directory tmp-name2
) :type
'file-error
)
2098 (make-directory tmp-name2
'parents
)
2099 (should (file-directory-p tmp-name2
))
2100 (should (file-accessible-directory-p tmp-name2
)))
2103 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2105 (ert-deftest tramp-test14-delete-directory
()
2106 "Check `delete-directory'."
2107 (skip-unless (tramp--test-enabled))
2109 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2110 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2111 ;; Delete empty directory.
2112 (make-directory tmp-name
)
2113 (should (file-directory-p tmp-name
))
2114 (delete-directory tmp-name
)
2115 (should-not (file-directory-p tmp-name
))
2116 ;; Delete non-empty directory.
2117 (make-directory tmp-name
)
2118 (should (file-directory-p tmp-name
))
2119 (write-region "foo" nil
(expand-file-name "bla" tmp-name
))
2120 (should (file-exists-p (expand-file-name "bla" tmp-name
)))
2121 (should-error (delete-directory tmp-name
) :type
'file-error
)
2122 (delete-directory tmp-name
'recursive
)
2123 (should-not (file-directory-p tmp-name
)))))
2125 (ert-deftest tramp-test15-copy-directory
()
2126 "Check `copy-directory'."
2127 (skip-unless (tramp--test-enabled))
2129 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2130 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2131 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2132 (tmp-name3 (expand-file-name
2133 (file-name-nondirectory tmp-name1
) tmp-name2
))
2134 (tmp-name4 (expand-file-name "foo" tmp-name1
))
2135 (tmp-name5 (expand-file-name "foo" tmp-name2
))
2136 (tmp-name6 (expand-file-name "foo" tmp-name3
)))
2138 ;; Copy complete directory.
2141 ;; Copy empty directory.
2142 (make-directory tmp-name1
)
2143 (write-region "foo" nil tmp-name4
)
2144 (should (file-directory-p tmp-name1
))
2145 (should (file-exists-p tmp-name4
))
2146 (copy-directory tmp-name1 tmp-name2
)
2147 (should (file-directory-p tmp-name2
))
2148 (should (file-exists-p tmp-name5
))
2149 ;; Target directory does exist already.
2151 (copy-directory tmp-name1 tmp-name2
)
2153 (copy-directory tmp-name1
(file-name-as-directory tmp-name2
))
2154 (should (file-directory-p tmp-name3
))
2155 (should (file-exists-p tmp-name6
)))
2159 (delete-directory tmp-name1
'recursive
)
2160 (delete-directory tmp-name2
'recursive
)))
2162 ;; Copy directory contents.
2165 ;; Copy empty directory.
2166 (make-directory tmp-name1
)
2167 (write-region "foo" nil tmp-name4
)
2168 (should (file-directory-p tmp-name1
))
2169 (should (file-exists-p tmp-name4
))
2170 (copy-directory tmp-name1 tmp-name2 nil
'parents
'contents
)
2171 (should (file-directory-p tmp-name2
))
2172 (should (file-exists-p tmp-name5
))
2173 ;; Target directory does exist already.
2174 (delete-file tmp-name5
)
2175 (should-not (file-exists-p tmp-name5
))
2177 tmp-name1
(file-name-as-directory tmp-name2
)
2178 nil
'parents
'contents
)
2179 (should (file-directory-p tmp-name2
))
2180 (should (file-exists-p tmp-name5
))
2181 (should-not (file-directory-p tmp-name3
))
2182 (should-not (file-exists-p tmp-name6
)))
2186 (delete-directory tmp-name1
'recursive
)
2187 (delete-directory tmp-name2
'recursive
))))))
2189 (ert-deftest tramp-test16-directory-files
()
2190 "Check `directory-files'."
2191 (skip-unless (tramp--test-enabled))
2193 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2194 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2195 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2196 (tmp-name3 (expand-file-name "foo" tmp-name1
)))
2199 (make-directory tmp-name1
)
2200 (write-region "foo" nil tmp-name2
)
2201 (write-region "bla" nil tmp-name3
)
2202 (should (file-directory-p tmp-name1
))
2203 (should (file-exists-p tmp-name2
))
2204 (should (file-exists-p tmp-name3
))
2205 (should (equal (directory-files tmp-name1
) '("." ".." "bla" "foo")))
2206 (should (equal (directory-files tmp-name1
'full
)
2207 `(,(concat tmp-name1
"/.")
2208 ,(concat tmp-name1
"/..")
2209 ,tmp-name2
,tmp-name3
)))
2210 (should (equal (directory-files
2211 tmp-name1 nil directory-files-no-dot-files-regexp
)
2213 (should (equal (directory-files
2214 tmp-name1
'full directory-files-no-dot-files-regexp
)
2215 `(,tmp-name2
,tmp-name3
))))
2218 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2220 ;; This is not a file name handler test. But Tramp needed to apply an
2221 ;; advice for older Emacs versions, so we check that this has been fixed.
2222 (ert-deftest tramp-test16-file-expand-wildcards
()
2223 "Check `file-expand-wildcards'."
2224 (skip-unless (tramp--test-enabled))
2226 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2227 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2228 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2229 (tmp-name3 (expand-file-name "bar" tmp-name1
))
2230 (tmp-name4 (expand-file-name "baz" tmp-name1
))
2231 (default-directory tmp-name1
))
2234 (make-directory tmp-name1
)
2235 (write-region "foo" nil tmp-name2
)
2236 (write-region "bar" nil tmp-name3
)
2237 (write-region "baz" nil tmp-name4
)
2238 (should (file-directory-p tmp-name1
))
2239 (should (file-exists-p tmp-name2
))
2240 (should (file-exists-p tmp-name3
))
2241 (should (file-exists-p tmp-name4
))
2243 ;; We cannot use `sort', it works destructive.
2244 (should (equal (file-expand-wildcards "*")
2245 (seq-sort 'string
< '("foo" "bar" "baz"))))
2246 (should (equal (file-expand-wildcards "ba?")
2247 (seq-sort 'string
< '("bar" "baz"))))
2248 (should (equal (file-expand-wildcards "ba[rz]")
2249 (seq-sort 'string
< '("bar" "baz"))))
2251 (should (equal (file-expand-wildcards "*" 'full
)
2253 'string
< `(,tmp-name2
,tmp-name3
,tmp-name4
))))
2254 (should (equal (file-expand-wildcards "ba?" 'full
)
2255 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2256 (should (equal (file-expand-wildcards "ba[rz]" 'full
)
2257 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2259 (should (equal (file-expand-wildcards (concat tmp-name1
"/" "*"))
2261 'string
< `(,tmp-name2
,tmp-name3
,tmp-name4
))))
2262 (should (equal (file-expand-wildcards (concat tmp-name1
"/" "ba?"))
2263 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
))))
2264 (should (equal (file-expand-wildcards
2265 (concat tmp-name1
"/" "ba[rz]"))
2266 (seq-sort 'string
< `(,tmp-name3
,tmp-name4
)))))
2270 (delete-directory tmp-name1
))))))
2272 (ert-deftest tramp-test17-insert-directory
()
2273 "Check `insert-directory'."
2274 (skip-unless (tramp--test-enabled))
2276 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2278 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2279 (tmp-name2 (expand-file-name "foo" tmp-name1
))
2280 ;; We test for the summary line. Keyword "total" could be localized.
2281 (process-environment
2282 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment
)))
2285 (make-directory tmp-name1
)
2286 (write-region "foo" nil tmp-name2
)
2287 (should (file-directory-p tmp-name1
))
2288 (should (file-exists-p tmp-name2
))
2290 (insert-directory tmp-name1 nil
)
2291 (goto-char (point-min))
2292 (should (looking-at-p (regexp-quote tmp-name1
))))
2294 (insert-directory tmp-name1
"-al")
2295 (goto-char (point-min))
2297 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1
)))))
2299 (insert-directory (file-name-as-directory tmp-name1
) "-al")
2300 (goto-char (point-min))
2302 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1
)))))
2305 (file-name-as-directory tmp-name1
) "-al" nil
'full-directory-p
)
2306 (goto-char (point-min))
2310 ;; There might be a summary line.
2311 "\\(total.+[[:digit:]]+\n\\)?"
2312 ;; We don't know in which order ".", ".." and "foo" appear.
2313 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
2316 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2318 (ert-deftest tramp-test17-dired-with-wildcards
()
2319 "Check `dired' with wildcards."
2320 (skip-unless (tramp--test-enabled))
2321 (skip-unless (tramp--test-sh-p))
2322 ;; Since Emacs 26.1.
2323 (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p
))
2325 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2327 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2329 (expand-file-name (tramp--test-make-temp-name nil quoted
)))
2330 (tmp-name3 (expand-file-name "foo" tmp-name1
))
2331 (tmp-name4 (expand-file-name "bar" tmp-name2
))
2332 (tramp-test-temporary-file-directory
2334 (if quoted
'tramp-compat-file-name-quote
'identity
)
2335 tramp-test-temporary-file-directory
))
2339 (make-directory tmp-name1
)
2340 (write-region "foo" nil tmp-name3
)
2341 (should (file-directory-p tmp-name1
))
2342 (should (file-exists-p tmp-name3
))
2343 (make-directory tmp-name2
)
2344 (write-region "foo" nil tmp-name4
)
2345 (should (file-directory-p tmp-name2
))
2346 (should (file-exists-p tmp-name4
))
2348 ;; Check for expanded directory names.
2349 (with-current-buffer
2353 "tramp-test*" tramp-test-temporary-file-directory
)))
2354 (goto-char (point-min))
2359 tmp-name1 tramp-test-temporary-file-directory
))))
2360 (goto-char (point-min))
2365 tmp-name2 tramp-test-temporary-file-directory
)))))
2366 (kill-buffer buffer
)
2368 ;; Check for expanded directory and file names.
2369 (with-current-buffer
2373 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2374 (goto-char (point-min))
2379 tmp-name3 tramp-test-temporary-file-directory
))))
2380 (goto-char (point-min))
2386 tramp-test-temporary-file-directory
)))))
2387 (kill-buffer buffer
)
2389 ;; Check for special characters.
2390 (setq tmp-name3
(expand-file-name "*?" tmp-name1
))
2391 (setq tmp-name4
(expand-file-name "[a-z0-9]" tmp-name2
))
2392 (write-region "foo" nil tmp-name3
)
2393 (should (file-exists-p tmp-name3
))
2394 (write-region "foo" nil tmp-name4
)
2395 (should (file-exists-p tmp-name4
))
2397 (with-current-buffer
2401 "tramp-test*/*" tramp-test-temporary-file-directory
)))
2402 (goto-char (point-min))
2407 tmp-name3 tramp-test-temporary-file-directory
))))
2408 (goto-char (point-min))
2414 tramp-test-temporary-file-directory
)))))
2415 (kill-buffer buffer
))
2418 (ignore-errors (kill-buffer buffer
))
2419 (ignore-errors (delete-directory tmp-name1
'recursive
))
2420 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
2422 ;; Method "smb" supports `make-symbolic-link' only if the remote host
2423 ;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
2424 ;; support symbolic links at all.
2425 (defmacro tramp--test-ignore-make-symbolic-link-error
(&rest body
)
2426 "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
2427 (declare (indent defun
) (debug t
))
2428 `(condition-case err
2431 (unless (and (eq (car err
) 'file-error
)
2432 (string-equal (error-message-string err
)
2433 "make-symbolic-link not supported"))
2434 (signal (car err
) (cdr err
))))))
2436 (ert-deftest tramp-test18-file-attributes
()
2437 "Check `file-attributes'.
2438 This tests also `file-readable-p', `file-regular-p' and
2439 `file-ownership-preserved-p'."
2440 (skip-unless (tramp--test-enabled))
2442 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2443 ;; We must use `file-truename' for the temporary directory,
2444 ;; because it could be located on a symlinked directory. This
2445 ;; would let the test fail.
2446 (let* ((tramp-test-temporary-file-directory
2447 (file-truename tramp-test-temporary-file-directory
))
2448 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2449 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2450 ;; File name with "//".
2454 (file-remote-p tmp-name1
)
2455 (replace-regexp-in-string
2456 "/" "//" (file-remote-p tmp-name1
'localname
))))
2460 ;; `file-ownership-preserved-p' should return t for
2461 ;; non-existing files. It is implemented only in tramp-sh.el.
2462 (when (tramp--test-sh-p)
2463 (should (file-ownership-preserved-p tmp-name1
'group
)))
2464 (write-region "foo" nil tmp-name1
)
2465 (should (file-exists-p tmp-name1
))
2466 (should (file-readable-p tmp-name1
))
2467 (should (file-regular-p tmp-name1
))
2468 (when (tramp--test-sh-p)
2469 (should (file-ownership-preserved-p tmp-name1
'group
)))
2471 ;; We do not test inodes and device numbers.
2472 (setq attr
(file-attributes tmp-name1
))
2473 (should (consp attr
))
2474 (should (null (car attr
)))
2475 (should (numberp (nth 1 attr
))) ;; Link.
2476 (should (numberp (nth 2 attr
))) ;; Uid.
2477 (should (numberp (nth 3 attr
))) ;; Gid.
2478 ;; Last access time.
2479 (should (stringp (current-time-string (nth 4 attr
))))
2480 ;; Last modification time.
2481 (should (stringp (current-time-string (nth 5 attr
))))
2482 ;; Last status change time.
2483 (should (stringp (current-time-string (nth 6 attr
))))
2484 (should (numberp (nth 7 attr
))) ;; Size.
2485 (should (stringp (nth 8 attr
))) ;; Modes.
2487 (setq attr
(file-attributes tmp-name1
'string
))
2488 (should (stringp (nth 2 attr
))) ;; Uid.
2489 (should (stringp (nth 3 attr
))) ;; Gid.
2491 (tramp--test-ignore-make-symbolic-link-error
2492 (when (tramp--test-sh-p)
2493 (should (file-ownership-preserved-p tmp-name2
'group
)))
2494 (make-symbolic-link tmp-name1 tmp-name2
)
2495 (should (file-exists-p tmp-name2
))
2496 (should (file-symlink-p tmp-name2
))
2497 (when (tramp--test-sh-p)
2498 (should (file-ownership-preserved-p tmp-name2
'group
)))
2499 (setq attr
(file-attributes tmp-name2
))
2503 (if quoted
'tramp-compat-file-name-quote
'identity
)
2505 (file-remote-p (file-truename tmp-name1
) 'localname
)))
2506 (delete-file tmp-name2
))
2508 ;; Check, that "//" in symlinks are handled properly.
2510 (let ((default-directory tramp-test-temporary-file-directory
))
2514 (tramp-file-name-localname
2515 (tramp-dissect-file-name tmp-name3
))
2516 (tramp-file-name-localname
2517 (tramp-dissect-file-name tmp-name2
)))
2519 (when (file-symlink-p tmp-name2
)
2520 (setq attr
(file-attributes tmp-name2
))
2524 (tramp-file-name-localname
2525 (tramp-dissect-file-name tmp-name3
))))
2526 (delete-file tmp-name2
))
2528 (when (tramp--test-sh-p)
2529 (should (file-ownership-preserved-p tmp-name1
'group
)))
2530 (delete-file tmp-name1
)
2531 (make-directory tmp-name1
)
2532 (should (file-exists-p tmp-name1
))
2533 (should (file-readable-p tmp-name1
))
2534 (should-not (file-regular-p tmp-name1
))
2535 (when (tramp--test-sh-p)
2536 (should (file-ownership-preserved-p tmp-name1
'group
)))
2537 (setq attr
(file-attributes tmp-name1
))
2538 (should (eq (car attr
) t
)))
2541 (ignore-errors (delete-directory tmp-name1
))
2542 (ignore-errors (delete-file tmp-name1
))
2543 (ignore-errors (delete-file tmp-name2
))))))
2545 (ert-deftest tramp-test19-directory-files-and-attributes
()
2546 "Check `directory-files-and-attributes'."
2547 (skip-unless (tramp--test-enabled))
2549 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2550 ;; `directory-files-and-attributes' contains also values for
2551 ;; "../". Ensure that this doesn't change during tests, for
2552 ;; example due to handling temporary files.
2553 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2554 (tmp-name2 (expand-file-name "bla" tmp-name1
))
2558 (make-directory tmp-name1
)
2559 (should (file-directory-p tmp-name1
))
2560 (make-directory tmp-name2
)
2561 (should (file-directory-p tmp-name2
))
2562 (write-region "foo" nil
(expand-file-name "foo" tmp-name2
))
2563 (write-region "bar" nil
(expand-file-name "bar" tmp-name2
))
2564 (write-region "boz" nil
(expand-file-name "boz" tmp-name2
))
2565 (setq attr
(directory-files-and-attributes tmp-name2
))
2566 (should (consp attr
))
2567 ;; Dumb remote shells without perl(1) or stat(1) are not
2568 ;; able to return the date correctly. They say "don't know".
2573 5 (file-attributes (expand-file-name (car elt
) tmp-name2
)))
2576 (equal (file-attributes (expand-file-name (car elt
) tmp-name2
))
2578 (setq attr
(directory-files-and-attributes tmp-name2
'full
))
2580 (unless (equal (nth 5 (file-attributes (car elt
))) '(0 0))
2582 (equal (file-attributes (car elt
)) (cdr elt
)))))
2583 (setq attr
(directory-files-and-attributes tmp-name2 nil
"^b"))
2584 (should (equal (mapcar 'car attr
) '("bar" "boz"))))
2587 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
2589 (ert-deftest tramp-test20-file-modes
()
2590 "Check `file-modes'.
2591 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2592 (skip-unless (tramp--test-enabled))
2593 (skip-unless (tramp--test-sh-p))
2595 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2596 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2599 (write-region "foo" nil tmp-name
)
2600 (should (file-exists-p tmp-name
))
2601 (set-file-modes tmp-name
#o777
)
2602 (should (= (file-modes tmp-name
) #o777
))
2603 (should (file-executable-p tmp-name
))
2604 (should (file-writable-p tmp-name
))
2605 (set-file-modes tmp-name
#o444
)
2606 (should (= (file-modes tmp-name
) #o444
))
2607 (should-not (file-executable-p tmp-name
))
2608 ;; A file is always writable for user "root".
2609 (unless (zerop (nth 2 (file-attributes tmp-name
)))
2610 (should-not (file-writable-p tmp-name
))))
2613 (ignore-errors (delete-file tmp-name
))))))
2615 (ert-deftest tramp-test21-file-links
()
2616 "Check `file-symlink-p'.
2617 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2618 (skip-unless (tramp--test-enabled))
2620 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2621 ;; We must use `file-truename' for the temporary directory,
2622 ;; because it could be located on a symlinked directory. This
2623 ;; would let the test fail.
2624 (let* ((tramp-test-temporary-file-directory
2625 (file-truename tramp-test-temporary-file-directory
))
2626 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
2627 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2628 (tmp-name3 (tramp--test-make-temp-name 'local quoted
))
2629 (tmp-name4 (tramp--test-make-temp-name nil quoted
)))
2631 ;; Check `make-symbolic-link'.
2633 (tramp--test-ignore-make-symbolic-link-error
2634 (write-region "foo" nil tmp-name1
)
2635 (should (file-exists-p tmp-name1
))
2636 (make-symbolic-link tmp-name1 tmp-name2
)
2640 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2641 (file-remote-p tmp-name1
'localname
))
2642 (file-symlink-p tmp-name2
)))
2644 (make-symbolic-link tmp-name1 tmp-name2
)
2645 :type
'file-already-exists
)
2646 ;; number means interactive case.
2647 (cl-letf (((symbol-function 'yes-or-no-p
) 'ignore
))
2649 (make-symbolic-link tmp-name1 tmp-name2
0)
2650 :type
'file-already-exists
))
2651 (cl-letf (((symbol-function 'yes-or-no-p
) (lambda (_prompt) t
)))
2652 (make-symbolic-link tmp-name1 tmp-name2
0)
2656 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2657 (file-remote-p tmp-name1
'localname
))
2658 (file-symlink-p tmp-name2
))))
2659 (make-symbolic-link tmp-name1 tmp-name2
'ok-if-already-exists
)
2663 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2664 (file-remote-p tmp-name1
'localname
))
2665 (file-symlink-p tmp-name2
)))
2666 ;; If we use the local part of `tmp-name1', it shall still work.
2668 (file-remote-p tmp-name1
'localname
)
2669 tmp-name2
'ok-if-already-exists
)
2673 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2674 (file-remote-p tmp-name1
'localname
))
2675 (file-symlink-p tmp-name2
)))
2676 ;; `tmp-name3' is a local file name. Therefore, the link
2677 ;; target remains unchanged, even if quoted.
2678 (make-symbolic-link tmp-name1 tmp-name3
)
2680 (string-equal tmp-name1
(file-symlink-p tmp-name3
)))
2681 ;; Check directory as newname.
2682 (make-directory tmp-name4
)
2684 (make-symbolic-link tmp-name1 tmp-name4
)
2685 :type
'file-already-exists
)
2686 (make-symbolic-link tmp-name1
(file-name-as-directory tmp-name4
))
2690 (if quoted
'tramp-compat-file-name-unquote
'identity
)
2691 (file-remote-p tmp-name1
'localname
))
2694 (file-name-nondirectory tmp-name1
) tmp-name4
)))))
2698 (delete-file tmp-name1
)
2699 (delete-file tmp-name2
)
2700 (delete-file tmp-name3
)
2701 (delete-directory tmp-name4
'recursive
)))
2703 ;; Check `add-name-to-file'.
2706 (write-region "foo" nil tmp-name1
)
2707 (should (file-exists-p tmp-name1
))
2708 (add-name-to-file tmp-name1 tmp-name2
)
2709 (should (file-regular-p tmp-name2
))
2711 (add-name-to-file tmp-name1 tmp-name2
)
2712 :type
'file-already-exists
)
2713 ;; number means interactive case.
2714 (cl-letf (((symbol-function 'yes-or-no-p
) 'ignore
))
2716 (add-name-to-file tmp-name1 tmp-name2
0)
2717 :type
'file-already-exists
))
2718 (cl-letf (((symbol-function 'yes-or-no-p
) (lambda (_prompt) t
)))
2719 (add-name-to-file tmp-name1 tmp-name2
0)
2720 (should (file-regular-p tmp-name2
)))
2721 (add-name-to-file tmp-name1 tmp-name2
'ok-if-already-exists
)
2722 (should-not (file-symlink-p tmp-name2
))
2723 (should (file-regular-p tmp-name2
))
2724 ;; `tmp-name3' is a local file name.
2726 (add-name-to-file tmp-name1 tmp-name3
)
2728 ;; Check directory as newname.
2729 (make-directory tmp-name4
)
2731 (add-name-to-file tmp-name1 tmp-name4
)
2732 :type
'file-already-exists
)
2733 (add-name-to-file tmp-name1
(file-name-as-directory tmp-name4
))
2736 (expand-file-name (file-name-nondirectory tmp-name1
) tmp-name4
))))
2740 (delete-file tmp-name1
)
2741 (delete-file tmp-name2
)
2742 (delete-directory tmp-name4
'recursive
)))
2744 ;; Check `file-truename'.
2746 (tramp--test-ignore-make-symbolic-link-error
2747 (write-region "foo" nil tmp-name1
)
2748 (should (file-exists-p tmp-name1
))
2749 (should (string-equal tmp-name1
(file-truename tmp-name1
)))
2750 (make-symbolic-link tmp-name1 tmp-name2
)
2751 (should (file-symlink-p tmp-name2
))
2752 (should-not (string-equal tmp-name2
(file-truename tmp-name2
)))
2754 (string-equal (file-truename tmp-name1
) (file-truename tmp-name2
)))
2755 (should (file-equal-p tmp-name1 tmp-name2
))
2756 ;; Symbolic links could look like a remote file name.
2757 ;; They must be quoted then.
2758 (delete-file tmp-name2
)
2759 (make-symbolic-link "/penguin:motd:" tmp-name2
)
2760 (should (file-symlink-p tmp-name2
))
2763 (file-truename tmp-name2
)
2764 (tramp-compat-file-name-quote
2765 (concat (file-remote-p tmp-name2
) "/penguin:motd:"))))
2766 ;; `tmp-name3' is a local file name.
2767 (make-symbolic-link tmp-name1 tmp-name3
)
2768 (should (file-symlink-p tmp-name3
))
2769 (should-not (string-equal tmp-name3
(file-truename tmp-name3
)))
2770 ;; `file-truename' returns a quoted file name for `tmp-name3'.
2771 ;; We must unquote it.
2774 (file-truename tmp-name1
)
2775 (tramp-compat-file-name-unquote (file-truename tmp-name3
)))))
2779 (delete-file tmp-name1
)
2780 (delete-file tmp-name2
)
2781 (delete-file tmp-name3
)))
2783 ;; Symbolic links could be nested.
2785 (tramp--test-ignore-make-symbolic-link-error
2786 (make-directory tmp-name1
)
2787 (should (file-directory-p tmp-name1
))
2788 (let* ((tramp-test-temporary-file-directory
2789 (file-truename tmp-name1
))
2790 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2791 (tmp-name3 tmp-name2
)
2792 (number-nesting 15))
2793 (dotimes (_ number-nesting
)
2796 (setq tmp-name3
(tramp--test-make-temp-name nil quoted
))))
2799 (file-truename tmp-name2
)
2800 (file-truename tmp-name3
)))
2802 (with-temp-buffer (insert-file-contents tmp-name2
))
2803 :type tramp-file-missing
)
2805 (with-temp-buffer (insert-file-contents tmp-name3
))
2806 :type tramp-file-missing
)
2807 ;; `directory-files' does not show symlinks to
2808 ;; non-existing targets in the "smb" case. So we remove
2809 ;; the symlinks manually.
2810 (while (stringp (setq tmp-name2
(file-symlink-p tmp-name3
)))
2811 (delete-file tmp-name3
)
2812 (setq tmp-name3
(concat (file-remote-p tmp-name3
) tmp-name2
)))))
2815 (ignore-errors (delete-directory tmp-name1
'recursive
)))
2817 ;; Detect cyclic symbolic links.
2819 (tramp--test-ignore-make-symbolic-link-error
2820 (make-symbolic-link tmp-name2 tmp-name1
)
2821 (should (file-symlink-p tmp-name1
))
2822 (make-symbolic-link tmp-name1 tmp-name2
)
2823 (should (file-symlink-p tmp-name2
))
2824 (should-error (file-truename tmp-name1
) :type
'file-error
))
2828 (delete-file tmp-name1
)
2829 (delete-file tmp-name2
)))
2831 ;; `file-truename' shall preserve trailing link of directories.
2832 (unless (file-symlink-p tramp-test-temporary-file-directory
)
2833 (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory
))
2834 (dir2 (file-name-as-directory dir1
)))
2835 (should (string-equal (file-truename dir1
) (expand-file-name dir1
)))
2837 (string-equal (file-truename dir2
) (expand-file-name dir2
))))))))
2839 (ert-deftest tramp-test22-file-times
()
2840 "Check `set-file-times' and `file-newer-than-file-p'."
2841 (skip-unless (tramp--test-enabled))
2842 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2844 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2845 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
2846 (tmp-name2 (tramp--test-make-temp-name nil quoted
))
2847 (tmp-name3 (tramp--test-make-temp-name nil quoted
)))
2850 (write-region "foo" nil tmp-name1
)
2851 (should (file-exists-p tmp-name1
))
2852 (should (consp (nth 5 (file-attributes tmp-name1
))))
2853 ;; '(0 0) means don't know, and will be replaced by
2854 ;; `current-time'. Therefore, we use '(0 1). We skip the
2855 ;; test, if the remote handler is not able to set the
2857 (skip-unless (set-file-times tmp-name1
'(0 1)))
2858 ;; Dumb remote shells without perl(1) or stat(1) are not
2859 ;; able to return the date correctly. They say "don't know".
2860 (unless (equal (nth 5 (file-attributes tmp-name1
)) '(0 0))
2861 (should (equal (nth 5 (file-attributes tmp-name1
)) '(0 1)))
2862 (write-region "bla" nil tmp-name2
)
2863 (should (file-exists-p tmp-name2
))
2864 (should (file-newer-than-file-p tmp-name2 tmp-name1
))
2865 ;; `tmp-name3' does not exist.
2866 (should (file-newer-than-file-p tmp-name2 tmp-name3
))
2867 (should-not (file-newer-than-file-p tmp-name3 tmp-name1
))))
2871 (delete-file tmp-name1
)
2872 (delete-file tmp-name2
))))))
2874 (ert-deftest tramp-test23-visited-file-modtime
()
2875 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
2876 (skip-unless (tramp--test-enabled))
2878 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2879 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
2882 (write-region "foo" nil tmp-name
)
2883 (should (file-exists-p tmp-name
))
2885 (insert-file-contents tmp-name
)
2886 (should (verify-visited-file-modtime))
2887 (set-visited-file-modtime '(0 1))
2888 (should (verify-visited-file-modtime))
2889 (should (equal (visited-file-modtime) '(0 1 0 0)))))
2892 (ignore-errors (delete-file tmp-name
))))))
2894 (ert-deftest tramp-test24-file-name-completion
()
2895 "Check `file-name-completion' and `file-name-all-completions'."
2896 (skip-unless (tramp--test-enabled))
2898 ;; Method and host name in completion mode. This kind of completion
2899 ;; does not work on MS Windows.
2900 (when (not (memq system-type
'(cygwin windows-nt
)))
2901 (let ((method (file-remote-p tramp-test-temporary-file-directory
'method
))
2902 (host (file-remote-p tramp-test-temporary-file-directory
'host
))
2903 (orig-syntax tramp-syntax
))
2904 (when (and (stringp host
) (string-match tramp-host-with-port-regexp host
))
2905 (setq host
(match-string 1 host
)))
2910 (if tramp--test-expensive-test
2911 (tramp-syntax-values) `(,orig-syntax
)))
2912 (tramp-change-syntax syntax
)
2913 (let ;; This is needed for the `simplified' syntax.
2915 (if (zerop (length tramp-method-regexp
))
2916 "" tramp-default-method-marker
))
2917 ;; This is needed for the `separate' syntax.
2918 (prefix-format (substring tramp-prefix-format
1)))
2919 ;; Complete method name.
2920 (unless (or (zerop (length method
))
2921 (zerop (length tramp-method-regexp
)))
2924 (concat prefix-format method tramp-postfix-method-format
)
2925 (file-name-all-completions
2926 (concat prefix-format
(substring method
0 1)) "/"))))
2927 ;; Complete host name for default method. With gvfs
2928 ;; based methods, host name will be determined as
2929 ;; host.local, so we omit the test.
2930 (let ((tramp-default-method (or method tramp-default-method
)))
2931 (unless (or (zerop (length host
))
2932 (tramp--test-gvfs-p tramp-default-method
))
2936 prefix-format method-marker tramp-postfix-method-format
2937 host tramp-postfix-host-format
)
2938 (file-name-all-completions
2940 prefix-format method-marker tramp-postfix-method-format
2941 (substring host
0 1))
2943 ;; Complete host name.
2944 (unless (or (zerop (length method
))
2945 (zerop (length tramp-method-regexp
))
2946 (zerop (length host
))
2947 (tramp--test-gvfs-p method
))
2951 prefix-format method tramp-postfix-method-format
2952 host tramp-postfix-host-format
)
2953 (file-name-all-completions
2954 (concat prefix-format method tramp-postfix-method-format
)
2958 (tramp-change-syntax orig-syntax
))))
2960 (dolist (n-e '(nil t
))
2961 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
2962 (let ((non-essential n-e
)
2963 (tmp-name (tramp--test-make-temp-name nil quoted
)))
2968 (make-directory tmp-name
)
2969 (should (file-directory-p tmp-name
))
2970 (write-region "foo" nil
(expand-file-name "foo" tmp-name
))
2971 (should (file-exists-p (expand-file-name "foo" tmp-name
)))
2972 (write-region "bar" nil
(expand-file-name "bold" tmp-name
))
2973 (should (file-exists-p (expand-file-name "bold" tmp-name
)))
2974 (make-directory (expand-file-name "boz" tmp-name
))
2975 (should (file-directory-p (expand-file-name "boz" tmp-name
)))
2976 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
2977 (should (equal (file-name-completion "foo" tmp-name
) t
))
2978 (should (equal (file-name-completion "b" tmp-name
) "bo"))
2979 (should-not (file-name-completion "a" tmp-name
))
2982 (file-name-completion "b" tmp-name
'file-directory-p
) "boz/"))
2984 (equal (file-name-all-completions "fo" tmp-name
) '("foo")))
2987 (sort (file-name-all-completions "b" tmp-name
) 'string-lessp
)
2989 (should-not (file-name-all-completions "a" tmp-name
))
2990 ;; `completion-regexp-list' restricts the completion to
2991 ;; files which match all expressions in this list.
2992 (let ((completion-regexp-list
2993 `(,directory-files-no-dot-files-regexp
"b")))
2995 (equal (file-name-completion "" tmp-name
) "bo"))
2998 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
3000 ;; `file-name-completion' ignores file names that end in
3001 ;; any string in `completion-ignored-extensions'.
3002 (let ((completion-ignored-extensions '(".ext")))
3003 (write-region "foo" nil
(expand-file-name "foo.ext" tmp-name
))
3004 (should (file-exists-p (expand-file-name "foo.ext" tmp-name
)))
3005 (should (equal (file-name-completion "fo" tmp-name
) "foo"))
3006 (should (equal (file-name-completion "foo" tmp-name
) t
))
3008 (equal (file-name-completion "foo." tmp-name
) "foo.ext"))
3009 (should (equal (file-name-completion "foo.ext" tmp-name
) t
))
3010 ;; `file-name-all-completions' is not affected.
3013 (sort (file-name-all-completions "" tmp-name
) 'string-lessp
)
3014 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
3017 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
3019 (ert-deftest tramp-test25-load
()
3021 (skip-unless (tramp--test-enabled))
3023 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3024 (let ((tmp-name (tramp--test-make-temp-name nil quoted
)))
3027 (load tmp-name
'noerror
'nomessage
)
3028 (should-not (featurep 'tramp-test-load
))
3029 (write-region "(provide 'tramp-test-load)" nil tmp-name
)
3030 ;; `load' in lread.c does not pass `must-suffix'. Why?
3032 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
3033 ;; :type 'file-error)
3034 (load tmp-name nil
'nomessage
'nosuffix
)
3035 (should (featurep 'tramp-test-load
)))
3039 (and (featurep 'tramp-test-load
) (unload-feature 'tramp-test-load
))
3040 (delete-file tmp-name
))))))
3042 (ert-deftest tramp-test26-process-file
()
3043 "Check `process-file'."
3044 :tags
'(:expensive-test
)
3045 (skip-unless (tramp--test-enabled))
3046 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3048 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3049 (let* ((tmp-name (tramp--test-make-temp-name nil quoted
))
3050 (fnnd (file-name-nondirectory tmp-name
))
3051 (default-directory tramp-test-temporary-file-directory
)
3052 kill-buffer-query-functions
)
3055 ;; We cannot use "/bin/true" and "/bin/false"; those paths
3056 ;; do not exist on hydra.
3057 (should (zerop (process-file "true")))
3058 (should-not (zerop (process-file "false")))
3059 (should-not (zerop (process-file "binary-does-not-exist")))
3061 (write-region "foo" nil tmp-name
)
3062 (should (file-exists-p tmp-name
))
3063 (should (zerop (process-file "ls" nil t nil fnnd
)))
3064 ;; `ls' could produce colorized output.
3065 (goto-char (point-min))
3067 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3068 (replace-match "" nil nil
))
3069 (should (string-equal (format "%s\n" fnnd
) (buffer-string)))
3070 (should-not (get-buffer-window (current-buffer) t
))
3072 ;; Second run. The output must be appended.
3073 (goto-char (point-max))
3074 (should (zerop (process-file "ls" nil t t fnnd
)))
3075 ;; `ls' could produce colorized output.
3076 (goto-char (point-min))
3078 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3079 (replace-match "" nil nil
))
3081 (string-equal (format "%s\n%s\n" fnnd fnnd
) (buffer-string)))
3082 ;; A non-nil DISPLAY must not raise the buffer.
3083 (should-not (get-buffer-window (current-buffer) t
))))
3086 (ignore-errors (delete-file tmp-name
))))))
3088 (ert-deftest tramp-test27-start-file-process
()
3089 "Check `start-file-process'."
3090 :tags
'(:expensive-test
)
3091 (skip-unless (tramp--test-enabled))
3092 (skip-unless (tramp--test-sh-p))
3094 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3095 (let ((default-directory tramp-test-temporary-file-directory
)
3096 (tmp-name (tramp--test-make-temp-name nil quoted
))
3097 kill-buffer-query-functions proc
)
3100 (setq proc
(start-file-process "test1" (current-buffer) "cat"))
3101 (should (processp proc
))
3102 (should (equal (process-status proc
) 'run
))
3103 (process-send-string proc
"foo")
3104 (process-send-eof proc
)
3106 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3107 (while (< (- (point-max) (point-min)) (length "foo"))
3108 (accept-process-output proc
0.1)))
3109 (should (string-equal (buffer-string) "foo")))
3112 (ignore-errors (delete-process proc
)))
3116 (write-region "foo" nil tmp-name
)
3117 (should (file-exists-p tmp-name
))
3120 "test2" (current-buffer)
3121 "cat" (file-name-nondirectory tmp-name
)))
3122 (should (processp proc
))
3124 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3125 (while (< (- (point-max) (point-min)) (length "foo"))
3126 (accept-process-output proc
0.1)))
3127 (should (string-equal (buffer-string) "foo")))
3131 (delete-process proc
)
3132 (delete-file tmp-name
)))
3136 (setq proc
(start-file-process "test3" (current-buffer) "cat"))
3137 (should (processp proc
))
3138 (should (equal (process-status proc
) 'run
))
3141 (lambda (p s
) (with-current-buffer (process-buffer p
) (insert s
))))
3142 (process-send-string proc
"foo")
3143 (process-send-eof proc
)
3145 (with-timeout (10 (ert-fail "`start-file-process' timed out"))
3146 (while (< (- (point-max) (point-min)) (length "foo"))
3147 (accept-process-output proc
0.1)))
3148 (should (string-equal (buffer-string) "foo")))
3151 (ignore-errors (delete-process proc
))))))
3153 (ert-deftest tramp-test28-interrupt-process
()
3154 "Check `interrupt-process'."
3155 :tags
'(:expensive-test
)
3156 (skip-unless (tramp--test-enabled))
3157 (skip-unless (tramp--test-sh-p))
3158 ;; Since Emacs 26.1.
3159 (skip-unless (boundp 'interrupt-process-functions
))
3161 (let ((default-directory tramp-test-temporary-file-directory
)
3162 kill-buffer-query-functions proc
)
3165 (setq proc
(start-file-process "test" (current-buffer) "sleep" "10"))
3166 (should (processp proc
))
3167 (should (process-live-p proc
))
3168 (should (equal (process-status proc
) 'run
))
3169 (should (interrupt-process proc
))
3170 ;; Let the process accept the interrupt.
3171 (accept-process-output proc
1 nil
0)
3172 (should-not (process-live-p proc
))
3173 (should (equal (process-status proc
) 'signal
))
3174 ;; An interrupted process cannot be interrupted, again.
3175 ;; Does not work reliable.
3176 ;; (should-error (interrupt-process proc) :type 'error))
3180 (ignore-errors (delete-process proc
)))))
3182 (ert-deftest tramp-test29-shell-command
()
3183 "Check `shell-command'."
3184 :tags
'(:expensive-test
)
3185 (skip-unless (tramp--test-enabled))
3186 (skip-unless (tramp--test-sh-p))
3188 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3189 (let ((tmp-name (tramp--test-make-temp-name nil quoted
))
3190 (default-directory tramp-test-temporary-file-directory
)
3191 ;; Suppress nasty messages.
3193 kill-buffer-query-functions
)
3196 (write-region "foo" nil tmp-name
)
3197 (should (file-exists-p tmp-name
))
3199 (format "ls %s" (file-name-nondirectory tmp-name
))
3201 ;; `ls' could produce colorized output.
3202 (goto-char (point-min))
3204 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3205 (replace-match "" nil nil
))
3208 (format "%s\n" (file-name-nondirectory tmp-name
))
3212 (ignore-errors (delete-file tmp-name
)))
3216 (write-region "foo" nil tmp-name
)
3217 (should (file-exists-p tmp-name
))
3218 (async-shell-command
3219 (format "ls %s" (file-name-nondirectory tmp-name
))
3222 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3223 (while (< (- (point-max) (point-min))
3224 (1+ (length (file-name-nondirectory tmp-name
))))
3225 (accept-process-output
3226 (get-buffer-process (current-buffer)) 0.1)))
3227 ;; `ls' could produce colorized output.
3228 (goto-char (point-min))
3230 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3231 (replace-match "" nil nil
))
3232 ;; There might be a nasty "Process *Async Shell* finished" message.
3233 (goto-char (point-min))
3235 (narrow-to-region (point-min) (point))
3238 (format "%s\n" (file-name-nondirectory tmp-name
))
3242 (ignore-errors (delete-file tmp-name
)))
3246 (write-region "foo" nil tmp-name
)
3247 (should (file-exists-p tmp-name
))
3248 (async-shell-command "read line; ls $line" (current-buffer))
3249 (process-send-string
3250 (get-buffer-process (current-buffer))
3251 (format "%s\n" (file-name-nondirectory tmp-name
)))
3253 (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
3254 (while (< (- (point-max) (point-min))
3255 (1+ (length (file-name-nondirectory tmp-name
))))
3256 (accept-process-output
3257 (get-buffer-process (current-buffer)) 0.1)))
3258 ;; `ls' could produce colorized output.
3259 (goto-char (point-min))
3261 (re-search-forward tramp-display-escape-sequence-regexp nil t
)
3262 (replace-match "" nil nil
))
3263 ;; There might be a nasty "Process *Async Shell* finished" message.
3264 (goto-char (point-min))
3266 (narrow-to-region (point-min) (point))
3269 (format "%s\n" (file-name-nondirectory tmp-name
))
3273 (ignore-errors (delete-file tmp-name
))))))
3275 (defun tramp--test-shell-command-to-string-asynchronously (command)
3276 "Like `shell-command-to-string', but for asynchronous processes."
3278 (async-shell-command command
(current-buffer))
3280 (while (get-buffer-process (current-buffer))
3281 (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3282 (accept-process-output nil
0.1)
3283 (buffer-substring-no-properties (point-min) (point-max))))
3285 ;; This test is inspired by Bug#23952.
3286 (ert-deftest tramp-test30-environment-variables
()
3287 "Check that remote processes set / unset environment variables properly."
3288 :tags
'(:expensive-test
)
3289 (skip-unless (tramp--test-enabled))
3290 (skip-unless (tramp--test-sh-p))
3292 (dolist (this-shell-command-to-string
3294 shell-command-to-string
3296 tramp--test-shell-command-to-string-asynchronously
))
3298 (let ((default-directory tramp-test-temporary-file-directory
)
3299 (shell-file-name "/bin/sh")
3300 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3301 kill-buffer-query-functions
)
3305 (let ((process-environment
3306 (cons (concat envvar
"=foo") process-environment
)))
3312 this-shell-command-to-string
3313 (format "echo -n ${%s:?bla}" envvar
))))))
3316 ;; Set the empty value.
3317 (let ((process-environment
3318 (cons (concat envvar
"=") process-environment
)))
3324 this-shell-command-to-string
3325 (format "echo -n ${%s:?bla}" envvar
))))
3329 (regexp-quote envvar
)
3330 (funcall this-shell-command-to-string
"set")))))
3332 ;; We force a reconnect, in order to have a clean environment.
3333 (tramp-cleanup-connection
3334 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3335 'keep-debug
'keep-password
)
3337 ;; Unset the variable.
3338 (let ((tramp-remote-process-environment
3339 (cons (concat envvar
"=foo")
3340 tramp-remote-process-environment
)))
3341 ;; Set the initial value, we want to unset below.
3346 this-shell-command-to-string
3347 (format "echo -n ${%s:?bla}" envvar
))))
3348 (let ((process-environment
3349 (cons envvar process-environment
)))
3350 ;; Variable is unset.
3355 this-shell-command-to-string
3356 (format "echo -n ${%s:?bla}" envvar
))))
3357 ;; Variable is unset.
3360 (regexp-quote envvar
)
3361 (funcall this-shell-command-to-string
"set")))))))))
3363 ;; This test is inspired by Bug#27009.
3364 (ert-deftest tramp-test30-environment-variables-and-port-numbers
()
3365 "Check that two connections with separate ports are different."
3366 (skip-unless (tramp--test-enabled))
3367 ;; We test it only for the mock-up connection; otherwise there might
3368 ;; be problems with the used ports.
3371 (eq tramp-syntax
'default
)
3373 "mock" (file-remote-p tramp-test-temporary-file-directory
'method
))))
3375 ;; We force a reconnect, in order to have a clean environment.
3376 (dolist (dir `(,tramp-test-temporary-file-directory
3377 "/mock:localhost#11111:" "/mock:localhost#22222:"))
3378 (tramp-cleanup-connection
3379 (tramp-dissect-file-name dir
) 'keep-debug
'keep-password
))
3382 (dolist (port '(11111 22222))
3383 (let* ((default-directory
3384 (format "/mock:localhost#%d:%s" port temporary-file-directory
))
3385 (shell-file-name "/bin/sh")
3386 (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3387 ;; We cannot use `process-environment', because this
3388 ;; would be applied in `process-file'.
3389 (tramp-remote-process-environment
3391 (format "%s=%d" envvar port
)
3392 tramp-remote-process-environment
)))
3395 (number-to-string port
)
3396 (shell-command-to-string (format "echo -n $%s" envvar
))))))
3399 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3400 (tramp-cleanup-connection (tramp-dissect-file-name dir
)))))
3402 ;; The functions were introduced in Emacs 26.1.
3403 (ert-deftest tramp-test31-explicit-shell-file-name
()
3404 "Check that connection-local `explicit-shell-file-name' is set."
3405 :tags
'(:expensive-test
)
3406 (skip-unless (tramp--test-enabled))
3407 (skip-unless (tramp--test-sh-p))
3408 ;; Since Emacs 26.1.
3409 (skip-unless (and (fboundp 'connection-local-set-profile-variables
)
3410 (fboundp 'connection-local-set-profiles
)))
3412 ;; `connection-local-set-profile-variables' and
3413 ;; `connection-local-set-profiles' exists since Emacs 26. We don't
3414 ;; want to see compiler warnings for older Emacsen.
3415 (let ((default-directory tramp-test-temporary-file-directory
)
3416 explicit-shell-file-name kill-buffer-query-functions
)
3419 ;; `shell-mode' would ruin our test, because it deletes all
3420 ;; buffer local variables.
3421 (put 'explicit-shell-file-name
'permanent-local t
)
3422 ;; Declare connection-local variable `explicit-shell-file-name'.
3424 (connection-local-set-profile-variables
3426 '((explicit-shell-file-name .
"/bin/sh")
3427 (explicit-sh-args .
("-i"))))
3428 (connection-local-set-profiles
3429 `(:application tramp
3430 :protocol
,(file-remote-p default-directory
'method
)
3431 :user
,(file-remote-p default-directory
'user
)
3432 :machine
,(file-remote-p default-directory
'host
))
3435 ;; Run interactive shell. Since the default directory is
3436 ;; remote, `explicit-shell-file-name' shall be set in order
3437 ;; to avoid a question.
3438 (with-current-buffer (get-buffer-create "*shell*")
3439 (ignore-errors (kill-process (current-buffer)))
3440 (should-not explicit-shell-file-name
)
3441 (call-interactively 'shell
)
3442 (should explicit-shell-file-name
)))
3444 (put 'explicit-shell-file-name
'permanent-local nil
)
3445 (kill-buffer "*shell*"))))
3447 (ert-deftest tramp-test32-vc-registered
()
3448 "Check `vc-registered'."
3449 :tags
'(:expensive-test
)
3450 (skip-unless (tramp--test-enabled))
3451 (skip-unless (tramp--test-sh-p))
3453 ;; TODO: This test fails.
3454 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3455 (let* ((default-directory tramp-test-temporary-file-directory
)
3456 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
3457 (tmp-name2 (expand-file-name "foo" tmp-name1
))
3458 (tramp-remote-process-environment tramp-remote-process-environment
)
3459 (vc-handled-backends
3460 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3462 ((tramp-find-executable
3463 v vc-git-program
(tramp-get-remote-path v
))
3465 ((tramp-find-executable
3466 v vc-hg-program
(tramp-get-remote-path v
))
3468 ((tramp-find-executable
3469 v vc-bzr-program
(tramp-get-remote-path v
))
3470 (setq tramp-remote-process-environment
3471 (cons (format "BZR_HOME=%s"
3472 (file-remote-p tmp-name1
'localname
))
3473 tramp-remote-process-environment
))
3474 ;; We must force a reconnect, in order to activate $BZR_HOME.
3475 (tramp-cleanup-connection
3476 (tramp-dissect-file-name tramp-test-temporary-file-directory
)
3477 'keep-debug
'keep-password
)
3480 ;; Suppress nasty messages.
3481 (inhibit-message t
))
3482 (skip-unless vc-handled-backends
)
3483 (unless quoted
(tramp--test-message "%s" vc-handled-backends
))
3487 (make-directory tmp-name1
)
3488 (write-region "foo" nil tmp-name2
)
3489 (should (file-directory-p tmp-name1
))
3490 (should (file-exists-p tmp-name2
))
3491 (should-not (vc-registered tmp-name1
))
3492 (should-not (vc-registered tmp-name2
))
3494 (let ((default-directory tmp-name1
))
3495 ;; Create empty repository, and register the file.
3496 ;; Sometimes, creation of repository fails (bzr!); we
3497 ;; skip the test then.
3499 (vc-create-repo (car vc-handled-backends
))
3500 (error (skip-unless nil
)))
3501 ;; The structure of VC-FILESET is not documented. Let's
3502 ;; hope it won't change.
3505 (list (car vc-handled-backends
)
3506 (list (file-name-nondirectory tmp-name2
))))
3507 ;; `vc-register' has changed its arguments in Emacs 25.1.
3510 nil
(list (car vc-handled-backends
)
3511 (list (file-name-nondirectory tmp-name2
))))))
3512 ;; vc-git uses an own process sentinel, Tramp's sentinel
3513 ;; for flushing the cache isn't used.
3514 (dired-uncache (concat (file-remote-p default-directory
) "/"))
3515 (should (vc-registered (file-name-nondirectory tmp-name2
)))))
3518 (ignore-errors (delete-directory tmp-name1
'recursive
))))))
3520 (ert-deftest tramp-test33-make-auto-save-file-name
()
3521 "Check `make-auto-save-file-name'."
3522 (skip-unless (tramp--test-enabled))
3524 (dolist (quoted (if tramp--test-expensive-test
'(nil t
) '(nil)))
3525 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted
))
3526 (tmp-name2 (tramp--test-make-temp-name nil quoted
)))
3530 ;; Use default `auto-save-file-name-transforms' mechanism.
3531 (let (tramp-auto-save-directory)
3533 (setq buffer-file-name tmp-name1
)
3536 (make-auto-save-file-name)
3537 ;; This is taken from original `make-auto-save-file-name'.
3538 ;; We call `convert-standard-filename', because on
3539 ;; MS Windows the (local) colons must be replaced by
3540 ;; exclamation marks.
3541 (convert-standard-filename
3545 (subst-char-in-string
3546 ?
/ ?
! (replace-regexp-in-string "!" "!!" tmp-name1
)))
3547 temporary-file-directory
))))))
3550 (let (tramp-auto-save-directory auto-save-file-name-transforms
)
3552 (setq buffer-file-name tmp-name1
)
3555 (make-auto-save-file-name)
3557 (if quoted
'tramp-compat-file-name-quote
'identity
)
3559 (format "#%s#" (file-name-nondirectory tmp-name1
))
3560 tramp-test-temporary-file-directory
))))))
3562 ;; TODO: The following two cases don't work yet.
3564 ;; Use default `tramp-auto-save-directory' mechanism.
3565 (let ((tramp-auto-save-directory tmp-name2
))
3567 (setq buffer-file-name tmp-name1
)
3570 (make-auto-save-file-name)
3571 ;; This is taken from Tramp.
3575 (tramp-subst-strs-in-string
3582 (tramp-compat-file-name-unquote tmp-name1
)))
3584 (should (file-directory-p tmp-name2
))))
3586 ;; Relative file names shall work, too.
3587 (let ((tramp-auto-save-directory "."))
3589 (setq buffer-file-name tmp-name1
3590 default-directory tmp-name2
)
3593 (make-auto-save-file-name)
3594 ;; This is taken from Tramp.
3598 (tramp-subst-strs-in-string
3605 (tramp-compat-file-name-unquote tmp-name1
)))
3607 (should (file-directory-p tmp-name2
)))))
3611 (ignore-errors (delete-file tmp-name1
))
3612 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
3614 ;; The functions were introduced in Emacs 26.1.
3615 (ert-deftest tramp-test34-make-nearby-temp-file
()
3616 "Check `make-nearby-temp-file' and `temporary-file-directory'."
3617 (skip-unless (tramp--test-enabled))
3618 ;; Since Emacs 26.1.
3620 (and (fboundp 'make-nearby-temp-file
) (fboundp 'temporary-file-directory
)))
3622 ;; `make-nearby-temp-file' and `temporary-file-directory' exists
3623 ;; since Emacs 26. We don't want to see compiler warnings for older
3625 (let ((default-directory tramp-test-temporary-file-directory
)
3627 ;; The remote host shall know a temporary file directory.
3628 (should (stringp (with-no-warnings (temporary-file-directory))))
3631 (file-remote-p default-directory
)
3632 (file-remote-p (with-no-warnings (temporary-file-directory)))))
3634 ;; The temporary file shall be located on the remote host.
3635 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test")))
3636 (should (file-exists-p tmp-file
))
3637 (should (file-regular-p tmp-file
))
3640 (file-remote-p default-directory
)
3641 (file-remote-p tmp-file
)))
3642 (delete-file tmp-file
)
3643 (should-not (file-exists-p tmp-file
))
3645 (setq tmp-file
(with-no-warnings (make-nearby-temp-file "tramp-test" 'dir
)))
3646 (should (file-exists-p tmp-file
))
3647 (should (file-directory-p tmp-file
))
3648 (delete-directory tmp-file
)
3649 (should-not (file-exists-p tmp-file
))))
3651 (defun tramp--test-adb-p ()
3652 "Check, whether the remote host runs Android.
3653 This requires restrictions of file name syntax."
3654 (tramp-adb-file-name-p tramp-test-temporary-file-directory
))
3656 (defun tramp--test-docker-p ()
3657 "Check, whether the docker method is used.
3658 This does not support some special file names."
3660 "docker" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3662 (defun tramp--test-ftp-p ()
3663 "Check, whether an FTP-like method is used.
3664 This does not support globbing characters in file names (yet)."
3665 ;; Globbing characters are ??, ?* and ?\[.
3667 "ftp$" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3669 (defun tramp--test-gvfs-p (&optional method
)
3670 "Check, whether the remote host runs a GVFS based method.
3671 This requires restrictions of file name syntax."
3672 (or (member method tramp-gvfs-methods
)
3673 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory
)))
3675 (defun tramp--test-hpux-p ()
3676 "Check, whether the remote host runs HP-UX.
3677 Several special characters do not work properly there."
3678 ;; We must refill the cache. `file-truename' does it.
3679 (with-parsed-tramp-file-name
3680 (file-truename tramp-test-temporary-file-directory
) nil
3681 (string-match "^HP-UX" (tramp-get-connection-property v
"uname" ""))))
3683 (defun tramp--test-rsync-p ()
3684 "Check, whether the rsync method is used.
3685 This does not support special file names."
3687 "rsync" (file-remote-p tramp-test-temporary-file-directory
'method
)))
3689 (defun tramp--test-sh-p ()
3690 "Check, whether the remote host runs a based method from tramp-sh.el."
3692 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory
)
3693 'tramp-sh-file-name-handler
))
3695 (defun tramp--test-windows-nt-and-batch ()
3696 "Check, whether the locale host runs MS Windows in batch mode.
3697 This does not support special characters."
3698 (and (eq system-type
'windows-nt
) noninteractive
))
3700 (defun tramp--test-windows-nt-and-pscp-psftp-p ()
3701 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
3702 This does not support utf8 based file transfer."
3703 (and (eq system-type
'windows-nt
)
3705 (regexp-opt '("pscp" "psftp"))
3706 (file-remote-p tramp-test-temporary-file-directory
'method
))))
3708 (defun tramp--test-windows-nt-or-smb-p ()
3709 "Check, whether the locale or remote host runs MS Windows.
3710 This requires restrictions of file name syntax."
3711 (or (eq system-type
'windows-nt
)
3712 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)))
3714 (defun tramp--test-check-files (&rest files
)
3715 "Run a simple but comprehensive test over every file in FILES."
3716 ;; TODO: The quoted case does not work.
3717 ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3719 ;; We must use `file-truename' for the temporary directory,
3720 ;; because it could be located on a symlinked directory. This
3721 ;; would let the test fail.
3722 (let* ((tramp-test-temporary-file-directory
3723 (file-truename tramp-test-temporary-file-directory
))
3724 (tmp-name1 (tramp--test-make-temp-name nil quoted
))
3725 (tmp-name2 (tramp--test-make-temp-name 'local quoted
))
3726 (files (delq nil files
))
3727 (process-environment process-environment
))
3730 (make-directory tmp-name1
)
3731 (make-directory tmp-name2
)
3734 (let* ((file1 (expand-file-name elt tmp-name1
))
3735 (file2 (expand-file-name elt tmp-name2
))
3736 (file3 (expand-file-name (concat elt
"foo") tmp-name1
)))
3737 (write-region elt nil file1
)
3738 (should (file-exists-p file1
))
3740 ;; Check file contents.
3742 (insert-file-contents file1
)
3743 (should (string-equal (buffer-string) elt
)))
3745 ;; Copy file both directions.
3746 (copy-file file1
(file-name-as-directory tmp-name2
))
3747 (should (file-exists-p file2
))
3749 (should-not (file-exists-p file1
))
3750 (copy-file file2
(file-name-as-directory tmp-name1
))
3751 (should (file-exists-p file1
))
3753 (tramp--test-ignore-make-symbolic-link-error
3754 (make-symbolic-link file1 file3
)
3755 (should (file-symlink-p file3
))
3758 (expand-file-name file1
) (file-truename file3
)))
3762 (if quoted
'tramp-compat-file-name-quote
'identity
)
3763 (car (file-attributes file3
)))
3764 (file-remote-p (file-truename file1
) 'localname
)))
3765 ;; Check file contents.
3767 (insert-file-contents file3
)
3768 (should (string-equal (buffer-string) elt
)))
3769 (delete-file file3
))))
3771 ;; Check file names.
3772 (should (equal (directory-files
3773 tmp-name1 nil directory-files-no-dot-files-regexp
)
3774 (sort (copy-sequence files
) 'string-lessp
)))
3775 (should (equal (directory-files
3776 tmp-name2 nil directory-files-no-dot-files-regexp
)
3777 (sort (copy-sequence files
) 'string-lessp
)))
3779 ;; `substitute-in-file-name' could return different
3780 ;; values. For `adb', there could be strange file
3781 ;; permissions preventing overwriting a file. We don't
3782 ;; care in this testcase.
3785 (substitute-in-file-name (expand-file-name elt tmp-name1
)))
3787 (substitute-in-file-name
3788 (expand-file-name elt tmp-name2
))))
3789 (ignore-errors (write-region elt nil file1
))
3790 (should (file-exists-p file1
))
3791 (ignore-errors (write-region elt nil file2 nil
'nomessage
))
3792 (should (file-exists-p file2
))))
3794 (should (equal (directory-files
3795 tmp-name1 nil directory-files-no-dot-files-regexp
)
3797 tmp-name2 nil directory-files-no-dot-files-regexp
)))
3799 ;; Check directory creation. We use a subdirectory "foo"
3800 ;; in order to avoid conflicts with previous file name tests.
3802 (let* ((elt1 (concat elt
"foo"))
3803 (file1 (expand-file-name (concat "foo/" elt
) tmp-name1
))
3804 (file2 (expand-file-name elt file1
))
3805 (file3 (expand-file-name elt1 file1
)))
3806 (make-directory file1
'parents
)
3807 (should (file-directory-p file1
))
3808 (write-region elt nil file2
)
3809 (should (file-exists-p file2
))
3813 file1 nil directory-files-no-dot-files-regexp
)
3817 (caar (directory-files-and-attributes
3818 file1 nil directory-files-no-dot-files-regexp
))
3821 ;; Check symlink in `directory-files-and-attributes'.
3822 ;; It does not work in the "smb" case, only relative
3823 ;; symlinks to existing files are shown there.
3824 (tramp--test-ignore-make-symbolic-link-error
3826 (tramp-smb-file-name-p tramp-test-temporary-file-directory
)
3827 (make-symbolic-link file2 file3
)
3828 (should (file-symlink-p file3
))
3831 (caar (directory-files-and-attributes
3832 file1 nil
(regexp-quote elt1
)))
3837 (if quoted
'tramp-compat-file-name-quote
'identity
)
3838 (cadr (car (directory-files-and-attributes
3839 file1 nil
(regexp-quote elt1
)))))
3840 (file-remote-p (file-truename file2
) 'localname
)))
3842 (should-not (file-exists-p file3
))))
3845 (should-not (file-exists-p file2
))
3846 (delete-directory file1
)
3847 (should-not (file-exists-p file1
))))
3849 ;; Check, that environment variables are set correctly.
3850 (when (and tramp--test-expensive-test
(tramp--test-sh-p))
3852 (let ((envvar (concat "VAR_" (upcase (md5 elt
))))
3853 (default-directory tramp-test-temporary-file-directory
)
3854 (process-environment process-environment
))
3856 ;; The value of PS1 could confuse Tramp's detection
3857 ;; of process output. So we unset it temporarily.
3860 (should (zerop (process-file "env" nil t nil
)))
3861 (goto-char (point-min))
3866 (regexp-quote envvar
)
3867 (regexp-quote (getenv envvar
))))))))))
3870 (ignore-errors (delete-directory tmp-name1
'recursive
))
3871 (ignore-errors (delete-directory tmp-name2
'recursive
))))))
3873 (defun tramp--test-special-characters ()
3874 "Perform the test in `tramp-test35-special-characters*'."
3875 ;; Newlines, slashes and backslashes in file names are not
3876 ;; supported. So we don't test. And we don't test the tab
3877 ;; character on Windows or Cygwin, because the backslash is
3878 ;; interpreted as a path separator, preventing "\t" from being
3879 ;; expanded to <TAB>.
3880 (tramp--test-check-files
3881 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3883 (if (or (tramp--test-adb-p)
3884 (tramp--test-docker-p)
3885 (eq system-type
'cygwin
))
3892 (unless (or (tramp--test-ftp-p)
3893 (tramp--test-gvfs-p)
3894 (tramp--test-windows-nt-or-smb-p))
3896 (unless (or (tramp--test-ftp-p)
3897 (tramp--test-gvfs-p)
3898 (tramp--test-windows-nt-or-smb-p))
3900 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3904 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3907 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3910 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3913 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
3916 ;; These tests are inspired by Bug#17238.
3917 (ert-deftest tramp-test35-special-characters
()
3918 "Check special characters in file names."
3919 (skip-unless (tramp--test-enabled))
3920 (skip-unless (not (tramp--test-rsync-p)))
3921 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3923 (tramp--test-special-characters))
3925 (ert-deftest tramp-test35-special-characters-with-stat
()
3926 "Check special characters in file names.
3927 Use the `stat' command."
3928 :tags
'(:expensive-test
)
3929 (skip-unless (tramp--test-enabled))
3930 (skip-unless (tramp--test-sh-p))
3931 (skip-unless (not (tramp--test-rsync-p)))
3932 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3933 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3934 (skip-unless (tramp-get-remote-stat v
)))
3936 (let ((tramp-connection-properties
3938 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3940 tramp-connection-properties
)))
3941 (tramp--test-special-characters)))
3943 (ert-deftest tramp-test35-special-characters-with-perl
()
3944 "Check special characters in file names.
3945 Use the `perl' command."
3946 :tags
'(:expensive-test
)
3947 (skip-unless (tramp--test-enabled))
3948 (skip-unless (tramp--test-sh-p))
3949 (skip-unless (not (tramp--test-rsync-p)))
3950 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3951 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3952 (skip-unless (tramp-get-remote-perl v
)))
3954 (let ((tramp-connection-properties
3956 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3958 ;; See `tramp-sh-handle-file-truename'.
3959 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3961 tramp-connection-properties
)))
3962 (tramp--test-special-characters)))
3964 (ert-deftest tramp-test35-special-characters-with-ls
()
3965 "Check special characters in file names.
3966 Use the `ls' command."
3967 :tags
'(:expensive-test
)
3968 (skip-unless (tramp--test-enabled))
3969 (skip-unless (tramp--test-sh-p))
3970 (skip-unless (not (tramp--test-rsync-p)))
3971 (skip-unless (not (tramp--test-windows-nt-and-batch)))
3972 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3974 (let ((tramp-connection-properties
3976 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3978 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3980 ;; See `tramp-sh-handle-file-truename'.
3981 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
3983 tramp-connection-properties
)))
3984 (tramp--test-special-characters)))
3986 (defun tramp--test-utf8 ()
3987 "Perform the test in `tramp-test36-utf8*'."
3988 (let* ((utf8 (if (and (eq system-type
'darwin
)
3989 (memq 'utf-8-hfs
(coding-system-list)))
3991 (coding-system-for-read utf8
)
3992 (coding-system-for-write utf8
)
3993 (file-name-coding-system
3994 (coding-system-change-eol-conversion utf8
'unix
)))
3995 (tramp--test-check-files
3996 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
3997 (unless (tramp--test-hpux-p)
3998 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
4000 "Автостопом по гала́ктике")))
4002 (ert-deftest tramp-test36-utf8
()
4003 "Check UTF8 encoding in file names and file contents."
4004 (skip-unless (tramp--test-enabled))
4005 (skip-unless (not (tramp--test-docker-p)))
4006 (skip-unless (not (tramp--test-rsync-p)))
4007 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4008 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4012 (ert-deftest tramp-test36-utf8-with-stat
()
4013 "Check UTF8 encoding in file names and file contents.
4014 Use the `stat' command."
4015 :tags
'(:expensive-test
)
4016 (skip-unless (tramp--test-enabled))
4017 (skip-unless (tramp--test-sh-p))
4018 (skip-unless (not (tramp--test-docker-p)))
4019 (skip-unless (not (tramp--test-rsync-p)))
4020 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4021 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4022 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4023 (skip-unless (tramp-get-remote-stat v
)))
4025 (let ((tramp-connection-properties
4027 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4029 tramp-connection-properties
)))
4030 (tramp--test-utf8)))
4032 (ert-deftest tramp-test36-utf8-with-perl
()
4033 "Check UTF8 encoding in file names and file contents.
4034 Use the `perl' command."
4035 :tags
'(:expensive-test
)
4036 (skip-unless (tramp--test-enabled))
4037 (skip-unless (tramp--test-sh-p))
4038 (skip-unless (not (tramp--test-docker-p)))
4039 (skip-unless (not (tramp--test-rsync-p)))
4040 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4041 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4042 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
4043 (skip-unless (tramp-get-remote-perl v
)))
4045 (let ((tramp-connection-properties
4047 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4049 ;; See `tramp-sh-handle-file-truename'.
4050 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4052 tramp-connection-properties
)))
4053 (tramp--test-utf8)))
4055 (ert-deftest tramp-test36-utf8-with-ls
()
4056 "Check UTF8 encoding in file names and file contents.
4057 Use the `ls' command."
4058 :tags
'(:expensive-test
)
4059 (skip-unless (tramp--test-enabled))
4060 (skip-unless (tramp--test-sh-p))
4061 (skip-unless (not (tramp--test-docker-p)))
4062 (skip-unless (not (tramp--test-rsync-p)))
4063 (skip-unless (not (tramp--test-windows-nt-and-batch)))
4064 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
4066 (let ((tramp-connection-properties
4068 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4070 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4072 ;; See `tramp-sh-handle-file-truename'.
4073 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory
))
4075 tramp-connection-properties
)))
4076 (tramp--test-utf8)))
4078 (defun tramp--test-timeout-handler ()
4080 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
4082 ;; This test is inspired by Bug#16928.
4083 (ert-deftest tramp-test37-asynchronous-requests
()
4084 "Check parallel asynchronous requests.
4085 Such requests could arrive from timers, process filters and
4086 process sentinels. They shall not disturb each other."
4087 :tags
'(:expensive-test
)
4088 (skip-unless (tramp--test-enabled))
4089 (skip-unless (tramp--test-sh-p))
4091 ;; This test could be blocked on hydra. So we set a timeout of 300
4092 ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
4093 (with-timeout (300 (tramp--test-timeout-handler))
4094 (define-key special-event-map
[sigusr1] 'tramp--test-timeout-handler)
4095 (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
4096 (let* (;; For the watchdog.
4097 (default-directory (expand-file-name temporary-file-directory))
4100 "*watchdog*" nil shell-file-name shell-command-switch
4101 (format "sleep 300; kill -USR1 %d" (emacs-pid))))
4102 (tmp-name (tramp--test-make-temp-name))
4103 (default-directory tmp-name)
4104 ;; Do not cache Tramp properties.
4105 (remote-file-name-inhibit-cache t)
4106 (process-file-side-effects t)
4107 ;; Suppress nasty messages.
4109 ;; Do not run delayed timers.
4110 (timer-max-repeats 0)
4111 ;; Number of asynchronous processes for test.
4113 ;; On hydra, timings are bad.
4116 ((getenv "EMACS_HYDRA_CI") 10)
4118 ;; We must distinguish due to performance reasons.
4121 ((string-equal "mock" (file-remote-p tmp-name 'method))
4123 (t 'file-attributes)))
4124 timer buffers kill-buffer-query-functions)
4128 (make-directory tmp-name)
4130 ;; Setup a timer in order to raise an ordinary command
4131 ;; again and again. `vc-registered' is well suited,
4132 ;; because there are many checks.
4139 (let ((time (float-time))
4140 (default-directory tmp-name)
4142 (buffer-name (nth (random (length buffers)) buffers))))
4143 (tramp--test-message
4144 "Start timer %s %s" file (current-time-string))
4145 (funcall timer-operation file)
4146 ;; Adjust timer if it takes too much time.
4147 (when (> (- (float-time) time) timer-repeat)
4148 (setq timer-repeat (* 1.5 timer-repeat))
4149 (setf (timer--repeat-delay timer) timer-repeat)
4150 (tramp--test-message "Increase timer %s" timer-repeat))
4151 (tramp--test-message
4152 "Stop timer %s %s" file (current-time-string)))))))
4154 ;; Create temporary buffers. The number of buffers
4155 ;; corresponds to the number of processes; it could be
4156 ;; increased in order to make pressure on Tramp.
4157 (dotimes (_ number-proc)
4158 (setq buffers (cons (generate-new-buffer "foo") buffers)))
4160 ;; Open asynchronous processes. Set process filter and sentinel.
4161 (dolist (buf buffers)
4163 (sit-for 0.01 'nodisp)
4165 (start-file-process-shell-command
4166 (buffer-name buf) buf
4168 "(read line && echo $line >$line);"
4169 "(read line && cat $line);"
4170 "(read line && rm $line)")))
4171 (file (expand-file-name (buffer-name buf))))
4172 ;; Remember the file name. Add counter.
4173 (process-put proc 'foo file)
4174 (process-put proc 'bar 0)
4175 ;; Add process filter.
4178 (lambda (proc string)
4179 (with-current-buffer (process-buffer proc)
4181 (unless (zerop (length string))
4182 (should (file-attributes (process-get proc 'foo))))))
4183 ;; Add process sentinel.
4184 (set-process-sentinel
4186 (lambda (proc _state)
4187 (should-not (file-attributes (process-get proc 'foo)))))))
4189 ;; Send a string. Use a random order of the buffers. Mix
4190 ;; with regular operation.
4191 (let ((buffers (copy-sequence buffers)))
4194 (sit-for 0.01 'nodisp)
4195 (let* ((buf (nth (random (length buffers)) buffers))
4196 (proc (get-buffer-process buf))
4197 (file (process-get proc 'foo))
4198 (count (process-get proc 'bar)))
4199 (tramp--test-message
4200 "Start action %d %s %s" count buf (current-time-string))
4201 ;; Regular operation prior process action.
4203 (should-not (file-attributes file))
4204 (should (file-attributes file)))
4205 ;; Send string to process.
4206 (process-send-string proc (format "%s\n" (buffer-name buf)))
4207 (accept-process-output proc 0.1 nil 0)
4208 ;; Give the watchdog a chance.
4209 (read-event nil nil 0.01)
4210 ;; Regular operation post process action.
4212 (should-not (file-attributes file))
4213 (should (file-attributes file)))
4214 (tramp--test-message
4215 "Stop action %d %s %s" count buf (current-time-string))
4216 (process-put proc 'bar (1+ count))
4217 (unless (process-live-p proc)
4218 (setq buffers (delq buf buffers))))))
4220 ;; Checks. All process output shall exists in the
4221 ;; respective buffers. All created files shall be
4223 (tramp--test-message "Check %s" (current-time-string))
4224 (dolist (buf buffers)
4225 (with-current-buffer buf
4226 (should (string-equal (format "%s\n" buf) (buffer-string)))))
4229 tmp-name nil directory-files-no-dot-files-regexp)))
4232 (define-key special-event-map [sigusr1] 'ignore
)
4233 (ignore-errors (quit-process watchdog
))
4234 (dolist (buf buffers
)
4235 (ignore-errors (delete-process (get-buffer-process buf
)))
4236 (ignore-errors (kill-buffer buf
)))
4237 (ignore-errors (cancel-timer timer
))
4238 (ignore-errors (delete-directory tmp-name
'recursive
)))))))
4240 (ert-deftest tramp-test38-recursive-load
()
4241 "Check that Tramp does not fail due to recursive load."
4242 (skip-unless (tramp--test-enabled))
4244 (let ((default-directory (expand-file-name temporary-file-directory
)))
4248 "(expand-file-name %S)" tramp-test-temporary-file-directory
)
4250 "(let ((default-directory %S)) (expand-file-name %S))"
4251 tramp-test-temporary-file-directory
4252 temporary-file-directory
)))
4256 (shell-command-to-string
4258 "%s -batch -Q -L %s --eval %s"
4259 (expand-file-name invocation-name invocation-directory
)
4260 (mapconcat 'shell-quote-argument load-path
" -L ")
4261 (shell-quote-argument code
))))))))
4263 (ert-deftest tramp-test39-remote-load-path
()
4264 "Check that Tramp autoloads its packages with remote `load-path'."
4265 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
4266 ;; It shall still work, when a remote file name is in the
4268 (let ((default-directory (expand-file-name temporary-file-directory
))
4270 "(let ((force-load-messages t) \
4271 (load-path (cons \"/foo:bar:\" load-path))) \
4272 (tramp-cleanup-all-connections))"))
4278 "tramp-cmds" (file-name-directory (locate-library "tramp"))))
4279 (shell-command-to-string
4281 "%s -batch -Q -L %s -l tramp-sh --eval %s"
4282 (expand-file-name invocation-name invocation-directory
)
4283 (mapconcat 'shell-quote-argument load-path
" -L ")
4284 (shell-quote-argument code
)))))))
4286 (ert-deftest tramp-test40-unload
()
4287 "Check that Tramp and its subpackages unload completely.
4288 Since it unloads Tramp, it shall be the last test to run."
4289 :tags
'(:expensive-test
)
4290 (skip-unless noninteractive
)
4292 (when (featurep 'tramp
)
4293 (unload-feature 'tramp
'force
)
4294 ;; No Tramp feature must be left.
4295 (should-not (featurep 'tramp
))
4296 (should-not (all-completions "tramp" (delq 'tramp-tests features
)))
4297 ;; `file-name-handler-alist' must be clean.
4298 (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist
)))
4299 ;; There shouldn't be left a bound symbol, except buffer-local
4300 ;; variables, and autoload functions. We do not regard our test
4301 ;; symbols, and the Tramp unload hooks.
4304 (and (or (and (boundp x
) (null (local-variable-if-set-p x
)))
4305 (and (functionp x
) (null (autoloadp (symbol-function x
)))))
4306 (string-match "^tramp" (symbol-name x
))
4307 (not (string-match "^tramp--?test" (symbol-name x
)))
4308 (not (string-match "unload-hook$" (symbol-name x
)))
4309 (ert-fail (format "`%s' still bound" x
)))))
4310 ;; The defstruct `tramp-file-name' and all its internal functions
4312 (should-not (cl--find-class 'tramp-file-name
))
4316 (string-match "tramp-file-name" (symbol-name x
))
4317 (ert-fail (format "Structure function `%s' still exists" x
)))))
4318 ;; There shouldn't be left a hook function containing a Tramp
4319 ;; function. We do not regard the Tramp unload hooks.
4323 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x
))
4324 (not (string-match "unload-hook$" (symbol-name x
)))
4325 (consp (symbol-value x
))
4326 (ignore-errors (all-completions "tramp" (symbol-value x
)))
4327 (ert-fail (format "Hook `%s' still contains Tramp function" x
)))))))
4331 ;; * dired-compress-file
4334 ;; * file-name-case-insensitive-p
4335 ;; * file-selinux-context
4336 ;; * find-backup-file-name
4338 ;; * set-file-selinux-context
4340 ;; * Work on skipped tests. Make a comment, when it is impossible.
4341 ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
4342 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4343 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
4344 ;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'.
4346 (defun tramp-test-all (&optional interactive
)
4347 "Run all tests for \\[tramp]."
4350 (if interactive
'ert-run-tests-interactively
'ert-run-tests-batch
) "^tramp"))
4352 (provide 'tramp-tests
)
4353 ;;; tramp-tests.el ends here