Line data Source code
1 : ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 :
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.
11 : ;;
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.
16 : ;;
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/'.
19 :
20 : ;;; Commentary:
21 :
22 : ;; The tests require a recent ert.el from Emacs 24.4.
23 :
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.
29 :
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.
35 :
36 : ;; A whole test run can be performed calling the command `tramp-test-all'.
37 :
38 : ;;; Code:
39 :
40 : (require 'dired)
41 : (require 'ert)
42 : (require 'tramp)
43 : (require 'vc)
44 : (require 'vc-bzr)
45 : (require 'vc-git)
46 : (require 'vc-hg)
47 :
48 : (declare-function tramp-find-executable "tramp-sh")
49 : (declare-function tramp-get-remote-path "tramp-sh")
50 : (declare-function tramp-get-remote-stat "tramp-sh")
51 : (declare-function tramp-get-remote-perl "tramp-sh")
52 : (defvar auto-save-file-name-transforms)
53 : (defvar tramp-copy-size-limit)
54 : (defvar tramp-persistency-file-name)
55 : (defvar tramp-remote-process-environment)
56 : ;; Suppress nasty messages.
57 : (fset 'shell-command-sentinel 'ignore)
58 :
59 : ;; There is no default value on w32 systems, which could work out of the box.
60 : (defconst tramp-test-temporary-file-directory
61 : (cond
62 : ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
63 : ((eq system-type 'windows-nt) null-device)
64 : (t (add-to-list
65 : 'tramp-methods
66 : '("mock"
67 : (tramp-login-program "sh")
68 : (tramp-login-args (("-i")))
69 : (tramp-remote-shell "/bin/sh")
70 : (tramp-remote-shell-args ("-c"))
71 : (tramp-connection-timeout 10)))
72 : (add-to-list
73 : 'tramp-default-host-alist
74 : `("\\`mock\\'" nil ,(system-name)))
75 : ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
76 : ;; batch mode only, therefore.
77 : (unless (and (null noninteractive) (file-directory-p "~/"))
78 : (setenv "HOME" temporary-file-directory))
79 : (format "/mock::%s" temporary-file-directory)))
80 : "Temporary directory for Tramp tests.")
81 :
82 : (setq password-cache-expiry nil
83 : tramp-verbose 0
84 : tramp-cache-read-persistent-data t ;; For auth-sources.
85 : tramp-copy-size-limit nil
86 : tramp-message-show-message nil
87 : tramp-persistency-file-name nil)
88 :
89 : ;; This should happen on hydra only.
90 : (when (getenv "EMACS_HYDRA_CI")
91 : (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
92 :
93 : (defvar tramp--test-expensive-test
94 : (null
95 : (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
96 : "Whether expensive tests are run.")
97 :
98 : (defvar tramp--test-enabled-checked nil
99 : "Cached result of `tramp--test-enabled'.
100 : If the function did run, the value is a cons cell, the `cdr'
101 : being the result.")
102 :
103 : (defun tramp--test-enabled ()
104 : "Whether remote file access is enabled."
105 42 : (unless (consp tramp--test-enabled-checked)
106 0 : (setq
107 : tramp--test-enabled-checked
108 0 : (cons
109 0 : t (ignore-errors
110 0 : (and
111 0 : (file-remote-p tramp-test-temporary-file-directory)
112 0 : (file-directory-p tramp-test-temporary-file-directory)
113 42 : (file-writable-p tramp-test-temporary-file-directory))))))
114 :
115 42 : (when (cdr tramp--test-enabled-checked)
116 : ;; Cleanup connection.
117 42 : (ignore-errors
118 42 : (tramp-cleanup-connection
119 42 : (tramp-dissect-file-name tramp-test-temporary-file-directory)
120 42 : nil 'keep-password)))
121 :
122 : ;; Return result.
123 42 : (cdr tramp--test-enabled-checked))
124 :
125 : (defun tramp--test-make-temp-name (&optional local quoted)
126 : "Return a temporary file name for test.
127 : If LOCAL is non-nil, a local file name is returned.
128 : If QUOTED is non-nil, the local part of the file name is quoted.
129 : The temporary file is not created."
130 90 : (funcall
131 90 : (if quoted 'tramp-compat-file-name-quote 'identity)
132 90 : (expand-file-name
133 90 : (make-temp-name "tramp-test")
134 90 : (if local temporary-file-directory tramp-test-temporary-file-directory))))
135 :
136 : ;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
137 : (defvar tramp--test-instrument-test-case-p nil
138 : "Whether `tramp--test-instrument-test-case' run.
139 : This shall used dynamically bound only.")
140 :
141 : (defmacro tramp--test-instrument-test-case (verbose &rest body)
142 : "Run BODY with `tramp-verbose' equal VERBOSE.
143 : Print the the content of the Tramp debug buffer, if BODY does not
144 : eval properly in `should' or `should-not'. `should-error' is not
145 : handled properly. BODY shall not contain a timeout."
146 : (declare (indent 1) (debug (form body)))
147 3 : `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
148 : (tramp-message-show-message t)
149 : (tramp-debug-on-error t)
150 : (debug-ignored-errors
151 : (cons "^make-symbolic-link not supported$" debug-ignored-errors))
152 : inhibit-message)
153 : (unwind-protect
154 3 : (let ((tramp--test-instrument-test-case-p t)) ,@body)
155 : ;; Unwind forms.
156 : (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
157 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
158 : (with-current-buffer (tramp-get-connection-buffer v)
159 : (message "%s" (buffer-string)))
160 : (with-current-buffer (tramp-get-debug-buffer v)
161 3 : (message "%s" (buffer-string))))))))
162 :
163 : (defsubst tramp--test-message (fmt-string &rest arguments)
164 : "Emit a message into ERT *Messages*."
165 90 : (tramp--test-instrument-test-case 0
166 90 : (apply
167 : 'tramp-message
168 90 : (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
169 90 : fmt-string arguments)))
170 :
171 : (defsubst tramp--test-backtrace ()
172 : "Dump a backtrace into ERT *Messages*."
173 0 : (tramp--test-instrument-test-case 10
174 0 : (tramp-backtrace
175 0 : (tramp-dissect-file-name tramp-test-temporary-file-directory))))
176 :
177 : (ert-deftest tramp-test00-availability ()
178 : "Test availability of Tramp functions."
179 : :expected-result (if (tramp--test-enabled) :passed :failed)
180 1 : (tramp--test-message
181 1 : "Remote directory: `%s'" tramp-test-temporary-file-directory)
182 1 : (should (ignore-errors
183 1 : (and
184 1 : (file-remote-p tramp-test-temporary-file-directory)
185 1 : (file-directory-p tramp-test-temporary-file-directory)
186 1 : (file-writable-p tramp-test-temporary-file-directory)))))
187 :
188 : (ert-deftest tramp-test01-file-name-syntax ()
189 : "Check remote file name syntax."
190 : ;; Simple cases.
191 1 : (should (tramp-tramp-file-p "/method::"))
192 1 : (should (tramp-tramp-file-p "/method:host:"))
193 1 : (should (tramp-tramp-file-p "/method:user@:"))
194 1 : (should (tramp-tramp-file-p "/method:user@host:"))
195 1 : (should (tramp-tramp-file-p "/method:user@email@host:"))
196 :
197 : ;; Using a port.
198 1 : (should (tramp-tramp-file-p "/method:host#1234:"))
199 1 : (should (tramp-tramp-file-p "/method:user@host#1234:"))
200 :
201 : ;; Using an IPv4 address.
202 1 : (should (tramp-tramp-file-p "/method:1.2.3.4:"))
203 1 : (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
204 :
205 : ;; Using an IPv6 address.
206 1 : (should (tramp-tramp-file-p "/method:[::1]:"))
207 1 : (should (tramp-tramp-file-p "/method:user@[::1]:"))
208 :
209 : ;; Local file name part.
210 1 : (should (tramp-tramp-file-p "/method:::"))
211 1 : (should (tramp-tramp-file-p "/method::/:"))
212 1 : (should (tramp-tramp-file-p "/method::/path/to/file"))
213 1 : (should (tramp-tramp-file-p "/method::/:/path/to/file"))
214 1 : (should (tramp-tramp-file-p "/method::file"))
215 1 : (should (tramp-tramp-file-p "/method::/:file"))
216 :
217 : ;; Multihop.
218 1 : (should (tramp-tramp-file-p "/method1:|method2::"))
219 1 : (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
220 1 : (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
221 1 : (should (tramp-tramp-file-p
222 1 : "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
223 :
224 : ;; No strings.
225 1 : (should-not (tramp-tramp-file-p nil))
226 1 : (should-not (tramp-tramp-file-p 'symbol))
227 : ;; Ange-ftp syntax.
228 1 : (should-not (tramp-tramp-file-p "/host:"))
229 1 : (should-not (tramp-tramp-file-p "/user@host:"))
230 1 : (should-not (tramp-tramp-file-p "/1.2.3.4:"))
231 1 : (should-not (tramp-tramp-file-p "/[]:"))
232 1 : (should-not (tramp-tramp-file-p "/[::1]:"))
233 1 : (should-not (tramp-tramp-file-p "/host:/:"))
234 1 : (should-not (tramp-tramp-file-p "/host1|host2:"))
235 1 : (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
236 : ;; Quote with "/:" suppresses file name handlers.
237 1 : (should-not (tramp-tramp-file-p "/::"))
238 1 : (should-not (tramp-tramp-file-p "/:@:"))
239 1 : (should-not (tramp-tramp-file-p "/:[]:"))
240 : ;; Methods shall be at least two characters on MS Windows, except
241 : ;; the default method.
242 1 : (let ((system-type 'windows-nt))
243 1 : (should-not (tramp-tramp-file-p "/c:/path/to/file"))
244 1 : (should-not (tramp-tramp-file-p "/c::/path/to/file"))
245 1 : (should (tramp-tramp-file-p "/-::/path/to/file")))
246 1 : (let ((system-type 'gnu/linux))
247 1 : (should (tramp-tramp-file-p "/-:h:/path/to/file"))
248 1 : (should (tramp-tramp-file-p "/m::/path/to/file"))))
249 :
250 : (ert-deftest tramp-test01-file-name-syntax-simplified ()
251 : "Check simplified file name syntax."
252 : :tags '(:expensive-test)
253 1 : (let ((syntax tramp-syntax))
254 1 : (unwind-protect
255 1 : (progn
256 1 : (tramp-change-syntax 'simplified)
257 : ;; Simple cases.
258 1 : (should (tramp-tramp-file-p "/host:"))
259 1 : (should (tramp-tramp-file-p "/user@:"))
260 1 : (should (tramp-tramp-file-p "/user@host:"))
261 1 : (should (tramp-tramp-file-p "/user@email@host:"))
262 :
263 : ;; Using a port.
264 1 : (should (tramp-tramp-file-p "/host#1234:"))
265 1 : (should (tramp-tramp-file-p "/user@host#1234:"))
266 :
267 : ;; Using an IPv4 address.
268 1 : (should (tramp-tramp-file-p "/1.2.3.4:"))
269 1 : (should (tramp-tramp-file-p "/user@1.2.3.4:"))
270 :
271 : ;; Using an IPv6 address.
272 1 : (should (tramp-tramp-file-p "/[::1]:"))
273 1 : (should (tramp-tramp-file-p "/user@[::1]:"))
274 :
275 : ;; Local file name part.
276 1 : (should (tramp-tramp-file-p "/host::"))
277 1 : (should (tramp-tramp-file-p "/host:/:"))
278 1 : (should (tramp-tramp-file-p "/host:/path/to/file"))
279 1 : (should (tramp-tramp-file-p "/host:/:/path/to/file"))
280 1 : (should (tramp-tramp-file-p "/host:file"))
281 1 : (should (tramp-tramp-file-p "/host:/:file"))
282 :
283 : ;; Multihop.
284 1 : (should (tramp-tramp-file-p "/host1|host2:"))
285 1 : (should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
286 1 : (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
287 :
288 : ;; No strings.
289 1 : (should-not (tramp-tramp-file-p nil))
290 1 : (should-not (tramp-tramp-file-p 'symbol))
291 : ;; Quote with "/:" suppresses file name handlers.
292 1 : (should-not (tramp-tramp-file-p "/::"))
293 1 : (should-not (tramp-tramp-file-p "/:@:"))
294 1 : (should-not (tramp-tramp-file-p "/:[]:")))
295 :
296 : ;; Exit.
297 1 : (tramp-change-syntax syntax))))
298 :
299 : (ert-deftest tramp-test01-file-name-syntax-separate ()
300 : "Check separate file name syntax."
301 : :tags '(:expensive-test)
302 1 : (let ((syntax tramp-syntax))
303 1 : (unwind-protect
304 1 : (progn
305 1 : (tramp-change-syntax 'separate)
306 : ;; Simple cases.
307 1 : (should (tramp-tramp-file-p "/[method/]"))
308 1 : (should (tramp-tramp-file-p "/[method/host]"))
309 1 : (should (tramp-tramp-file-p "/[method/user@]"))
310 1 : (should (tramp-tramp-file-p "/[method/user@host]"))
311 1 : (should (tramp-tramp-file-p "/[method/user@email@host]"))
312 :
313 : ;; Using a port.
314 1 : (should (tramp-tramp-file-p "/[method/host#1234]"))
315 1 : (should (tramp-tramp-file-p "/[method/user@host#1234]"))
316 :
317 : ;; Using an IPv4 address.
318 1 : (should (tramp-tramp-file-p "/[method/1.2.3.4]"))
319 1 : (should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
320 :
321 : ;; Using an IPv6 address.
322 1 : (should (tramp-tramp-file-p "/[method/::1]"))
323 1 : (should (tramp-tramp-file-p "/[method/user@::1]"))
324 :
325 : ;; Local file name part.
326 1 : (should (tramp-tramp-file-p "/[method/]"))
327 1 : (should (tramp-tramp-file-p "/[method/]/:"))
328 1 : (should (tramp-tramp-file-p "/[method/]/path/to/file"))
329 1 : (should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
330 1 : (should (tramp-tramp-file-p "/[method/]file"))
331 1 : (should (tramp-tramp-file-p "/[method/]/:file"))
332 :
333 : ;; Multihop.
334 1 : (should (tramp-tramp-file-p "/[method1/|method2/]"))
335 1 : (should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
336 1 : (should
337 1 : (tramp-tramp-file-p
338 1 : "/[method1/user1@host1|method2/user2@host2]"))
339 1 : (should
340 1 : (tramp-tramp-file-p
341 1 : "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
342 :
343 : ;; No strings.
344 1 : (should-not (tramp-tramp-file-p nil))
345 1 : (should-not (tramp-tramp-file-p 'symbol))
346 : ;; Ange-ftp syntax.
347 1 : (should-not (tramp-tramp-file-p "/host:"))
348 1 : (should-not (tramp-tramp-file-p "/user@host:"))
349 1 : (should-not (tramp-tramp-file-p "/1.2.3.4:"))
350 1 : (should-not (tramp-tramp-file-p "/host:/:"))
351 1 : (should-not (tramp-tramp-file-p "/host1|host2:"))
352 1 : (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
353 : ;; Quote with "/:" suppresses file name handlers.
354 1 : (should-not (tramp-tramp-file-p "/:[]")))
355 :
356 : ;; Exit.
357 1 : (tramp-change-syntax syntax))))
358 :
359 : (ert-deftest tramp-test02-file-name-dissect ()
360 : "Check remote file name components."
361 1 : (let ((tramp-default-method "default-method")
362 : (tramp-default-user "default-user")
363 : (tramp-default-host "default-host"))
364 : ;; Expand `tramp-default-user' and `tramp-default-host'.
365 1 : (should (string-equal
366 1 : (file-remote-p "/method::")
367 1 : (format "/%s:%s@%s:" "method" "default-user" "default-host")))
368 1 : (should (string-equal (file-remote-p "/method::" 'method) "method"))
369 1 : (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
370 1 : (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
371 1 : (should (string-equal (file-remote-p "/method::" 'localname) ""))
372 1 : (should (string-equal (file-remote-p "/method::" 'hop) nil))
373 :
374 : ;; Expand `tramp-default-method' and `tramp-default-user'.
375 1 : (should (string-equal
376 1 : (file-remote-p "/-:host:")
377 1 : (format "/%s:%s@%s:" "default-method" "default-user" "host")))
378 1 : (should (string-equal (file-remote-p "/-:host:" 'method) "default-method"))
379 1 : (should (string-equal (file-remote-p "/-:host:" 'user) "default-user"))
380 1 : (should (string-equal (file-remote-p "/-:host:" 'host) "host"))
381 1 : (should (string-equal (file-remote-p "/-:host:" 'localname) ""))
382 1 : (should (string-equal (file-remote-p "/-:host:" 'hop) nil))
383 :
384 : ;; Expand `tramp-default-method' and `tramp-default-host'.
385 1 : (should (string-equal
386 1 : (file-remote-p "/-:user@:")
387 1 : (format "/%s:%s@%s:" "default-method" "user" "default-host")))
388 1 : (should (string-equal (file-remote-p "/-:user@:" 'method) "default-method"))
389 1 : (should (string-equal (file-remote-p "/-:user@:" 'user) "user"))
390 1 : (should (string-equal (file-remote-p "/-:user@:" 'host) "default-host"))
391 1 : (should (string-equal (file-remote-p "/-:user@:" 'localname) ""))
392 1 : (should (string-equal (file-remote-p "/-:user@:" 'hop) nil))
393 :
394 : ;; Expand `tramp-default-method'.
395 1 : (should (string-equal
396 1 : (file-remote-p "/-:user@host:")
397 1 : (format "/%s:%s@%s:" "default-method" "user" "host")))
398 1 : (should (string-equal
399 1 : (file-remote-p "/-:user@host:" 'method) "default-method"))
400 1 : (should (string-equal (file-remote-p "/-:user@host:" 'user) "user"))
401 1 : (should (string-equal (file-remote-p "/-:user@host:" 'host) "host"))
402 1 : (should (string-equal (file-remote-p "/-:user@host:" 'localname) ""))
403 1 : (should (string-equal (file-remote-p "/-:user@host:" 'hop) nil))
404 :
405 : ;; Expand `tramp-default-user'.
406 1 : (should (string-equal
407 1 : (file-remote-p "/method:host:")
408 1 : (format "/%s:%s@%s:" "method" "default-user" "host")))
409 1 : (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
410 1 : (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
411 1 : (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
412 1 : (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
413 1 : (should (string-equal (file-remote-p "/method:host:" 'hop) nil))
414 :
415 : ;; Expand `tramp-default-host'.
416 1 : (should (string-equal
417 1 : (file-remote-p "/method:user@:")
418 1 : (format "/%s:%s@%s:" "method" "user" "default-host")))
419 1 : (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
420 1 : (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
421 1 : (should (string-equal (file-remote-p "/method:user@:" 'host)
422 1 : "default-host"))
423 1 : (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
424 1 : (should (string-equal (file-remote-p "/method:user@:" 'hop) nil))
425 :
426 : ;; No expansion.
427 1 : (should (string-equal
428 1 : (file-remote-p "/method:user@host:")
429 1 : (format "/%s:%s@%s:" "method" "user" "host")))
430 1 : (should (string-equal
431 1 : (file-remote-p "/method:user@host:" 'method) "method"))
432 1 : (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
433 1 : (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
434 1 : (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
435 1 : (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil))
436 :
437 : ;; No expansion.
438 1 : (should (string-equal
439 1 : (file-remote-p "/method:user@email@host:")
440 1 : (format "/%s:%s@%s:" "method" "user@email" "host")))
441 1 : (should (string-equal
442 1 : (file-remote-p "/method:user@email@host:" 'method) "method"))
443 1 : (should (string-equal
444 1 : (file-remote-p "/method:user@email@host:" 'user) "user@email"))
445 1 : (should (string-equal
446 1 : (file-remote-p "/method:user@email@host:" 'host) "host"))
447 1 : (should (string-equal
448 1 : (file-remote-p "/method:user@email@host:" 'localname) ""))
449 1 : (should (string-equal
450 1 : (file-remote-p "/method:user@email@host:" 'hop) nil))
451 :
452 : ;; Expand `tramp-default-method' and `tramp-default-user'.
453 1 : (should (string-equal
454 1 : (file-remote-p "/-:host#1234:")
455 1 : (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
456 1 : (should (string-equal
457 1 : (file-remote-p "/-:host#1234:" 'method) "default-method"))
458 1 : (should (string-equal (file-remote-p "/-:host#1234:" 'user) "default-user"))
459 1 : (should (string-equal (file-remote-p "/-:host#1234:" 'host) "host#1234"))
460 1 : (should (string-equal (file-remote-p "/-:host#1234:" 'localname) ""))
461 1 : (should (string-equal (file-remote-p "/-:host#1234:" 'hop) nil))
462 :
463 : ;; Expand `tramp-default-method'.
464 1 : (should (string-equal
465 1 : (file-remote-p "/-:user@host#1234:")
466 1 : (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
467 1 : (should (string-equal
468 1 : (file-remote-p "/-:user@host#1234:" 'method) "default-method"))
469 1 : (should (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
470 1 : (should (string-equal (file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
471 1 : (should (string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
472 1 : (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
473 :
474 : ;; Expand `tramp-default-user'.
475 1 : (should (string-equal
476 1 : (file-remote-p "/method:host#1234:")
477 1 : (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
478 1 : (should (string-equal
479 1 : (file-remote-p "/method:host#1234:" 'method) "method"))
480 1 : (should (string-equal
481 1 : (file-remote-p "/method:host#1234:" 'user) "default-user"))
482 1 : (should (string-equal
483 1 : (file-remote-p "/method:host#1234:" 'host) "host#1234"))
484 1 : (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
485 1 : (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil))
486 :
487 : ;; No expansion.
488 1 : (should (string-equal
489 1 : (file-remote-p "/method:user@host#1234:")
490 1 : (format "/%s:%s@%s:" "method" "user" "host#1234")))
491 1 : (should (string-equal
492 1 : (file-remote-p "/method:user@host#1234:" 'method) "method"))
493 1 : (should (string-equal
494 1 : (file-remote-p "/method:user@host#1234:" 'user) "user"))
495 1 : (should (string-equal
496 1 : (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
497 1 : (should (string-equal
498 1 : (file-remote-p "/method:user@host#1234:" 'localname) ""))
499 1 : (should (string-equal
500 1 : (file-remote-p "/method:user@host#1234:" 'hop) nil))
501 :
502 : ;; Expand `tramp-default-method' and `tramp-default-user'.
503 1 : (should (string-equal
504 1 : (file-remote-p "/-:1.2.3.4:")
505 1 : (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
506 1 : (should (string-equal (file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
507 1 : (should (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
508 1 : (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
509 1 : (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
510 1 : (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop) nil))
511 :
512 : ;; Expand `tramp-default-method'.
513 1 : (should (string-equal
514 1 : (file-remote-p "/-:user@1.2.3.4:")
515 1 : (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
516 1 : (should (string-equal
517 1 : (file-remote-p "/-:user@1.2.3.4:" 'method) "default-method"))
518 1 : (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user) "user"))
519 1 : (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host) "1.2.3.4"))
520 1 : (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname) ""))
521 1 : (should (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop) nil))
522 :
523 : ;; Expand `tramp-default-user'.
524 1 : (should (string-equal
525 1 : (file-remote-p "/method:1.2.3.4:")
526 1 : (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
527 1 : (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
528 1 : (should (string-equal
529 1 : (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
530 1 : (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
531 1 : (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
532 1 : (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil))
533 :
534 : ;; No expansion.
535 1 : (should (string-equal
536 1 : (file-remote-p "/method:user@1.2.3.4:")
537 1 : (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
538 1 : (should (string-equal
539 1 : (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
540 1 : (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
541 1 : (should (string-equal
542 1 : (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
543 1 : (should (string-equal
544 1 : (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
545 1 : (should (string-equal
546 1 : (file-remote-p "/method:user@1.2.3.4:" 'hop) nil))
547 :
548 : ;; Expand `tramp-default-method', `tramp-default-user' and
549 : ;; `tramp-default-host'.
550 1 : (should (string-equal
551 1 : (file-remote-p "/-:[]:")
552 1 : (format
553 1 : "/%s:%s@%s:" "default-method" "default-user" "default-host")))
554 1 : (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
555 1 : (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
556 1 : (should (string-equal (file-remote-p "/-:[]:" 'host) "default-host"))
557 1 : (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
558 1 : (should (string-equal (file-remote-p "/-:[]:" 'hop) nil))
559 :
560 : ;; Expand `tramp-default-method' and `tramp-default-user'.
561 1 : (let ((tramp-default-host "::1"))
562 1 : (should (string-equal
563 1 : (file-remote-p "/-:[]:")
564 1 : (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
565 1 : (should (string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
566 1 : (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
567 1 : (should (string-equal (file-remote-p "/-:[]:" 'host) "::1"))
568 1 : (should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
569 1 : (should (string-equal (file-remote-p "/-:[]:" 'hop) nil)))
570 :
571 : ;; Expand `tramp-default-method' and `tramp-default-user'.
572 1 : (should (string-equal
573 1 : (file-remote-p "/-:[::1]:")
574 1 : (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
575 1 : (should (string-equal (file-remote-p "/-:[::1]:" 'method) "default-method"))
576 1 : (should (string-equal (file-remote-p "/-:[::1]:" 'user) "default-user"))
577 1 : (should (string-equal (file-remote-p "/-:[::1]:" 'host) "::1"))
578 1 : (should (string-equal (file-remote-p "/-:[::1]:" 'localname) ""))
579 1 : (should (string-equal (file-remote-p "/-:[::1]:" 'hop) nil))
580 :
581 : ;; Expand `tramp-default-method'.
582 1 : (should (string-equal
583 1 : (file-remote-p "/-:user@[::1]:")
584 1 : (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
585 1 : (should (string-equal
586 1 : (file-remote-p "/-:user@[::1]:" 'method) "default-method"))
587 1 : (should (string-equal (file-remote-p "/-:user@[::1]:" 'user) "user"))
588 1 : (should (string-equal (file-remote-p "/-:user@[::1]:" 'host) "::1"))
589 1 : (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname) ""))
590 1 : (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop) nil))
591 :
592 : ;; Expand `tramp-default-user'.
593 1 : (should (string-equal
594 1 : (file-remote-p "/method:[::1]:")
595 1 : (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
596 1 : (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
597 1 : (should (string-equal
598 1 : (file-remote-p "/method:[::1]:" 'user) "default-user"))
599 1 : (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
600 1 : (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
601 1 : (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
602 :
603 : ;; No expansion.
604 1 : (should (string-equal
605 1 : (file-remote-p "/method:user@[::1]:")
606 1 : (format "/%s:%s@%s:" "method" "user" "[::1]")))
607 1 : (should (string-equal
608 1 : (file-remote-p "/method:user@[::1]:" 'method) "method"))
609 1 : (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
610 1 : (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
611 1 : (should (string-equal
612 1 : (file-remote-p "/method:user@[::1]:" 'localname) ""))
613 1 : (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
614 :
615 : ;; Local file name part.
616 1 : (should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
617 1 : (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
618 1 : (should (string-equal (file-remote-p "/method:: " 'localname) " "))
619 1 : (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
620 1 : (should (string-equal
621 1 : (file-remote-p "/method::/path/to/file" 'localname)
622 1 : "/path/to/file"))
623 :
624 : ;; Multihop.
625 1 : (should
626 1 : (string-equal
627 1 : (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
628 1 : (format "/%s:%s@%s|%s:%s@%s:"
629 1 : "method1" "user1" "host1" "method2" "user2" "host2")))
630 1 : (should
631 1 : (string-equal
632 1 : (file-remote-p
633 1 : "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
634 1 : "method2"))
635 1 : (should
636 1 : (string-equal
637 1 : (file-remote-p
638 1 : "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
639 1 : "user2"))
640 1 : (should
641 1 : (string-equal
642 1 : (file-remote-p
643 1 : "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
644 1 : "host2"))
645 1 : (should
646 1 : (string-equal
647 1 : (file-remote-p
648 1 : "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
649 1 : "/path/to/file"))
650 1 : (should
651 1 : (string-equal
652 1 : (file-remote-p
653 1 : "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
654 1 : (format "%s:%s@%s|"
655 1 : "method1" "user1" "host1")))
656 :
657 1 : (should
658 1 : (string-equal
659 1 : (file-remote-p
660 1 : (concat
661 : "/method1:user1@host1"
662 : "|method2:user2@host2"
663 1 : "|method3:user3@host3:/path/to/file"))
664 1 : (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
665 : "method1" "user1" "host1"
666 : "method2" "user2" "host2"
667 1 : "method3" "user3" "host3")))
668 1 : (should
669 1 : (string-equal
670 1 : (file-remote-p
671 1 : (concat
672 : "/method1:user1@host1"
673 : "|method2:user2@host2"
674 1 : "|method3:user3@host3:/path/to/file")
675 1 : 'method)
676 1 : "method3"))
677 1 : (should
678 1 : (string-equal
679 1 : (file-remote-p
680 1 : (concat
681 : "/method1:user1@host1"
682 : "|method2:user2@host2"
683 1 : "|method3:user3@host3:/path/to/file")
684 1 : 'user)
685 1 : "user3"))
686 1 : (should
687 1 : (string-equal
688 1 : (file-remote-p
689 1 : (concat
690 : "/method1:user1@host1"
691 : "|method2:user2@host2"
692 1 : "|method3:user3@host3:/path/to/file")
693 1 : 'host)
694 1 : "host3"))
695 1 : (should
696 1 : (string-equal
697 1 : (file-remote-p
698 1 : (concat
699 : "/method1:user1@host1"
700 : "|method2:user2@host2"
701 1 : "|method3:user3@host3:/path/to/file")
702 1 : 'localname)
703 1 : "/path/to/file"))
704 1 : (should
705 1 : (string-equal
706 1 : (file-remote-p
707 1 : (concat
708 : "/method1:user1@host1"
709 : "|method2:user2@host2"
710 1 : "|method3:user3@host3:/path/to/file")
711 1 : 'hop)
712 1 : (format "%s:%s@%s|%s:%s@%s|"
713 1 : "method1" "user1" "host1" "method2" "user2" "host2")))))
714 :
715 : (ert-deftest tramp-test02-file-name-dissect-simplified ()
716 : "Check simplified file name components."
717 : :tags '(:expensive-test)
718 1 : (let ((tramp-default-method "default-method")
719 : (tramp-default-user "default-user")
720 : (tramp-default-host "default-host")
721 1 : (syntax tramp-syntax))
722 1 : (unwind-protect
723 1 : (progn
724 1 : (tramp-change-syntax 'simplified)
725 : ;; Expand `tramp-default-method' and `tramp-default-user'.
726 1 : (should (string-equal
727 1 : (file-remote-p "/host:")
728 1 : (format "/%s@%s:" "default-user" "host")))
729 1 : (should (string-equal
730 1 : (file-remote-p "/host:" 'method) "default-method"))
731 1 : (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
732 1 : (should (string-equal (file-remote-p "/host:" 'host) "host"))
733 1 : (should (string-equal (file-remote-p "/host:" 'localname) ""))
734 1 : (should (string-equal (file-remote-p "/host:" 'hop) nil))
735 :
736 : ;; Expand `tramp-default-method' and `tramp-default-host'.
737 1 : (should (string-equal
738 1 : (file-remote-p "/user@:")
739 1 : (format "/%s@%s:" "user" "default-host")))
740 1 : (should (string-equal
741 1 : (file-remote-p "/user@:" 'method) "default-method"))
742 1 : (should (string-equal (file-remote-p "/user@:" 'user) "user"))
743 1 : (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
744 1 : (should (string-equal (file-remote-p "/user@:" 'localname) ""))
745 1 : (should (string-equal (file-remote-p "/user@:" 'hop) nil))
746 :
747 : ;; Expand `tramp-default-method'.
748 1 : (should (string-equal
749 1 : (file-remote-p "/user@host:")
750 1 : (format "/%s@%s:" "user" "host")))
751 1 : (should (string-equal
752 1 : (file-remote-p "/user@host:" 'method) "default-method"))
753 1 : (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
754 1 : (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
755 1 : (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
756 1 : (should (string-equal (file-remote-p "/user@host:" 'hop) nil))
757 :
758 : ;; No expansion.
759 1 : (should (string-equal
760 1 : (file-remote-p "/user@email@host:")
761 1 : (format "/%s@%s:" "user@email" "host")))
762 1 : (should (string-equal
763 1 : (file-remote-p
764 1 : "/user@email@host:" 'method) "default-method"))
765 1 : (should (string-equal
766 1 : (file-remote-p "/user@email@host:" 'user) "user@email"))
767 1 : (should (string-equal
768 1 : (file-remote-p "/user@email@host:" 'host) "host"))
769 1 : (should (string-equal
770 1 : (file-remote-p "/user@email@host:" 'localname) ""))
771 1 : (should (string-equal
772 1 : (file-remote-p "/user@email@host:" 'hop) nil))
773 :
774 : ;; Expand `tramp-default-method' and `tramp-default-user'.
775 1 : (should (string-equal
776 1 : (file-remote-p "/host#1234:")
777 1 : (format "/%s@%s:" "default-user" "host#1234")))
778 1 : (should (string-equal
779 1 : (file-remote-p "/host#1234:" 'method) "default-method"))
780 1 : (should (string-equal
781 1 : (file-remote-p "/host#1234:" 'user) "default-user"))
782 1 : (should (string-equal
783 1 : (file-remote-p "/host#1234:" 'host) "host#1234"))
784 1 : (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
785 1 : (should (string-equal (file-remote-p "/host#1234:" 'hop) nil))
786 :
787 : ;; Expand `tramp-default-method'.
788 1 : (should (string-equal
789 1 : (file-remote-p "/user@host#1234:")
790 1 : (format "/%s@%s:" "user" "host#1234")))
791 1 : (should (string-equal
792 1 : (file-remote-p "/user@host#1234:" 'method) "default-method"))
793 1 : (should (string-equal
794 1 : (file-remote-p "/user@host#1234:" 'user) "user"))
795 1 : (should (string-equal
796 1 : (file-remote-p "/user@host#1234:" 'host) "host#1234"))
797 1 : (should (string-equal
798 1 : (file-remote-p "/user@host#1234:" 'localname) ""))
799 1 : (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil))
800 :
801 : ;; Expand `tramp-default-method' and `tramp-default-user'.
802 1 : (should (string-equal
803 1 : (file-remote-p "/1.2.3.4:")
804 1 : (format "/%s@%s:" "default-user" "1.2.3.4")))
805 1 : (should (string-equal
806 1 : (file-remote-p "/1.2.3.4:" 'method) "default-method"))
807 1 : (should (string-equal
808 1 : (file-remote-p "/1.2.3.4:" 'user) "default-user"))
809 1 : (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
810 1 : (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
811 1 : (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil))
812 :
813 : ;; Expand `tramp-default-method'.
814 1 : (should (string-equal
815 1 : (file-remote-p "/user@1.2.3.4:")
816 1 : (format "/%s@%s:" "user" "1.2.3.4")))
817 1 : (should (string-equal
818 1 : (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
819 1 : (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
820 1 : (should (string-equal
821 1 : (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
822 1 : (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
823 1 : (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil))
824 :
825 : ;; Expand `tramp-default-method', `tramp-default-user' and
826 : ;; `tramp-default-host'.
827 1 : (should (string-equal
828 1 : (file-remote-p "/[]:")
829 1 : (format
830 1 : "/%s@%s:" "default-user" "default-host")))
831 1 : (should (string-equal
832 1 : (file-remote-p "/[]:" 'method) "default-method"))
833 1 : (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
834 1 : (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
835 1 : (should (string-equal (file-remote-p "/[]:" 'localname) ""))
836 1 : (should (string-equal (file-remote-p "/[]:" 'hop) nil))
837 :
838 : ;; Expand `tramp-default-method' and `tramp-default-user'.
839 1 : (let ((tramp-default-host "::1"))
840 1 : (should (string-equal
841 1 : (file-remote-p "/[]:")
842 1 : (format "/%s@%s:" "default-user" "[::1]")))
843 1 : (should (string-equal
844 1 : (file-remote-p "/[]:" 'method) "default-method"))
845 1 : (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
846 1 : (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
847 1 : (should (string-equal (file-remote-p "/[]:" 'localname) ""))
848 1 : (should (string-equal (file-remote-p "/[]:" 'hop) nil)))
849 :
850 : ;; Expand `tramp-default-method' and `tramp-default-user'.
851 1 : (should (string-equal
852 1 : (file-remote-p "/[::1]:")
853 1 : (format "/%s@%s:" "default-user" "[::1]")))
854 1 : (should (string-equal
855 1 : (file-remote-p "/[::1]:" 'method) "default-method"))
856 1 : (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
857 1 : (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
858 1 : (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
859 1 : (should (string-equal (file-remote-p "/[::1]:" 'hop) nil))
860 :
861 : ;; Expand `tramp-default-method'.
862 1 : (should (string-equal
863 1 : (file-remote-p "/user@[::1]:")
864 1 : (format "/%s@%s:" "user" "[::1]")))
865 1 : (should (string-equal
866 1 : (file-remote-p "/user@[::1]:" 'method) "default-method"))
867 1 : (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
868 1 : (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
869 1 : (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
870 1 : (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
871 :
872 : ;; Local file name part.
873 1 : (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
874 1 : (should (string-equal (file-remote-p "/host::" 'localname) ":"))
875 1 : (should (string-equal (file-remote-p "/host: " 'localname) " "))
876 1 : (should (string-equal (file-remote-p "/host:file" 'localname) "file"))
877 1 : (should (string-equal
878 1 : (file-remote-p "/host:/path/to/file" 'localname)
879 1 : "/path/to/file"))
880 :
881 : ;; Multihop.
882 1 : (should
883 1 : (string-equal
884 1 : (file-remote-p "/user1@host1|user2@host2:/path/to/file")
885 1 : (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
886 1 : (should
887 1 : (string-equal
888 1 : (file-remote-p
889 1 : "/user1@host1|user2@host2:/path/to/file" 'method)
890 1 : "default-method"))
891 1 : (should
892 1 : (string-equal
893 1 : (file-remote-p
894 1 : "/user1@host1|user2@host2:/path/to/file" 'user)
895 1 : "user2"))
896 1 : (should
897 1 : (string-equal
898 1 : (file-remote-p
899 1 : "/user1@host1|user2@host2:/path/to/file" 'host)
900 1 : "host2"))
901 1 : (should
902 1 : (string-equal
903 1 : (file-remote-p
904 1 : "/user1@host1|user2@host2:/path/to/file" 'localname)
905 1 : "/path/to/file"))
906 1 : (should
907 1 : (string-equal
908 1 : (file-remote-p
909 1 : "/user1@host1|user2@host2:/path/to/file" 'hop)
910 1 : (format "%s@%s|" "user1" "host1")))
911 :
912 1 : (should
913 1 : (string-equal
914 1 : (file-remote-p
915 1 : (concat
916 : "/user1@host1"
917 : "|user2@host2"
918 1 : "|user3@host3:/path/to/file"))
919 1 : (format "/%s@%s|%s@%s|%s@%s:"
920 : "user1" "host1"
921 : "user2" "host2"
922 1 : "user3" "host3")))
923 1 : (should
924 1 : (string-equal
925 1 : (file-remote-p
926 1 : (concat
927 : "/user1@host1"
928 : "|user2@host2"
929 1 : "|user3@host3:/path/to/file")
930 1 : 'method)
931 1 : "default-method"))
932 1 : (should
933 1 : (string-equal
934 1 : (file-remote-p
935 1 : (concat
936 : "/user1@host1"
937 : "|user2@host2"
938 1 : "|user3@host3:/path/to/file")
939 1 : 'user)
940 1 : "user3"))
941 1 : (should
942 1 : (string-equal
943 1 : (file-remote-p
944 1 : (concat
945 : "/user1@host1"
946 : "|user2@host2"
947 1 : "|user3@host3:/path/to/file")
948 1 : 'host)
949 1 : "host3"))
950 1 : (should
951 1 : (string-equal
952 1 : (file-remote-p
953 1 : (concat
954 : "/user1@host1"
955 : "|user2@host2"
956 1 : "|user3@host3:/path/to/file")
957 1 : 'localname)
958 1 : "/path/to/file"))
959 1 : (should
960 1 : (string-equal
961 1 : (file-remote-p
962 1 : (concat
963 : "/user1@host1"
964 : "|user2@host2"
965 1 : "|user3@host3:/path/to/file")
966 1 : 'hop)
967 1 : (format "%s@%s|%s@%s|"
968 1 : "user1" "host1" "user2" "host2"))))
969 :
970 : ;; Exit.
971 1 : (tramp-change-syntax syntax))))
972 :
973 : (ert-deftest tramp-test02-file-name-dissect-separate ()
974 : "Check separate file name components."
975 : :tags '(:expensive-test)
976 1 : (let ((tramp-default-method "default-method")
977 : (tramp-default-user "default-user")
978 : (tramp-default-host "default-host")
979 1 : (syntax tramp-syntax))
980 1 : (unwind-protect
981 1 : (progn
982 1 : (tramp-change-syntax 'separate)
983 : ;; Expand `tramp-default-user' and `tramp-default-host'.
984 1 : (should (string-equal
985 1 : (file-remote-p "/[method/]")
986 1 : (format
987 1 : "/[%s/%s@%s]" "method" "default-user" "default-host")))
988 1 : (should (string-equal (file-remote-p "/[method/]" 'method) "method"))
989 1 : (should (string-equal
990 1 : (file-remote-p "/[method/]" 'user) "default-user"))
991 1 : (should (string-equal
992 1 : (file-remote-p "/[method/]" 'host) "default-host"))
993 1 : (should (string-equal (file-remote-p "/[method/]" 'localname) ""))
994 1 : (should (string-equal (file-remote-p "/[method/]" 'hop) nil))
995 :
996 : ;; Expand `tramp-default-method' and `tramp-default-user'.
997 1 : (should (string-equal
998 1 : (file-remote-p "/[/host]")
999 1 : (format
1000 1 : "/[%s/%s@%s]" "default-method" "default-user" "host")))
1001 1 : (should (string-equal
1002 1 : (file-remote-p "/[/host]" 'method) "default-method"))
1003 1 : (should (string-equal
1004 1 : (file-remote-p "/[/host]" 'user) "default-user"))
1005 1 : (should (string-equal (file-remote-p "/[/host]" 'host) "host"))
1006 1 : (should (string-equal (file-remote-p "/[/host]" 'localname) ""))
1007 1 : (should (string-equal (file-remote-p "/[/host]" 'hop) nil))
1008 :
1009 : ;; Expand `tramp-default-method' and `tramp-default-host'.
1010 1 : (should (string-equal
1011 1 : (file-remote-p "/[/user@]")
1012 1 : (format
1013 1 : "/[%s/%s@%s]" "default-method" "user" "default-host")))
1014 1 : (should (string-equal
1015 1 : (file-remote-p "/[/user@]" 'method) "default-method"))
1016 1 : (should (string-equal (file-remote-p "/[/user@]" 'user) "user"))
1017 1 : (should (string-equal
1018 1 : (file-remote-p "/[/user@]" 'host) "default-host"))
1019 1 : (should (string-equal (file-remote-p "/[/user@]" 'localname) ""))
1020 1 : (should (string-equal (file-remote-p "/[/user@]" 'hop) nil))
1021 :
1022 : ;; Expand `tramp-default-method'.
1023 1 : (should (string-equal
1024 1 : (file-remote-p "/[/user@host]")
1025 1 : (format "/[%s/%s@%s]" "default-method" "user" "host")))
1026 1 : (should (string-equal
1027 1 : (file-remote-p "/[/user@host]" 'method) "default-method"))
1028 1 : (should (string-equal (file-remote-p "/[/user@host]" 'user) "user"))
1029 1 : (should (string-equal (file-remote-p "/[/user@host]" 'host) "host"))
1030 1 : (should (string-equal (file-remote-p "/[/user@host]" 'localname) ""))
1031 1 : (should (string-equal (file-remote-p "/[/user@host]" 'hop) nil))
1032 :
1033 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1034 1 : (should (string-equal
1035 1 : (file-remote-p "/[-/host]")
1036 1 : (format
1037 1 : "/[%s/%s@%s]" "default-method" "default-user" "host")))
1038 1 : (should (string-equal
1039 1 : (file-remote-p "/[-/host]" 'method) "default-method"))
1040 1 : (should (string-equal
1041 1 : (file-remote-p "/[-/host]" 'user) "default-user"))
1042 1 : (should (string-equal (file-remote-p "/[-/host]" 'host) "host"))
1043 1 : (should (string-equal (file-remote-p "/[-/host]" 'localname) ""))
1044 1 : (should (string-equal (file-remote-p "/[-/host]" 'hop) nil))
1045 :
1046 : ;; Expand `tramp-default-method' and `tramp-default-host'.
1047 1 : (should (string-equal
1048 1 : (file-remote-p "/[-/user@]")
1049 1 : (format
1050 1 : "/[%s/%s@%s]" "default-method" "user" "default-host")))
1051 1 : (should (string-equal
1052 1 : (file-remote-p "/[-/user@]" 'method) "default-method"))
1053 1 : (should (string-equal (file-remote-p "/[-/user@]" 'user) "user"))
1054 1 : (should (string-equal
1055 1 : (file-remote-p "/[-/user@]" 'host) "default-host"))
1056 1 : (should (string-equal (file-remote-p "/[-/user@]" 'localname) ""))
1057 1 : (should (string-equal (file-remote-p "/[-/user@]" 'hop) nil))
1058 :
1059 : ;; Expand `tramp-default-method'.
1060 1 : (should (string-equal
1061 1 : (file-remote-p "/[-/user@host]")
1062 1 : (format "/[%s/%s@%s]" "default-method" "user" "host")))
1063 1 : (should (string-equal
1064 1 : (file-remote-p "/[-/user@host]" 'method) "default-method"))
1065 1 : (should (string-equal (file-remote-p "/[-/user@host]" 'user) "user"))
1066 1 : (should (string-equal (file-remote-p "/[-/user@host]" 'host) "host"))
1067 1 : (should (string-equal (file-remote-p "/[-/user@host]" 'localname) ""))
1068 1 : (should (string-equal (file-remote-p "/[-/user@host]" 'hop) nil))
1069 :
1070 : ;; Expand `tramp-default-user'.
1071 1 : (should (string-equal
1072 1 : (file-remote-p "/[method/host]")
1073 1 : (format "/[%s/%s@%s]" "method" "default-user" "host")))
1074 1 : (should (string-equal
1075 1 : (file-remote-p "/[method/host]" 'method) "method"))
1076 1 : (should (string-equal
1077 1 : (file-remote-p "/[method/host]" 'user) "default-user"))
1078 1 : (should (string-equal (file-remote-p "/[method/host]" 'host) "host"))
1079 1 : (should (string-equal (file-remote-p "/[method/host]" 'localname) ""))
1080 1 : (should (string-equal (file-remote-p "/[method/host]" 'hop) nil))
1081 :
1082 : ;; Expand `tramp-default-host'.
1083 1 : (should (string-equal
1084 1 : (file-remote-p "/[method/user@]")
1085 1 : (format "/[%s/%s@%s]" "method" "user" "default-host")))
1086 1 : (should (string-equal
1087 1 : (file-remote-p "/[method/user@]" 'method) "method"))
1088 1 : (should (string-equal (file-remote-p "/[method/user@]" 'user) "user"))
1089 1 : (should (string-equal
1090 1 : (file-remote-p "/[method/user@]" 'host) "default-host"))
1091 1 : (should (string-equal
1092 1 : (file-remote-p "/[method/user@]" 'localname) ""))
1093 1 : (should (string-equal (file-remote-p "/[method/user@]" 'hop) nil))
1094 :
1095 : ;; No expansion.
1096 1 : (should (string-equal
1097 1 : (file-remote-p "/[method/user@host]")
1098 1 : (format "/[%s/%s@%s]" "method" "user" "host")))
1099 1 : (should (string-equal
1100 1 : (file-remote-p "/[method/user@host]" 'method) "method"))
1101 1 : (should (string-equal
1102 1 : (file-remote-p "/[method/user@host]" 'user) "user"))
1103 1 : (should (string-equal
1104 1 : (file-remote-p "/[method/user@host]" 'host) "host"))
1105 1 : (should (string-equal
1106 1 : (file-remote-p "/[method/user@host]" 'localname) ""))
1107 1 : (should (string-equal
1108 1 : (file-remote-p "/[method/user@host]" 'hop) nil))
1109 :
1110 : ;; No expansion.
1111 1 : (should (string-equal
1112 1 : (file-remote-p "/[method/user@email@host]")
1113 1 : (format "/[%s/%s@%s]" "method" "user@email" "host")))
1114 1 : (should (string-equal
1115 1 : (file-remote-p
1116 1 : "/[method/user@email@host]" 'method) "method"))
1117 1 : (should (string-equal
1118 1 : (file-remote-p
1119 1 : "/[method/user@email@host]" 'user) "user@email"))
1120 1 : (should (string-equal
1121 1 : (file-remote-p "/[method/user@email@host]" 'host) "host"))
1122 1 : (should (string-equal
1123 1 : (file-remote-p "/[method/user@email@host]" 'localname) ""))
1124 1 : (should (string-equal
1125 1 : (file-remote-p "/[method/user@email@host]" 'hop) nil))
1126 :
1127 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1128 1 : (should (string-equal
1129 1 : (file-remote-p "/[/host#1234]")
1130 1 : (format
1131 1 : "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1132 1 : (should (string-equal
1133 1 : (file-remote-p "/[/host#1234]" 'method) "default-method"))
1134 1 : (should (string-equal
1135 1 : (file-remote-p "/[/host#1234]" 'user) "default-user"))
1136 1 : (should (string-equal
1137 1 : (file-remote-p "/[/host#1234]" 'host) "host#1234"))
1138 1 : (should (string-equal (file-remote-p "/[/host#1234]" 'localname) ""))
1139 1 : (should (string-equal (file-remote-p "/[/host#1234]" 'hop) nil))
1140 :
1141 : ;; Expand `tramp-default-method'.
1142 1 : (should (string-equal
1143 1 : (file-remote-p "/[/user@host#1234]")
1144 1 : (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1145 1 : (should (string-equal
1146 1 : (file-remote-p
1147 1 : "/[/user@host#1234]" 'method) "default-method"))
1148 1 : (should (string-equal
1149 1 : (file-remote-p
1150 1 : "/[/user@host#1234]" 'user) "user"))
1151 1 : (should (string-equal
1152 1 : (file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
1153 1 : (should (string-equal
1154 1 : (file-remote-p "/[/user@host#1234]" 'localname) ""))
1155 1 : (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop) nil))
1156 :
1157 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1158 1 : (should (string-equal
1159 1 : (file-remote-p "/[-/host#1234]")
1160 1 : (format
1161 1 : "/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
1162 1 : (should (string-equal
1163 1 : (file-remote-p "/[-/host#1234]" 'method) "default-method"))
1164 1 : (should (string-equal
1165 1 : (file-remote-p "/[-/host#1234]" 'user) "default-user"))
1166 1 : (should (string-equal
1167 1 : (file-remote-p "/[-/host#1234]" 'host) "host#1234"))
1168 1 : (should (string-equal (file-remote-p "/[-/host#1234]" 'localname) ""))
1169 1 : (should (string-equal (file-remote-p "/[-/host#1234]" 'hop) nil))
1170 :
1171 : ;; Expand `tramp-default-method'.
1172 1 : (should (string-equal
1173 1 : (file-remote-p "/[-/user@host#1234]")
1174 1 : (format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
1175 1 : (should (string-equal
1176 1 : (file-remote-p
1177 1 : "/[-/user@host#1234]" 'method) "default-method"))
1178 1 : (should (string-equal
1179 1 : (file-remote-p
1180 1 : "/[-/user@host#1234]" 'user) "user"))
1181 1 : (should (string-equal
1182 1 : (file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
1183 1 : (should (string-equal
1184 1 : (file-remote-p "/[-/user@host#1234]" 'localname) ""))
1185 1 : (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop) nil))
1186 :
1187 : ;; Expand `tramp-default-user'.
1188 1 : (should (string-equal
1189 1 : (file-remote-p "/[method/host#1234]")
1190 1 : (format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
1191 1 : (should (string-equal
1192 1 : (file-remote-p "/[method/host#1234]" 'method) "method"))
1193 1 : (should (string-equal
1194 1 : (file-remote-p "/[method/host#1234]" 'user) "default-user"))
1195 1 : (should (string-equal
1196 1 : (file-remote-p "/[method/host#1234]" 'host) "host#1234"))
1197 1 : (should (string-equal
1198 1 : (file-remote-p "/[method/host#1234]" 'localname) ""))
1199 1 : (should (string-equal (file-remote-p "/[method/host#1234]" 'hop) nil))
1200 :
1201 : ;; No expansion.
1202 1 : (should (string-equal
1203 1 : (file-remote-p "/[method/user@host#1234]")
1204 1 : (format "/[%s/%s@%s]" "method" "user" "host#1234")))
1205 1 : (should (string-equal
1206 1 : (file-remote-p "/[method/user@host#1234]" 'method) "method"))
1207 1 : (should (string-equal
1208 1 : (file-remote-p "/[method/user@host#1234]" 'user) "user"))
1209 1 : (should (string-equal
1210 1 : (file-remote-p
1211 1 : "/[method/user@host#1234]" 'host) "host#1234"))
1212 1 : (should (string-equal
1213 1 : (file-remote-p "/[method/user@host#1234]" 'localname) ""))
1214 1 : (should (string-equal
1215 1 : (file-remote-p "/[method/user@host#1234]" 'hop) nil))
1216 :
1217 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1218 1 : (should (string-equal
1219 1 : (file-remote-p "/[/1.2.3.4]")
1220 1 : (format
1221 1 : "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1222 1 : (should (string-equal
1223 1 : (file-remote-p "/[/1.2.3.4]" 'method) "default-method"))
1224 1 : (should (string-equal
1225 1 : (file-remote-p "/[/1.2.3.4]" 'user) "default-user"))
1226 1 : (should (string-equal
1227 1 : (file-remote-p "/[/1.2.3.4]" 'host) "1.2.3.4"))
1228 1 : (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname) ""))
1229 1 : (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop) nil))
1230 :
1231 : ;; Expand `tramp-default-method'.
1232 1 : (should (string-equal
1233 1 : (file-remote-p "/[/user@1.2.3.4]")
1234 1 : (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1235 1 : (should (string-equal
1236 1 : (file-remote-p
1237 1 : "/[/user@1.2.3.4]" 'method) "default-method"))
1238 1 : (should (string-equal
1239 1 : (file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
1240 1 : (should (string-equal
1241 1 : (file-remote-p "/[/user@1.2.3.4]" 'host) "1.2.3.4"))
1242 1 : (should (string-equal
1243 1 : (file-remote-p "/[/user@1.2.3.4]" 'localname) ""))
1244 1 : (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop) nil))
1245 :
1246 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1247 1 : (should (string-equal
1248 1 : (file-remote-p "/[-/1.2.3.4]")
1249 1 : (format
1250 1 : "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
1251 1 : (should (string-equal
1252 1 : (file-remote-p "/[-/1.2.3.4]" 'method) "default-method"))
1253 1 : (should (string-equal
1254 1 : (file-remote-p "/[-/1.2.3.4]" 'user) "default-user"))
1255 1 : (should (string-equal
1256 1 : (file-remote-p "/[-/1.2.3.4]" 'host) "1.2.3.4"))
1257 1 : (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname) ""))
1258 1 : (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop) nil))
1259 :
1260 : ;; Expand `tramp-default-method'.
1261 1 : (should (string-equal
1262 1 : (file-remote-p "/[-/user@1.2.3.4]")
1263 1 : (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
1264 1 : (should (string-equal
1265 1 : (file-remote-p
1266 1 : "/[-/user@1.2.3.4]" 'method) "default-method"))
1267 1 : (should (string-equal
1268 1 : (file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
1269 1 : (should (string-equal
1270 1 : (file-remote-p "/[-/user@1.2.3.4]" 'host) "1.2.3.4"))
1271 1 : (should (string-equal
1272 1 : (file-remote-p "/[-/user@1.2.3.4]" 'localname) ""))
1273 1 : (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop) nil))
1274 :
1275 : ;; Expand `tramp-default-user'.
1276 1 : (should (string-equal
1277 1 : (file-remote-p "/[method/1.2.3.4]")
1278 1 : (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
1279 1 : (should (string-equal
1280 1 : (file-remote-p "/[method/1.2.3.4]" 'method) "method"))
1281 1 : (should (string-equal
1282 1 : (file-remote-p "/[method/1.2.3.4]" 'user) "default-user"))
1283 1 : (should (string-equal
1284 1 : (file-remote-p "/[method/1.2.3.4]" 'host) "1.2.3.4"))
1285 1 : (should (string-equal
1286 1 : (file-remote-p "/[method/1.2.3.4]" 'localname) ""))
1287 1 : (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop) nil))
1288 :
1289 : ;; No expansion.
1290 1 : (should (string-equal
1291 1 : (file-remote-p "/[method/user@1.2.3.4]")
1292 1 : (format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
1293 1 : (should (string-equal
1294 1 : (file-remote-p "/[method/user@1.2.3.4]" 'method) "method"))
1295 1 : (should (string-equal
1296 1 : (file-remote-p "/[method/user@1.2.3.4]" 'user) "user"))
1297 1 : (should (string-equal
1298 1 : (file-remote-p "/[method/user@1.2.3.4]" 'host) "1.2.3.4"))
1299 1 : (should (string-equal
1300 1 : (file-remote-p "/[method/user@1.2.3.4]" 'localname) ""))
1301 1 : (should (string-equal
1302 1 : (file-remote-p "/[method/user@1.2.3.4]" 'hop) nil))
1303 :
1304 : ;; Expand `tramp-default-method', `tramp-default-user' and
1305 : ;; `tramp-default-host'.
1306 1 : (should (string-equal
1307 1 : (file-remote-p "/[/]")
1308 1 : (format
1309 : "/[%s/%s@%s]"
1310 1 : "default-method" "default-user" "default-host")))
1311 1 : (should (string-equal
1312 1 : (file-remote-p "/[/]" 'method) "default-method"))
1313 1 : (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1314 1 : (should (string-equal (file-remote-p "/[/]" 'host) "default-host"))
1315 1 : (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1316 1 : (should (string-equal (file-remote-p "/[/]" 'hop) nil))
1317 :
1318 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1319 1 : (let ((tramp-default-host "::1"))
1320 1 : (should (string-equal
1321 1 : (file-remote-p "/[/]")
1322 1 : (format
1323 : "/[%s/%s@%s]"
1324 1 : "default-method" "default-user" "::1")))
1325 1 : (should (string-equal
1326 1 : (file-remote-p "/[/]" 'method) "default-method"))
1327 1 : (should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
1328 1 : (should (string-equal (file-remote-p "/[/]" 'host) "::1"))
1329 1 : (should (string-equal (file-remote-p "/[/]" 'localname) ""))
1330 1 : (should (string-equal (file-remote-p "/[/]" 'hop) nil)))
1331 :
1332 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1333 1 : (should (string-equal
1334 1 : (file-remote-p "/[/::1]")
1335 1 : (format
1336 1 : "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1337 1 : (should (string-equal
1338 1 : (file-remote-p "/[/::1]" 'method) "default-method"))
1339 1 : (should (string-equal
1340 1 : (file-remote-p "/[/::1]" 'user) "default-user"))
1341 1 : (should (string-equal (file-remote-p "/[/::1]" 'host) "::1"))
1342 1 : (should (string-equal (file-remote-p "/[/::1]" 'localname) ""))
1343 1 : (should (string-equal (file-remote-p "/[/::1]" 'hop) nil))
1344 :
1345 : ;; Expand `tramp-default-method'.
1346 1 : (should (string-equal
1347 1 : (file-remote-p "/[/user@::1]")
1348 1 : (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1349 1 : (should (string-equal
1350 1 : (file-remote-p "/[/user@::1]" 'method) "default-method"))
1351 1 : (should (string-equal (file-remote-p "/[/user@::1]" 'user) "user"))
1352 1 : (should (string-equal (file-remote-p "/[/user@::1]" 'host) "::1"))
1353 1 : (should (string-equal (file-remote-p "/[/user@::1]" 'localname) ""))
1354 1 : (should (string-equal (file-remote-p "/[/user@::1]" 'hop) nil))
1355 :
1356 : ;; Expand `tramp-default-method', `tramp-default-user' and
1357 : ;; `tramp-default-host'.
1358 1 : (should (string-equal
1359 1 : (file-remote-p "/[-/]")
1360 1 : (format
1361 : "/[%s/%s@%s]"
1362 1 : "default-method" "default-user" "default-host")))
1363 1 : (should (string-equal
1364 1 : (file-remote-p "/[-/]" 'method) "default-method"))
1365 1 : (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1366 1 : (should (string-equal (file-remote-p "/[-/]" 'host) "default-host"))
1367 1 : (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1368 1 : (should (string-equal (file-remote-p "/[-/]" 'hop) nil))
1369 :
1370 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1371 1 : (let ((tramp-default-host "::1"))
1372 1 : (should (string-equal
1373 1 : (file-remote-p "/[-/]")
1374 1 : (format
1375 : "/[%s/%s@%s]"
1376 1 : "default-method" "default-user" "::1")))
1377 1 : (should (string-equal
1378 1 : (file-remote-p "/[-/]" 'method) "default-method"))
1379 1 : (should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
1380 1 : (should (string-equal (file-remote-p "/[-/]" 'host) "::1"))
1381 1 : (should (string-equal (file-remote-p "/[-/]" 'localname) ""))
1382 1 : (should (string-equal (file-remote-p "/[-/]" 'hop) nil)))
1383 :
1384 : ;; Expand `tramp-default-method' and `tramp-default-user'.
1385 1 : (should (string-equal
1386 1 : (file-remote-p "/[-/::1]")
1387 1 : (format
1388 1 : "/[%s/%s@%s]" "default-method" "default-user" "::1")))
1389 1 : (should (string-equal
1390 1 : (file-remote-p "/[-/::1]" 'method) "default-method"))
1391 1 : (should (string-equal
1392 1 : (file-remote-p "/[-/::1]" 'user) "default-user"))
1393 1 : (should (string-equal (file-remote-p "/[-/::1]" 'host) "::1"))
1394 1 : (should (string-equal (file-remote-p "/[-/::1]" 'localname) ""))
1395 1 : (should (string-equal (file-remote-p "/[-/::1]" 'hop) nil))
1396 :
1397 : ;; Expand `tramp-default-method'.
1398 1 : (should (string-equal
1399 1 : (file-remote-p "/[-/user@::1]")
1400 1 : (format "/[%s/%s@%s]" "default-method" "user" "::1")))
1401 1 : (should (string-equal
1402 1 : (file-remote-p "/[-/user@::1]" 'method) "default-method"))
1403 1 : (should (string-equal (file-remote-p "/[-/user@::1]" 'user) "user"))
1404 1 : (should (string-equal (file-remote-p "/[-/user@::1]" 'host) "::1"))
1405 1 : (should (string-equal (file-remote-p "/[-/user@::1]" 'localname) ""))
1406 1 : (should (string-equal (file-remote-p "/[-/user@::1]" 'hop) nil))
1407 :
1408 : ;; Expand `tramp-default-user'.
1409 1 : (should (string-equal
1410 1 : (file-remote-p "/[method/::1]")
1411 1 : (format "/[%s/%s@%s]" "method" "default-user" "::1")))
1412 1 : (should (string-equal
1413 1 : (file-remote-p "/[method/::1]" 'method) "method"))
1414 1 : (should (string-equal
1415 1 : (file-remote-p "/[method/::1]" 'user) "default-user"))
1416 1 : (should (string-equal (file-remote-p "/[method/::1]" 'host) "::1"))
1417 1 : (should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
1418 1 : (should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
1419 :
1420 : ;; No expansion.
1421 1 : (should (string-equal
1422 1 : (file-remote-p "/[method/user@::1]")
1423 1 : (format "/[%s/%s@%s]" "method" "user" "::1")))
1424 1 : (should (string-equal
1425 1 : (file-remote-p "/[method/user@::1]" 'method) "method"))
1426 1 : (should (string-equal
1427 1 : (file-remote-p "/[method/user@::1]" 'user) "user"))
1428 1 : (should (string-equal
1429 1 : (file-remote-p "/[method/user@::1]" 'host) "::1"))
1430 1 : (should (string-equal
1431 1 : (file-remote-p "/[method/user@::1]" 'localname) ""))
1432 1 : (should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
1433 :
1434 : ;; Local file name part.
1435 1 : (should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
1436 1 : (should (string-equal (file-remote-p "/[-/host]/:" 'localname) "/:"))
1437 1 : (should (string-equal (file-remote-p "/[method/]:" 'localname) ":"))
1438 1 : (should (string-equal (file-remote-p "/[method/] " 'localname) " "))
1439 1 : (should (string-equal
1440 1 : (file-remote-p "/[method/]file" 'localname) "file"))
1441 1 : (should (string-equal
1442 1 : (file-remote-p "/[method/]/path/to/file" 'localname)
1443 1 : "/path/to/file"))
1444 :
1445 : ;; Multihop.
1446 1 : (should
1447 1 : (string-equal
1448 1 : (file-remote-p
1449 1 : "/[method1/user1@host1|method2/user2@host2]/path/to/file")
1450 1 : (format "/[%s/%s@%s|%s/%s@%s]"
1451 1 : "method1" "user1" "host1" "method2" "user2" "host2")))
1452 1 : (should
1453 1 : (string-equal
1454 1 : (file-remote-p
1455 1 : "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method)
1456 1 : "method2"))
1457 1 : (should
1458 1 : (string-equal
1459 1 : (file-remote-p
1460 1 : "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
1461 1 : "user2"))
1462 1 : (should
1463 1 : (string-equal
1464 1 : (file-remote-p
1465 1 : "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
1466 1 : "host2"))
1467 1 : (should
1468 1 : (string-equal
1469 1 : (file-remote-p
1470 : "/[method1/user1@host1|method2/user2@host2]/path/to/file"
1471 1 : 'localname)
1472 1 : "/path/to/file"))
1473 1 : (should
1474 1 : (string-equal
1475 1 : (file-remote-p
1476 1 : "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
1477 1 : (format "%s/%s@%s|"
1478 1 : "method1" "user1" "host1")))
1479 :
1480 1 : (should
1481 1 : (string-equal
1482 1 : (file-remote-p
1483 1 : (concat
1484 : "/[method1/user1@host1"
1485 : "|method2/user2@host2"
1486 1 : "|method3/user3@host3]/path/to/file"))
1487 1 : (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
1488 : "method1" "user1" "host1"
1489 : "method2" "user2" "host2"
1490 1 : "method3" "user3" "host3")))
1491 1 : (should
1492 1 : (string-equal
1493 1 : (file-remote-p
1494 1 : (concat
1495 : "/[method1/user1@host1"
1496 : "|method2/user2@host2"
1497 1 : "|method3/user3@host3]/path/to/file")
1498 1 : 'method)
1499 1 : "method3"))
1500 1 : (should
1501 1 : (string-equal
1502 1 : (file-remote-p
1503 1 : (concat
1504 : "/[method1/user1@host1"
1505 : "|method2/user2@host2"
1506 1 : "|method3/user3@host3]/path/to/file")
1507 1 : 'user)
1508 1 : "user3"))
1509 1 : (should
1510 1 : (string-equal
1511 1 : (file-remote-p
1512 1 : (concat
1513 : "/[method1/user1@host1"
1514 : "|method2/user2@host2"
1515 1 : "|method3/user3@host3]/path/to/file")
1516 1 : 'host)
1517 1 : "host3"))
1518 1 : (should
1519 1 : (string-equal
1520 1 : (file-remote-p
1521 1 : (concat
1522 : "/[method1/user1@host1"
1523 : "|method2/user2@host2"
1524 1 : "|method3/user3@host3]/path/to/file")
1525 1 : 'localname)
1526 1 : "/path/to/file"))
1527 1 : (should
1528 1 : (string-equal
1529 1 : (file-remote-p
1530 1 : (concat
1531 : "/[method1/user1@host1"
1532 : "|method2/user2@host2"
1533 1 : "|method3/user3@host3]/path/to/file")
1534 1 : 'hop)
1535 1 : (format "%s/%s@%s|%s/%s@%s|"
1536 1 : "method1" "user1" "host1" "method2" "user2" "host2"))))
1537 :
1538 : ;; Exit.
1539 1 : (tramp-change-syntax syntax))))
1540 :
1541 : (ert-deftest tramp-test03-file-name-defaults ()
1542 : "Check default values for some methods."
1543 : ;; Default values in tramp-adb.el.
1544 1 : (should (string-equal (file-remote-p "/adb::" 'host) ""))
1545 : ;; Default values in tramp-ftp.el.
1546 1 : (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
1547 1 : (dolist (u '("ftp" "anonymous"))
1548 2 : (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))
1549 : ;; Default values in tramp-gvfs.el.
1550 1 : (when (and (load "tramp-gvfs" 'noerror 'nomessage)
1551 1 : (symbol-value 'tramp-gvfs-enabled))
1552 1 : (should (string-equal (file-remote-p "/synce::" 'user) nil)))
1553 : ;; Default values in tramp-sh.el.
1554 1 : (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
1555 5 : (should
1556 5 : (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
1557 1 : (dolist (m '("su" "sudo" "ksu"))
1558 3 : (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
1559 1 : (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
1560 6 : (should
1561 6 : (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
1562 : ;; Default values in tramp-smb.el.
1563 1 : (should (string-equal (file-remote-p "/smb::" 'user) nil)))
1564 :
1565 : (ert-deftest tramp-test04-substitute-in-file-name ()
1566 : "Check `substitute-in-file-name'."
1567 1 : (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
1568 1 : (should
1569 1 : (string-equal
1570 1 : (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
1571 1 : (should
1572 1 : (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
1573 : ;; Quoting local part.
1574 1 : (should
1575 1 : (string-equal
1576 1 : (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
1577 1 : (should
1578 1 : (string-equal
1579 1 : (substitute-in-file-name "/method:host:/:/path//foo")
1580 1 : "/method:host:/:/path//foo"))
1581 1 : (should
1582 1 : (string-equal
1583 1 : (substitute-in-file-name "/method:host:/:/path///foo")
1584 1 : "/method:host:/:/path///foo"))
1585 :
1586 1 : (should
1587 1 : (string-equal
1588 1 : (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
1589 1 : (should
1590 1 : (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
1591 : ;; Quoting local part.
1592 1 : (should
1593 1 : (string-equal
1594 1 : (substitute-in-file-name "/method:host:/:/path/~/foo")
1595 1 : "/method:host:/:/path/~/foo"))
1596 1 : (should
1597 1 : (string-equal
1598 1 : (substitute-in-file-name "/method:host:/:/path//~/foo")
1599 1 : "/method:host:/:/path//~/foo"))
1600 :
1601 1 : (let (process-environment)
1602 1 : (should
1603 1 : (string-equal
1604 1 : (substitute-in-file-name "/method:host:/path/$FOO")
1605 1 : "/method:host:/path/$FOO"))
1606 1 : (setenv "FOO" "bla")
1607 1 : (should
1608 1 : (string-equal
1609 1 : (substitute-in-file-name "/method:host:/path/$FOO")
1610 1 : "/method:host:/path/bla"))
1611 1 : (should
1612 1 : (string-equal
1613 1 : (substitute-in-file-name "/method:host:/path/$$FOO")
1614 1 : "/method:host:/path/$FOO"))
1615 : ;; Quoting local part.
1616 1 : (should
1617 1 : (string-equal
1618 1 : (substitute-in-file-name "/method:host:/:/path/$FOO")
1619 1 : "/method:host:/:/path/$FOO"))
1620 1 : (setenv "FOO" "bla")
1621 1 : (should
1622 1 : (string-equal
1623 1 : (substitute-in-file-name "/method:host:/:/path/$FOO")
1624 1 : "/method:host:/:/path/$FOO"))
1625 1 : (should
1626 1 : (string-equal
1627 1 : (substitute-in-file-name "/method:host:/:/path/$$FOO")
1628 1 : "/method:host:/:/path/$$FOO"))))
1629 :
1630 : (ert-deftest tramp-test05-expand-file-name ()
1631 : "Check `expand-file-name'."
1632 1 : (should
1633 1 : (string-equal
1634 1 : (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
1635 1 : (should
1636 1 : (string-equal
1637 1 : (expand-file-name "/method:host:/path/../file") "/method:host:/file"))
1638 : ;; Quoting local part.
1639 1 : (should
1640 1 : (string-equal
1641 1 : (expand-file-name "/method:host:/:/path/./file")
1642 1 : "/method:host:/:/path/file"))
1643 1 : (should
1644 1 : (string-equal
1645 1 : (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
1646 1 : (should
1647 1 : (string-equal
1648 1 : (expand-file-name "/method:host:/:/~/path/./file")
1649 1 : "/method:host:/:/~/path/file")))
1650 :
1651 : ;; The following test is inspired by Bug#26911. It is rather a bug in
1652 : ;; `expand-file-name', and it fails for all Emacs versions. Test
1653 : ;; added for later, when it is fixed.
1654 : (ert-deftest tramp-test05-expand-file-name-relative ()
1655 : "Check `expand-file-name'."
1656 : ;; Mark as failed until bug has been fixed.
1657 : :expected-result :failed
1658 1 : (skip-unless (tramp--test-enabled))
1659 : ;; These are the methods the test doesn't fail.
1660 1 : (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
1661 1 : (tramp-smb-file-name-p tramp-test-temporary-file-directory))
1662 0 : (setf (ert-test-expected-result-type
1663 0 : (ert-get-test 'tramp-test05-expand-file-name-relative))
1664 1 : :passed))
1665 :
1666 1 : (should
1667 1 : (string-equal
1668 1 : (let ((default-directory
1669 1 : (concat
1670 1 : (file-remote-p tramp-test-temporary-file-directory) "/path")))
1671 1 : (expand-file-name ".." "./"))
1672 1 : (concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
1673 :
1674 : (ert-deftest tramp-test06-directory-file-name ()
1675 : "Check `directory-file-name'.
1676 : This checks also `file-name-as-directory', `file-name-directory',
1677 : `file-name-nondirectory' and `unhandled-file-name-directory'."
1678 1 : (should
1679 1 : (string-equal
1680 1 : (directory-file-name "/method:host:/path/to/file")
1681 1 : "/method:host:/path/to/file"))
1682 1 : (should
1683 1 : (string-equal
1684 1 : (directory-file-name "/method:host:/path/to/file/")
1685 1 : "/method:host:/path/to/file"))
1686 1 : (should
1687 1 : (string-equal
1688 1 : (file-name-as-directory "/method:host:/path/to/file")
1689 1 : "/method:host:/path/to/file/"))
1690 1 : (should
1691 1 : (string-equal
1692 1 : (file-name-as-directory "/method:host:/path/to/file/")
1693 1 : "/method:host:/path/to/file/"))
1694 1 : (should
1695 1 : (string-equal
1696 1 : (file-name-directory "/method:host:/path/to/file")
1697 1 : "/method:host:/path/to/"))
1698 1 : (should
1699 1 : (string-equal
1700 1 : (file-name-directory "/method:host:/path/to/file/")
1701 1 : "/method:host:/path/to/file/"))
1702 1 : (should
1703 1 : (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
1704 1 : (should
1705 1 : (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
1706 1 : (should-not
1707 1 : (unhandled-file-name-directory "/method:host:/path/to/file"))
1708 :
1709 : ;; Bug#10085.
1710 1 : (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
1711 1 : (dolist (n-e '(nil t))
1712 : ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
1713 : ;; which ruins the tests.
1714 2 : (let ((non-essential n-e)
1715 : tramp-default-method)
1716 2 : (dolist
1717 : (file
1718 2 : `(,(format
1719 : "/%s::"
1720 2 : (file-remote-p tramp-test-temporary-file-directory 'method))
1721 2 : ,(format
1722 : "/-:%s:"
1723 2 : (file-remote-p tramp-test-temporary-file-directory 'host))))
1724 4 : (should (string-equal (directory-file-name file) file))
1725 4 : (should
1726 4 : (string-equal
1727 4 : (file-name-as-directory file)
1728 4 : (if (tramp-completion-mode-p)
1729 4 : file (concat file "./"))))
1730 4 : (should (string-equal (file-name-directory file) file))
1731 4 : (should (string-equal (file-name-nondirectory file) "")))))))
1732 :
1733 : (ert-deftest tramp-test07-file-exists-p ()
1734 : "Check `file-exist-p', `write-region' and `delete-file'."
1735 1 : (skip-unless (tramp--test-enabled))
1736 :
1737 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1738 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1739 2 : (should-not (file-exists-p tmp-name))
1740 2 : (write-region "foo" nil tmp-name)
1741 2 : (should (file-exists-p tmp-name))
1742 2 : (delete-file tmp-name)
1743 2 : (should-not (file-exists-p tmp-name)))))
1744 :
1745 : (ert-deftest tramp-test08-file-local-copy ()
1746 : "Check `file-local-copy'."
1747 1 : (skip-unless (tramp--test-enabled))
1748 :
1749 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1750 2 : (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1751 : tmp-name2)
1752 2 : (unwind-protect
1753 2 : (progn
1754 2 : (write-region "foo" nil tmp-name1)
1755 2 : (should (setq tmp-name2 (file-local-copy tmp-name1)))
1756 2 : (with-temp-buffer
1757 2 : (insert-file-contents tmp-name2)
1758 2 : (should (string-equal (buffer-string) "foo")))
1759 : ;; Check also that a file transfer with compression works.
1760 2 : (let ((default-directory tramp-test-temporary-file-directory)
1761 : (tramp-copy-size-limit 4)
1762 : (tramp-inline-compress-start-size 2))
1763 2 : (delete-file tmp-name2)
1764 2 : (should (setq tmp-name2 (file-local-copy tmp-name1)))))
1765 :
1766 : ;; Cleanup.
1767 2 : (ignore-errors
1768 2 : (delete-file tmp-name1)
1769 2 : (delete-file tmp-name2))))))
1770 :
1771 : (ert-deftest tramp-test09-insert-file-contents ()
1772 : "Check `insert-file-contents'."
1773 1 : (skip-unless (tramp--test-enabled))
1774 :
1775 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1776 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1777 2 : (unwind-protect
1778 2 : (progn
1779 2 : (write-region "foo" nil tmp-name)
1780 2 : (with-temp-buffer
1781 2 : (insert-file-contents tmp-name)
1782 2 : (should (string-equal (buffer-string) "foo"))
1783 2 : (insert-file-contents tmp-name)
1784 2 : (should (string-equal (buffer-string) "foofoo"))
1785 : ;; Insert partly.
1786 2 : (insert-file-contents tmp-name nil 1 3)
1787 2 : (should (string-equal (buffer-string) "oofoofoo"))
1788 : ;; Replace.
1789 2 : (insert-file-contents tmp-name nil nil nil 'replace)
1790 2 : (should (string-equal (buffer-string) "foo"))))
1791 :
1792 : ;; Cleanup.
1793 2 : (ignore-errors (delete-file tmp-name))))))
1794 :
1795 : (ert-deftest tramp-test10-write-region ()
1796 : "Check `write-region'."
1797 1 : (skip-unless (tramp--test-enabled))
1798 :
1799 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1800 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
1801 2 : (unwind-protect
1802 2 : (progn
1803 : ;; Write buffer. Use absolute and relative file name.
1804 2 : (with-temp-buffer
1805 2 : (insert "foo")
1806 2 : (write-region nil nil tmp-name))
1807 2 : (with-temp-buffer
1808 2 : (insert-file-contents tmp-name)
1809 2 : (should (string-equal (buffer-string) "foo")))
1810 2 : (delete-file tmp-name)
1811 2 : (with-temp-buffer
1812 2 : (insert "foo")
1813 2 : (should-not (file-exists-p tmp-name))
1814 2 : (let ((default-directory (file-name-directory tmp-name)))
1815 2 : (should-not (file-exists-p (file-name-nondirectory tmp-name)))
1816 2 : (write-region nil nil (file-name-nondirectory tmp-name))
1817 2 : (should (file-exists-p (file-name-nondirectory tmp-name))))
1818 2 : (should (file-exists-p tmp-name)))
1819 2 : (with-temp-buffer
1820 2 : (insert-file-contents tmp-name)
1821 2 : (should (string-equal (buffer-string) "foo")))
1822 :
1823 : ;; Append.
1824 2 : (with-temp-buffer
1825 2 : (insert "bla")
1826 2 : (write-region nil nil tmp-name 'append))
1827 2 : (with-temp-buffer
1828 2 : (insert-file-contents tmp-name)
1829 2 : (should (string-equal (buffer-string) "foobla")))
1830 2 : (with-temp-buffer
1831 2 : (insert "baz")
1832 2 : (write-region nil nil tmp-name 3))
1833 2 : (with-temp-buffer
1834 2 : (insert-file-contents tmp-name)
1835 2 : (should (string-equal (buffer-string) "foobaz")))
1836 :
1837 : ;; Write string.
1838 2 : (write-region "foo" nil tmp-name)
1839 2 : (with-temp-buffer
1840 2 : (insert-file-contents tmp-name)
1841 2 : (should (string-equal (buffer-string) "foo")))
1842 :
1843 : ;; Write partly.
1844 2 : (with-temp-buffer
1845 2 : (insert "123456789")
1846 2 : (write-region 3 5 tmp-name))
1847 2 : (with-temp-buffer
1848 2 : (insert-file-contents tmp-name)
1849 2 : (should (string-equal (buffer-string) "34")))
1850 :
1851 : ;; Do not overwrite if excluded.
1852 6 : (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)))
1853 2 : (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1854 : ;; `mustbenew' is passed to Tramp since Emacs 26.1. We
1855 : ;; have no test for this, so we check function
1856 : ;; `temporary-file-directory', which has been added to
1857 : ;; Emacs 26.1 as well.
1858 2 : (when (fboundp 'temporary-file-directory)
1859 2 : (should-error
1860 6 : (cl-letf (((symbol-function 'y-or-n-p) 'ignore))
1861 2 : (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
1862 2 : :type 'file-already-exists)
1863 2 : (should-error
1864 2 : (write-region "foo" nil tmp-name nil nil nil 'excl)
1865 2 : :type 'file-already-exists)))
1866 :
1867 : ;; Cleanup.
1868 2 : (ignore-errors (delete-file tmp-name))))))
1869 :
1870 : (ert-deftest tramp-test11-copy-file ()
1871 : "Check `copy-file'."
1872 1 : (skip-unless (tramp--test-enabled))
1873 :
1874 : ;; TODO: The quoted case does not work.
1875 : ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1876 1 : (let (quoted)
1877 1 : (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1878 1 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
1879 1 : (tmp-name3 (tramp--test-make-temp-name nil quoted))
1880 1 : (tmp-name4 (tramp--test-make-temp-name 'local quoted))
1881 1 : (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
1882 :
1883 : ;; Copy on remote side.
1884 1 : (unwind-protect
1885 1 : (progn
1886 1 : (write-region "foo" nil tmp-name1)
1887 1 : (copy-file tmp-name1 tmp-name2)
1888 1 : (should (file-exists-p tmp-name2))
1889 1 : (with-temp-buffer
1890 1 : (insert-file-contents tmp-name2)
1891 1 : (should (string-equal (buffer-string) "foo")))
1892 1 : (should-error (copy-file tmp-name1 tmp-name2))
1893 1 : (copy-file tmp-name1 tmp-name2 'ok)
1894 1 : (make-directory tmp-name3)
1895 1 : (copy-file tmp-name1 tmp-name3)
1896 1 : (should
1897 1 : (file-exists-p
1898 1 : (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
1899 :
1900 : ;; Cleanup.
1901 1 : (ignore-errors (delete-file tmp-name1))
1902 1 : (ignore-errors (delete-file tmp-name2))
1903 1 : (ignore-errors (delete-directory tmp-name3 'recursive)))
1904 :
1905 : ;; Copy from remote side to local side.
1906 1 : (unwind-protect
1907 1 : (progn
1908 1 : (write-region "foo" nil tmp-name1)
1909 1 : (copy-file tmp-name1 tmp-name4)
1910 1 : (should (file-exists-p tmp-name4))
1911 1 : (with-temp-buffer
1912 1 : (insert-file-contents tmp-name4)
1913 1 : (should (string-equal (buffer-string) "foo")))
1914 1 : (should-error (copy-file tmp-name1 tmp-name4))
1915 1 : (copy-file tmp-name1 tmp-name4 'ok)
1916 1 : (make-directory tmp-name5)
1917 1 : (copy-file tmp-name1 tmp-name5)
1918 1 : (should
1919 1 : (file-exists-p
1920 1 : (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
1921 :
1922 : ;; Cleanup.
1923 1 : (ignore-errors (delete-file tmp-name1))
1924 1 : (ignore-errors (delete-file tmp-name4))
1925 1 : (ignore-errors (delete-directory tmp-name5 'recursive)))
1926 :
1927 : ;; Copy from local side to remote side.
1928 1 : (unwind-protect
1929 1 : (progn
1930 1 : (write-region "foo" nil tmp-name4 nil 'nomessage)
1931 1 : (copy-file tmp-name4 tmp-name1)
1932 1 : (should (file-exists-p tmp-name1))
1933 1 : (with-temp-buffer
1934 1 : (insert-file-contents tmp-name1)
1935 1 : (should (string-equal (buffer-string) "foo")))
1936 1 : (should-error (copy-file tmp-name4 tmp-name1))
1937 1 : (copy-file tmp-name4 tmp-name1 'ok)
1938 1 : (make-directory tmp-name3)
1939 1 : (copy-file tmp-name4 tmp-name3)
1940 1 : (should
1941 1 : (file-exists-p
1942 1 : (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
1943 :
1944 : ;; Cleanup.
1945 1 : (ignore-errors (delete-file tmp-name1))
1946 1 : (ignore-errors (delete-file tmp-name4))
1947 1 : (ignore-errors (delete-directory tmp-name3 'recursive))))))
1948 :
1949 : (ert-deftest tramp-test12-rename-file ()
1950 : "Check `rename-file'."
1951 1 : (skip-unless (tramp--test-enabled))
1952 :
1953 : ;; TODO: The quoted case does not work.
1954 : ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1955 1 : (let (quoted)
1956 1 : (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
1957 1 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
1958 1 : (tmp-name3 (tramp--test-make-temp-name nil quoted))
1959 1 : (tmp-name4 (tramp--test-make-temp-name 'local quoted))
1960 1 : (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
1961 :
1962 : ;; Rename on remote side.
1963 1 : (unwind-protect
1964 1 : (progn
1965 1 : (write-region "foo" nil tmp-name1)
1966 1 : (rename-file tmp-name1 tmp-name2)
1967 1 : (should-not (file-exists-p tmp-name1))
1968 1 : (should (file-exists-p tmp-name2))
1969 1 : (with-temp-buffer
1970 1 : (insert-file-contents tmp-name2)
1971 1 : (should (string-equal (buffer-string) "foo")))
1972 1 : (write-region "foo" nil tmp-name1)
1973 1 : (should-error (rename-file tmp-name1 tmp-name2))
1974 1 : (rename-file tmp-name1 tmp-name2 'ok)
1975 1 : (should-not (file-exists-p tmp-name1))
1976 1 : (write-region "foo" nil tmp-name1)
1977 1 : (make-directory tmp-name3)
1978 1 : (rename-file tmp-name1 tmp-name3)
1979 1 : (should-not (file-exists-p tmp-name1))
1980 1 : (should
1981 1 : (file-exists-p
1982 1 : (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
1983 :
1984 : ;; Cleanup.
1985 1 : (ignore-errors (delete-file tmp-name1))
1986 1 : (ignore-errors (delete-file tmp-name2))
1987 1 : (ignore-errors (delete-directory tmp-name3 'recursive)))
1988 :
1989 : ;; Rename from remote side to local side.
1990 1 : (unwind-protect
1991 1 : (progn
1992 1 : (write-region "foo" nil tmp-name1)
1993 1 : (rename-file tmp-name1 tmp-name4)
1994 1 : (should-not (file-exists-p tmp-name1))
1995 1 : (should (file-exists-p tmp-name4))
1996 1 : (with-temp-buffer
1997 1 : (insert-file-contents tmp-name4)
1998 1 : (should (string-equal (buffer-string) "foo")))
1999 1 : (write-region "foo" nil tmp-name1)
2000 1 : (should-error (rename-file tmp-name1 tmp-name4))
2001 1 : (rename-file tmp-name1 tmp-name4 'ok)
2002 1 : (should-not (file-exists-p tmp-name1))
2003 1 : (write-region "foo" nil tmp-name1)
2004 1 : (make-directory tmp-name5)
2005 1 : (rename-file tmp-name1 tmp-name5)
2006 1 : (should-not (file-exists-p tmp-name1))
2007 1 : (should
2008 1 : (file-exists-p
2009 1 : (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
2010 :
2011 : ;; Cleanup.
2012 1 : (ignore-errors (delete-file tmp-name1))
2013 1 : (ignore-errors (delete-file tmp-name4))
2014 1 : (ignore-errors (delete-directory tmp-name5 'recursive)))
2015 :
2016 : ;; Rename from local side to remote side.
2017 1 : (unwind-protect
2018 1 : (progn
2019 1 : (write-region "foo" nil tmp-name4 nil 'nomessage)
2020 1 : (rename-file tmp-name4 tmp-name1)
2021 1 : (should-not (file-exists-p tmp-name4))
2022 1 : (should (file-exists-p tmp-name1))
2023 1 : (with-temp-buffer
2024 1 : (insert-file-contents tmp-name1)
2025 1 : (should (string-equal (buffer-string) "foo")))
2026 1 : (write-region "foo" nil tmp-name4 nil 'nomessage)
2027 1 : (should-error (rename-file tmp-name4 tmp-name1))
2028 1 : (rename-file tmp-name4 tmp-name1 'ok)
2029 1 : (should-not (file-exists-p tmp-name4))
2030 1 : (write-region "foo" nil tmp-name4 nil 'nomessage)
2031 1 : (make-directory tmp-name3)
2032 1 : (rename-file tmp-name4 tmp-name3)
2033 1 : (should-not (file-exists-p tmp-name4))
2034 1 : (should
2035 1 : (file-exists-p
2036 1 : (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
2037 :
2038 : ;; Cleanup.
2039 1 : (ignore-errors (delete-file tmp-name1))
2040 1 : (ignore-errors (delete-file tmp-name4))
2041 1 : (ignore-errors (delete-directory tmp-name3 'recursive))))))
2042 :
2043 : (ert-deftest tramp-test13-make-directory ()
2044 : "Check `make-directory'.
2045 : This tests also `file-directory-p' and `file-accessible-directory-p'."
2046 1 : (skip-unless (tramp--test-enabled))
2047 :
2048 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2049 2 : (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2050 2 : (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
2051 2 : (unwind-protect
2052 2 : (progn
2053 2 : (make-directory tmp-name1)
2054 2 : (should (file-directory-p tmp-name1))
2055 2 : (should (file-accessible-directory-p tmp-name1))
2056 2 : (should-error (make-directory tmp-name2))
2057 2 : (make-directory tmp-name2 'parents)
2058 2 : (should (file-directory-p tmp-name2))
2059 2 : (should (file-accessible-directory-p tmp-name2)))
2060 :
2061 : ;; Cleanup.
2062 2 : (ignore-errors (delete-directory tmp-name1 'recursive))))))
2063 :
2064 : (ert-deftest tramp-test14-delete-directory ()
2065 : "Check `delete-directory'."
2066 1 : (skip-unless (tramp--test-enabled))
2067 :
2068 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2069 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2070 : ;; Delete empty directory.
2071 2 : (make-directory tmp-name)
2072 2 : (should (file-directory-p tmp-name))
2073 2 : (delete-directory tmp-name)
2074 2 : (should-not (file-directory-p tmp-name))
2075 : ;; Delete non-empty directory.
2076 2 : (make-directory tmp-name)
2077 2 : (should (file-directory-p tmp-name))
2078 2 : (write-region "foo" nil (expand-file-name "bla" tmp-name))
2079 2 : (should (file-exists-p (expand-file-name "bla" tmp-name)))
2080 2 : (should-error (delete-directory tmp-name))
2081 2 : (delete-directory tmp-name 'recursive)
2082 2 : (should-not (file-directory-p tmp-name)))))
2083 :
2084 : (ert-deftest tramp-test15-copy-directory ()
2085 : "Check `copy-directory'."
2086 1 : (skip-unless (tramp--test-enabled))
2087 :
2088 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2089 2 : (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2090 2 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
2091 2 : (tmp-name3 (expand-file-name
2092 2 : (file-name-nondirectory tmp-name1) tmp-name2))
2093 2 : (tmp-name4 (expand-file-name "foo" tmp-name1))
2094 2 : (tmp-name5 (expand-file-name "foo" tmp-name2))
2095 2 : (tmp-name6 (expand-file-name "foo" tmp-name3)))
2096 :
2097 : ;; Copy complete directory.
2098 2 : (unwind-protect
2099 2 : (progn
2100 : ;; Copy empty directory.
2101 2 : (make-directory tmp-name1)
2102 2 : (write-region "foo" nil tmp-name4)
2103 2 : (should (file-directory-p tmp-name1))
2104 2 : (should (file-exists-p tmp-name4))
2105 2 : (copy-directory tmp-name1 tmp-name2)
2106 2 : (should (file-directory-p tmp-name2))
2107 2 : (should (file-exists-p tmp-name5))
2108 : ;; Target directory does exist already.
2109 2 : (copy-directory tmp-name1 tmp-name2)
2110 2 : (should (file-directory-p tmp-name3))
2111 2 : (should (file-exists-p tmp-name6)))
2112 :
2113 : ;; Cleanup.
2114 2 : (ignore-errors
2115 2 : (delete-directory tmp-name1 'recursive)
2116 2 : (delete-directory tmp-name2 'recursive)))
2117 :
2118 : ;; Copy directory contents.
2119 2 : (unwind-protect
2120 2 : (progn
2121 : ;; Copy empty directory.
2122 2 : (make-directory tmp-name1)
2123 2 : (write-region "foo" nil tmp-name4)
2124 2 : (should (file-directory-p tmp-name1))
2125 2 : (should (file-exists-p tmp-name4))
2126 2 : (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
2127 2 : (should (file-directory-p tmp-name2))
2128 2 : (should (file-exists-p tmp-name5))
2129 : ;; Target directory does exist already.
2130 2 : (delete-file tmp-name5)
2131 2 : (should-not (file-exists-p tmp-name5))
2132 2 : (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
2133 2 : (should (file-directory-p tmp-name2))
2134 2 : (should (file-exists-p tmp-name5))
2135 2 : (should-not (file-directory-p tmp-name3))
2136 2 : (should-not (file-exists-p tmp-name6)))
2137 :
2138 : ;; Cleanup.
2139 2 : (ignore-errors
2140 2 : (delete-directory tmp-name1 'recursive)
2141 2 : (delete-directory tmp-name2 'recursive))))))
2142 :
2143 : (ert-deftest tramp-test16-directory-files ()
2144 : "Check `directory-files'."
2145 1 : (skip-unless (tramp--test-enabled))
2146 :
2147 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2148 2 : (let* ((tmp-name1
2149 2 : (expand-file-name (tramp--test-make-temp-name nil quoted)))
2150 2 : (tmp-name2 (expand-file-name "bla" tmp-name1))
2151 2 : (tmp-name3 (expand-file-name "foo" tmp-name1)))
2152 2 : (unwind-protect
2153 2 : (progn
2154 2 : (make-directory tmp-name1)
2155 2 : (write-region "foo" nil tmp-name2)
2156 2 : (write-region "bla" nil tmp-name3)
2157 2 : (should (file-directory-p tmp-name1))
2158 2 : (should (file-exists-p tmp-name2))
2159 2 : (should (file-exists-p tmp-name3))
2160 2 : (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
2161 2 : (should (equal (directory-files tmp-name1 'full)
2162 2 : `(,(concat tmp-name1 "/.")
2163 2 : ,(concat tmp-name1 "/..")
2164 2 : ,tmp-name2 ,tmp-name3)))
2165 2 : (should (equal (directory-files
2166 2 : tmp-name1 nil directory-files-no-dot-files-regexp)
2167 2 : '("bla" "foo")))
2168 2 : (should (equal (directory-files
2169 2 : tmp-name1 'full directory-files-no-dot-files-regexp)
2170 2 : `(,tmp-name2 ,tmp-name3))))
2171 :
2172 : ;; Cleanup.
2173 2 : (ignore-errors (delete-directory tmp-name1 'recursive))))))
2174 :
2175 : (ert-deftest tramp-test17-insert-directory ()
2176 : "Check `insert-directory'."
2177 1 : (skip-unless (tramp--test-enabled))
2178 :
2179 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2180 2 : (let* ((tmp-name1
2181 2 : (expand-file-name (tramp--test-make-temp-name nil quoted)))
2182 2 : (tmp-name2 (expand-file-name "foo" tmp-name1))
2183 : ;; We test for the summary line. Keyword "total" could be localized.
2184 : (process-environment
2185 2 : (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
2186 2 : (unwind-protect
2187 2 : (progn
2188 2 : (make-directory tmp-name1)
2189 2 : (write-region "foo" nil tmp-name2)
2190 2 : (should (file-directory-p tmp-name1))
2191 2 : (should (file-exists-p tmp-name2))
2192 2 : (with-temp-buffer
2193 2 : (insert-directory tmp-name1 nil)
2194 2 : (goto-char (point-min))
2195 2 : (should (looking-at-p (regexp-quote tmp-name1))))
2196 2 : (with-temp-buffer
2197 2 : (insert-directory tmp-name1 "-al")
2198 2 : (goto-char (point-min))
2199 2 : (should
2200 2 : (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
2201 2 : (with-temp-buffer
2202 2 : (insert-directory (file-name-as-directory tmp-name1) "-al")
2203 2 : (goto-char (point-min))
2204 2 : (should
2205 2 : (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
2206 2 : (with-temp-buffer
2207 2 : (insert-directory
2208 2 : (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
2209 2 : (goto-char (point-min))
2210 2 : (should
2211 2 : (looking-at-p
2212 2 : (concat
2213 : ;; There might be a summary line.
2214 : "\\(total.+[[:digit:]]+\n\\)?"
2215 : ;; We don't know in which order ".", ".." and "foo" appear.
2216 2 : "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
2217 :
2218 : ;; Cleanup.
2219 2 : (ignore-errors (delete-directory tmp-name1 'recursive))))))
2220 :
2221 : (ert-deftest tramp-test17-dired-with-wildcards ()
2222 : "Check `dired' with wildcards."
2223 1 : (skip-unless (tramp--test-enabled))
2224 1 : (skip-unless (tramp--test-sh-p))
2225 : ;; Since Emacs 26.1.
2226 1 : (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
2227 :
2228 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2229 2 : (let* ((tmp-name1
2230 2 : (expand-file-name (tramp--test-make-temp-name nil quoted)))
2231 : (tmp-name2
2232 2 : (expand-file-name (tramp--test-make-temp-name nil quoted)))
2233 2 : (tmp-name3 (expand-file-name "foo" tmp-name1))
2234 2 : (tmp-name4 (expand-file-name "bar" tmp-name2))
2235 : (tramp-test-temporary-file-directory
2236 2 : (funcall
2237 2 : (if quoted 'tramp-compat-file-name-quote 'identity)
2238 2 : tramp-test-temporary-file-directory))
2239 : buffer)
2240 2 : (unwind-protect
2241 2 : (progn
2242 2 : (make-directory tmp-name1)
2243 2 : (write-region "foo" nil tmp-name3)
2244 2 : (should (file-directory-p tmp-name1))
2245 2 : (should (file-exists-p tmp-name3))
2246 2 : (make-directory tmp-name2)
2247 2 : (write-region "foo" nil tmp-name4)
2248 2 : (should (file-directory-p tmp-name2))
2249 2 : (should (file-exists-p tmp-name4))
2250 :
2251 : ;; Check for expanded directory names.
2252 2 : (with-current-buffer
2253 2 : (setq buffer
2254 2 : (dired-noselect
2255 2 : (expand-file-name
2256 2 : "tramp-test*" tramp-test-temporary-file-directory)))
2257 2 : (goto-char (point-min))
2258 2 : (should
2259 2 : (re-search-forward
2260 2 : (regexp-quote
2261 2 : (file-relative-name
2262 2 : tmp-name1 tramp-test-temporary-file-directory))))
2263 2 : (goto-char (point-min))
2264 2 : (should
2265 2 : (re-search-forward
2266 2 : (regexp-quote
2267 2 : (file-relative-name
2268 2 : tmp-name2 tramp-test-temporary-file-directory)))))
2269 2 : (kill-buffer buffer)
2270 :
2271 : ;; Check for expanded directory and file names.
2272 2 : (with-current-buffer
2273 2 : (setq buffer
2274 2 : (dired-noselect
2275 2 : (expand-file-name
2276 2 : "tramp-test*/*" tramp-test-temporary-file-directory)))
2277 2 : (goto-char (point-min))
2278 2 : (should
2279 2 : (re-search-forward
2280 2 : (regexp-quote
2281 2 : (file-relative-name
2282 2 : tmp-name3 tramp-test-temporary-file-directory))))
2283 2 : (goto-char (point-min))
2284 2 : (should
2285 2 : (re-search-forward
2286 2 : (regexp-quote
2287 2 : (file-relative-name
2288 2 : tmp-name4
2289 2 : tramp-test-temporary-file-directory)))))
2290 2 : (kill-buffer buffer)
2291 :
2292 : ;; Check for special characters.
2293 2 : (setq tmp-name3 (expand-file-name "*?" tmp-name1))
2294 2 : (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
2295 2 : (write-region "foo" nil tmp-name3)
2296 2 : (should (file-exists-p tmp-name3))
2297 2 : (write-region "foo" nil tmp-name4)
2298 2 : (should (file-exists-p tmp-name4))
2299 :
2300 2 : (with-current-buffer
2301 2 : (setq buffer
2302 2 : (dired-noselect
2303 2 : (expand-file-name
2304 2 : "tramp-test*/*" tramp-test-temporary-file-directory)))
2305 2 : (goto-char (point-min))
2306 2 : (should
2307 2 : (re-search-forward
2308 2 : (regexp-quote
2309 2 : (file-relative-name
2310 2 : tmp-name3 tramp-test-temporary-file-directory))))
2311 2 : (goto-char (point-min))
2312 2 : (should
2313 2 : (re-search-forward
2314 2 : (regexp-quote
2315 2 : (file-relative-name
2316 2 : tmp-name4
2317 2 : tramp-test-temporary-file-directory)))))
2318 2 : (kill-buffer buffer))
2319 :
2320 : ;; Cleanup.
2321 2 : (ignore-errors (kill-buffer buffer))
2322 2 : (ignore-errors (delete-directory tmp-name1 'recursive))
2323 2 : (ignore-errors (delete-directory tmp-name2 'recursive))))))
2324 :
2325 : (ert-deftest tramp-test18-file-attributes ()
2326 : "Check `file-attributes'.
2327 : This tests also `file-readable-p', `file-regular-p' and
2328 : `file-ownership-preserved-p'."
2329 1 : (skip-unless (tramp--test-enabled))
2330 :
2331 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2332 : ;; We must use `file-truename' for the temporary directory,
2333 : ;; because it could be located on a symlinked directory. This
2334 : ;; would let the test fail.
2335 2 : (let* ((tramp-test-temporary-file-directory
2336 2 : (file-truename tramp-test-temporary-file-directory))
2337 2 : (tmp-name1 (tramp--test-make-temp-name nil quoted))
2338 2 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
2339 : ;; File name with "//".
2340 : (tmp-name3
2341 2 : (format
2342 : "%s%s"
2343 2 : (file-remote-p tmp-name1)
2344 2 : (replace-regexp-in-string
2345 2 : "/" "//" (file-remote-p tmp-name1 'localname))))
2346 : attr)
2347 2 : (unwind-protect
2348 2 : (progn
2349 : ;; `file-ownership-preserved-p' should return t for
2350 : ;; non-existing files. It is implemented only in tramp-sh.el.
2351 2 : (when (tramp--test-sh-p)
2352 2 : (should (file-ownership-preserved-p tmp-name1 'group)))
2353 2 : (write-region "foo" nil tmp-name1)
2354 2 : (should (file-exists-p tmp-name1))
2355 2 : (should (file-readable-p tmp-name1))
2356 2 : (should (file-regular-p tmp-name1))
2357 2 : (when (tramp--test-sh-p)
2358 2 : (should (file-ownership-preserved-p tmp-name1 'group)))
2359 :
2360 : ;; We do not test inodes and device numbers.
2361 2 : (setq attr (file-attributes tmp-name1))
2362 2 : (should (consp attr))
2363 2 : (should (null (car attr)))
2364 2 : (should (numberp (nth 1 attr))) ;; Link.
2365 2 : (should (numberp (nth 2 attr))) ;; Uid.
2366 2 : (should (numberp (nth 3 attr))) ;; Gid.
2367 : ;; Last access time.
2368 2 : (should (stringp (current-time-string (nth 4 attr))))
2369 : ;; Last modification time.
2370 2 : (should (stringp (current-time-string (nth 5 attr))))
2371 : ;; Last status change time.
2372 2 : (should (stringp (current-time-string (nth 6 attr))))
2373 2 : (should (numberp (nth 7 attr))) ;; Size.
2374 2 : (should (stringp (nth 8 attr))) ;; Modes.
2375 :
2376 2 : (setq attr (file-attributes tmp-name1 'string))
2377 2 : (should (stringp (nth 2 attr))) ;; Uid.
2378 2 : (should (stringp (nth 3 attr))) ;; Gid.
2379 :
2380 2 : (condition-case err
2381 2 : (progn
2382 2 : (when (tramp--test-sh-p)
2383 2 : (should (file-ownership-preserved-p tmp-name2 'group)))
2384 2 : (make-symbolic-link tmp-name1 tmp-name2)
2385 2 : (should (file-exists-p tmp-name2))
2386 2 : (should (file-symlink-p tmp-name2))
2387 2 : (when (tramp--test-sh-p)
2388 2 : (should (file-ownership-preserved-p tmp-name2 'group)))
2389 2 : (setq attr (file-attributes tmp-name2))
2390 2 : (should
2391 2 : (string-equal
2392 2 : (funcall
2393 2 : (if quoted 'tramp-compat-file-name-quote 'identity)
2394 2 : (car attr))
2395 2 : (file-remote-p (file-truename tmp-name1) 'localname)))
2396 2 : (delete-file tmp-name2))
2397 : (file-error
2398 0 : (should (string-equal (error-message-string err)
2399 2 : "make-symbolic-link not supported"))))
2400 :
2401 : ;; Check, that "//" in symlinks are handled properly.
2402 2 : (with-temp-buffer
2403 2 : (let ((default-directory tramp-test-temporary-file-directory))
2404 2 : (shell-command
2405 2 : (format
2406 : "ln -s %s %s"
2407 2 : (tramp-file-name-localname
2408 2 : (tramp-dissect-file-name tmp-name3))
2409 2 : (tramp-file-name-localname
2410 2 : (tramp-dissect-file-name tmp-name2)))
2411 2 : t)))
2412 2 : (when (file-symlink-p tmp-name2)
2413 1 : (setq attr (file-attributes tmp-name2))
2414 1 : (should
2415 1 : (string-equal
2416 1 : (car attr)
2417 1 : (tramp-file-name-localname
2418 1 : (tramp-dissect-file-name tmp-name3))))
2419 2 : (delete-file tmp-name2))
2420 :
2421 2 : (when (tramp--test-sh-p)
2422 2 : (should (file-ownership-preserved-p tmp-name1 'group)))
2423 2 : (delete-file tmp-name1)
2424 2 : (make-directory tmp-name1)
2425 2 : (should (file-exists-p tmp-name1))
2426 2 : (should (file-readable-p tmp-name1))
2427 2 : (should-not (file-regular-p tmp-name1))
2428 2 : (when (tramp--test-sh-p)
2429 2 : (should (file-ownership-preserved-p tmp-name1 'group)))
2430 2 : (setq attr (file-attributes tmp-name1))
2431 2 : (should (eq (car attr) t)))
2432 :
2433 : ;; Cleanup.
2434 2 : (ignore-errors (delete-directory tmp-name1))
2435 2 : (ignore-errors (delete-file tmp-name1))
2436 2 : (ignore-errors (delete-file tmp-name2))))))
2437 :
2438 : (ert-deftest tramp-test19-directory-files-and-attributes ()
2439 : "Check `directory-files-and-attributes'."
2440 1 : (skip-unless (tramp--test-enabled))
2441 :
2442 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2443 : ;; `directory-files-and-attributes' contains also values for
2444 : ;; "../". Ensure that this doesn't change during tests, for
2445 : ;; example due to handling temporary files.
2446 2 : (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2447 2 : (tmp-name2 (expand-file-name "bla" tmp-name1))
2448 : attr)
2449 2 : (unwind-protect
2450 2 : (progn
2451 2 : (make-directory tmp-name1)
2452 2 : (should (file-directory-p tmp-name1))
2453 2 : (make-directory tmp-name2)
2454 2 : (should (file-directory-p tmp-name2))
2455 2 : (write-region "foo" nil (expand-file-name "foo" tmp-name2))
2456 2 : (write-region "bar" nil (expand-file-name "bar" tmp-name2))
2457 2 : (write-region "boz" nil (expand-file-name "boz" tmp-name2))
2458 2 : (setq attr (directory-files-and-attributes tmp-name2))
2459 2 : (should (consp attr))
2460 : ;; Dumb remote shells without perl(1) or stat(1) are not
2461 : ;; able to return the date correctly. They say "don't know".
2462 2 : (dolist (elt attr)
2463 10 : (unless
2464 10 : (equal
2465 10 : (nth
2466 10 : 5 (file-attributes (expand-file-name (car elt) tmp-name2)))
2467 10 : '(0 0))
2468 10 : (should
2469 10 : (equal (file-attributes (expand-file-name (car elt) tmp-name2))
2470 10 : (cdr elt)))))
2471 2 : (setq attr (directory-files-and-attributes tmp-name2 'full))
2472 2 : (dolist (elt attr)
2473 10 : (unless (equal (nth 5 (file-attributes (car elt))) '(0 0))
2474 10 : (should
2475 10 : (equal (file-attributes (car elt)) (cdr elt)))))
2476 2 : (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
2477 2 : (should (equal (mapcar 'car attr) '("bar" "boz"))))
2478 :
2479 : ;; Cleanup.
2480 2 : (ignore-errors (delete-directory tmp-name1 'recursive))))))
2481 :
2482 : (ert-deftest tramp-test20-file-modes ()
2483 : "Check `file-modes'.
2484 : This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
2485 1 : (skip-unless (tramp--test-enabled))
2486 1 : (skip-unless (tramp--test-sh-p))
2487 :
2488 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2489 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2490 2 : (unwind-protect
2491 2 : (progn
2492 2 : (write-region "foo" nil tmp-name)
2493 2 : (should (file-exists-p tmp-name))
2494 2 : (set-file-modes tmp-name #o777)
2495 2 : (should (= (file-modes tmp-name) #o777))
2496 2 : (should (file-executable-p tmp-name))
2497 2 : (should (file-writable-p tmp-name))
2498 2 : (set-file-modes tmp-name #o444)
2499 2 : (should (= (file-modes tmp-name) #o444))
2500 2 : (should-not (file-executable-p tmp-name))
2501 : ;; A file is always writable for user "root".
2502 2 : (unless (zerop (nth 2 (file-attributes tmp-name)))
2503 2 : (should-not (file-writable-p tmp-name))))
2504 :
2505 : ;; Cleanup.
2506 2 : (ignore-errors (delete-file tmp-name))))))
2507 :
2508 : (ert-deftest tramp-test21-file-links ()
2509 : "Check `file-symlink-p'.
2510 : This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2511 1 : (skip-unless (tramp--test-enabled))
2512 :
2513 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2514 : ;; We must use `file-truename' for the temporary directory,
2515 : ;; because it could be located on a symlinked directory. This
2516 : ;; would let the test fail.
2517 2 : (let* ((tramp-test-temporary-file-directory
2518 2 : (file-truename tramp-test-temporary-file-directory))
2519 2 : (tmp-name1 (tramp--test-make-temp-name nil quoted))
2520 2 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
2521 2 : (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
2522 :
2523 : ;; Check `make-symbolic-link'.
2524 2 : (unwind-protect
2525 2 : (progn
2526 2 : (write-region "foo" nil tmp-name1)
2527 2 : (should (file-exists-p tmp-name1))
2528 : ;; Method "smb" supports `make-symbolic-link' only if the
2529 : ;; remote host has CIFS capabilities. tramp-adb.el and
2530 : ;; tramp-gvfs.el do not support symbolic links at all.
2531 2 : (condition-case err
2532 2 : (make-symbolic-link tmp-name1 tmp-name2)
2533 : (file-error
2534 0 : (skip-unless
2535 0 : (not (string-equal (error-message-string err)
2536 2 : "make-symbolic-link not supported")))))
2537 2 : (should (file-symlink-p tmp-name2))
2538 2 : (should-error (make-symbolic-link tmp-name1 tmp-name2))
2539 2 : (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
2540 2 : (should (file-symlink-p tmp-name2))
2541 : ;; `tmp-name3' is a local file name.
2542 2 : (should-error (make-symbolic-link tmp-name1 tmp-name3)))
2543 :
2544 : ;; Cleanup.
2545 2 : (ignore-errors
2546 2 : (delete-file tmp-name1)
2547 2 : (delete-file tmp-name2)))
2548 :
2549 : ;; Check `add-name-to-file'.
2550 2 : (unwind-protect
2551 2 : (progn
2552 2 : (write-region "foo" nil tmp-name1)
2553 2 : (should (file-exists-p tmp-name1))
2554 2 : (add-name-to-file tmp-name1 tmp-name2)
2555 2 : (should-not (file-symlink-p tmp-name2))
2556 2 : (should-error (add-name-to-file tmp-name1 tmp-name2))
2557 2 : (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
2558 2 : (should-not (file-symlink-p tmp-name2))
2559 : ;; `tmp-name3' is a local file name.
2560 2 : (should-error (add-name-to-file tmp-name1 tmp-name3)))
2561 :
2562 : ;; Cleanup.
2563 2 : (ignore-errors
2564 2 : (delete-file tmp-name1)
2565 2 : (delete-file tmp-name2)))
2566 :
2567 : ;; Check `file-truename'.
2568 2 : (unwind-protect
2569 2 : (progn
2570 2 : (write-region "foo" nil tmp-name1)
2571 2 : (should (file-exists-p tmp-name1))
2572 2 : (make-symbolic-link tmp-name1 tmp-name2)
2573 2 : (should (file-symlink-p tmp-name2))
2574 2 : (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
2575 2 : (should
2576 2 : (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
2577 2 : (should (file-equal-p tmp-name1 tmp-name2)))
2578 2 : (ignore-errors
2579 2 : (delete-file tmp-name1)
2580 2 : (delete-file tmp-name2)))
2581 :
2582 : ;; `file-truename' shall preserve trailing link of directories.
2583 2 : (unless (file-symlink-p tramp-test-temporary-file-directory)
2584 2 : (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
2585 2 : (dir2 (file-name-as-directory dir1)))
2586 2 : (should (string-equal (file-truename dir1) (expand-file-name dir1)))
2587 2 : (should
2588 2 : (string-equal (file-truename dir2) (expand-file-name dir2))))))))
2589 :
2590 : (ert-deftest tramp-test22-file-times ()
2591 : "Check `set-file-times' and `file-newer-than-file-p'."
2592 1 : (skip-unless (tramp--test-enabled))
2593 1 : (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2594 :
2595 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2596 2 : (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
2597 2 : (tmp-name2 (tramp--test-make-temp-name nil quoted))
2598 2 : (tmp-name3 (tramp--test-make-temp-name nil quoted)))
2599 2 : (unwind-protect
2600 2 : (progn
2601 2 : (write-region "foo" nil tmp-name1)
2602 2 : (should (file-exists-p tmp-name1))
2603 2 : (should (consp (nth 5 (file-attributes tmp-name1))))
2604 : ;; '(0 0) means don't know, and will be replaced by
2605 : ;; `current-time'. Therefore, we use '(0 1). We skip the
2606 : ;; test, if the remote handler is not able to set the
2607 : ;; correct time.
2608 2 : (skip-unless (set-file-times tmp-name1 '(0 1)))
2609 : ;; Dumb remote shells without perl(1) or stat(1) are not
2610 : ;; able to return the date correctly. They say "don't know".
2611 2 : (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
2612 2 : (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
2613 2 : (write-region "bla" nil tmp-name2)
2614 2 : (should (file-exists-p tmp-name2))
2615 2 : (should (file-newer-than-file-p tmp-name2 tmp-name1))
2616 : ;; `tmp-name3' does not exist.
2617 2 : (should (file-newer-than-file-p tmp-name2 tmp-name3))
2618 2 : (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
2619 :
2620 : ;; Cleanup.
2621 2 : (ignore-errors
2622 2 : (delete-file tmp-name1)
2623 2 : (delete-file tmp-name2))))))
2624 :
2625 : (ert-deftest tramp-test23-visited-file-modtime ()
2626 : "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
2627 1 : (skip-unless (tramp--test-enabled))
2628 :
2629 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2630 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2631 2 : (unwind-protect
2632 2 : (progn
2633 2 : (write-region "foo" nil tmp-name)
2634 2 : (should (file-exists-p tmp-name))
2635 2 : (with-temp-buffer
2636 2 : (insert-file-contents tmp-name)
2637 2 : (should (verify-visited-file-modtime))
2638 2 : (set-visited-file-modtime '(0 1))
2639 2 : (should (verify-visited-file-modtime))
2640 2 : (should (equal (visited-file-modtime) '(0 1 0 0)))))
2641 :
2642 : ;; Cleanup.
2643 2 : (ignore-errors (delete-file tmp-name))))))
2644 :
2645 : (ert-deftest tramp-test24-file-name-completion ()
2646 : "Check `file-name-completion' and `file-name-all-completions'."
2647 1 : (skip-unless (tramp--test-enabled))
2648 :
2649 : ;; Method and host name in completion mode. This kind of completion
2650 : ;; does not work on MS Windows.
2651 1 : (when (not (memq system-type '(cygwin windows-nt)))
2652 1 : (let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
2653 1 : (host (file-remote-p tramp-test-temporary-file-directory 'host))
2654 1 : (orig-syntax tramp-syntax))
2655 1 : (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
2656 1 : (setq host (match-string 1 host)))
2657 :
2658 1 : (unwind-protect
2659 1 : (dolist
2660 : (syntax
2661 1 : (if tramp--test-expensive-test
2662 1 : (tramp-syntax-values) `(,orig-syntax)))
2663 3 : (tramp-change-syntax syntax)
2664 3 : (let ;; This is needed for the `simplified' syntax.
2665 : ((method-marker
2666 3 : (if (zerop (length (tramp-method-regexp)))
2667 3 : "" tramp-default-method-marker))
2668 : ;; This is needed for the `separate' syntax.
2669 3 : (prefix-format (substring (tramp-prefix-format) 1)))
2670 : ;; Complete method name.
2671 3 : (unless (or (zerop (length method))
2672 3 : (zerop (length (tramp-method-regexp))))
2673 2 : (should
2674 2 : (member
2675 2 : (concat prefix-format method (tramp-postfix-method-format))
2676 2 : (file-name-all-completions
2677 3 : (concat prefix-format (substring method 0 1)) "/"))))
2678 : ;; Complete host name for default method. With gvfs
2679 : ;; based methods, host name will be determined as
2680 : ;; host.local, so we omit the test.
2681 3 : (let ((tramp-default-method (or method tramp-default-method)))
2682 3 : (unless (or (zerop (length host))
2683 3 : (tramp--test-gvfs-p tramp-default-method))
2684 3 : (should
2685 3 : (member
2686 3 : (concat
2687 3 : prefix-format method-marker (tramp-postfix-method-format)
2688 3 : host (tramp-postfix-host-format))
2689 3 : (file-name-all-completions
2690 3 : (concat
2691 3 : prefix-format method-marker (tramp-postfix-method-format)
2692 3 : (substring host 0 1))
2693 3 : "/")))))
2694 : ;; Complete host name.
2695 3 : (unless (or (zerop (length method))
2696 3 : (zerop (length (tramp-method-regexp)))
2697 2 : (zerop (length host))
2698 3 : (tramp--test-gvfs-p method))
2699 2 : (should
2700 2 : (member
2701 2 : (concat
2702 2 : prefix-format method (tramp-postfix-method-format)
2703 2 : host (tramp-postfix-host-format))
2704 2 : (file-name-all-completions
2705 2 : (concat prefix-format method (tramp-postfix-method-format))
2706 3 : "/"))))))
2707 :
2708 : ;; Cleanup.
2709 1 : (tramp-change-syntax orig-syntax))))
2710 :
2711 1 : (dolist (n-e '(nil t))
2712 2 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2713 4 : (let ((non-essential n-e)
2714 4 : (tmp-name (tramp--test-make-temp-name nil quoted)))
2715 :
2716 4 : (unwind-protect
2717 4 : (progn
2718 : ;; Local files.
2719 4 : (make-directory tmp-name)
2720 4 : (should (file-directory-p tmp-name))
2721 4 : (write-region "foo" nil (expand-file-name "foo" tmp-name))
2722 4 : (should (file-exists-p (expand-file-name "foo" tmp-name)))
2723 4 : (write-region "bar" nil (expand-file-name "bold" tmp-name))
2724 4 : (should (file-exists-p (expand-file-name "bold" tmp-name)))
2725 4 : (make-directory (expand-file-name "boz" tmp-name))
2726 4 : (should (file-directory-p (expand-file-name "boz" tmp-name)))
2727 4 : (should (equal (file-name-completion "fo" tmp-name) "foo"))
2728 4 : (should (equal (file-name-completion "foo" tmp-name) t))
2729 4 : (should (equal (file-name-completion "b" tmp-name) "bo"))
2730 4 : (should-not (file-name-completion "a" tmp-name))
2731 4 : (should
2732 4 : (equal
2733 4 : (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
2734 4 : (should
2735 4 : (equal (file-name-all-completions "fo" tmp-name) '("foo")))
2736 4 : (should
2737 4 : (equal
2738 4 : (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
2739 4 : '("bold" "boz/")))
2740 4 : (should-not (file-name-all-completions "a" tmp-name))
2741 : ;; `completion-regexp-list' restricts the completion to
2742 : ;; files which match all expressions in this list.
2743 4 : (let ((completion-regexp-list
2744 4 : `(,directory-files-no-dot-files-regexp "b")))
2745 4 : (should
2746 4 : (equal (file-name-completion "" tmp-name) "bo"))
2747 4 : (should
2748 4 : (equal
2749 4 : (sort (file-name-all-completions "" tmp-name) 'string-lessp)
2750 4 : '("bold" "boz/"))))
2751 : ;; `file-name-completion' ignores file names that end in
2752 : ;; any string in `completion-ignored-extensions'.
2753 4 : (let ((completion-ignored-extensions '(".ext")))
2754 4 : (write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
2755 4 : (should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
2756 4 : (should (equal (file-name-completion "fo" tmp-name) "foo"))
2757 4 : (should (equal (file-name-completion "foo" tmp-name) t))
2758 4 : (should
2759 4 : (equal (file-name-completion "foo." tmp-name) "foo.ext"))
2760 4 : (should (equal (file-name-completion "foo.ext" tmp-name) t))
2761 : ;; `file-name-all-completions' is not affected.
2762 4 : (should
2763 4 : (equal
2764 4 : (sort (file-name-all-completions "" tmp-name) 'string-lessp)
2765 4 : '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
2766 :
2767 : ;; Cleanup.
2768 4 : (ignore-errors (delete-directory tmp-name 'recursive)))))))
2769 :
2770 : (ert-deftest tramp-test25-load ()
2771 : "Check `load'."
2772 1 : (skip-unless (tramp--test-enabled))
2773 :
2774 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2775 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
2776 2 : (unwind-protect
2777 2 : (progn
2778 2 : (load tmp-name 'noerror 'nomessage)
2779 2 : (should-not (featurep 'tramp-test-load))
2780 2 : (write-region "(provide 'tramp-test-load)" nil tmp-name)
2781 : ;; `load' in lread.c does not pass `must-suffix'. Why?
2782 : ;;(should-error
2783 : ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
2784 2 : (load tmp-name nil 'nomessage 'nosuffix)
2785 2 : (should (featurep 'tramp-test-load)))
2786 :
2787 : ;; Cleanup.
2788 2 : (ignore-errors
2789 2 : (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
2790 2 : (delete-file tmp-name))))))
2791 :
2792 : (ert-deftest tramp-test26-process-file ()
2793 : "Check `process-file'."
2794 : :tags '(:expensive-test)
2795 1 : (skip-unless (tramp--test-enabled))
2796 1 : (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
2797 :
2798 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2799 2 : (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
2800 2 : (fnnd (file-name-nondirectory tmp-name))
2801 2 : (default-directory tramp-test-temporary-file-directory)
2802 : kill-buffer-query-functions)
2803 2 : (unwind-protect
2804 2 : (progn
2805 : ;; We cannot use "/bin/true" and "/bin/false"; those paths
2806 : ;; do not exist on hydra.
2807 2 : (should (zerop (process-file "true")))
2808 2 : (should-not (zerop (process-file "false")))
2809 2 : (should-not (zerop (process-file "binary-does-not-exist")))
2810 2 : (with-temp-buffer
2811 2 : (write-region "foo" nil tmp-name)
2812 2 : (should (file-exists-p tmp-name))
2813 2 : (should (zerop (process-file "ls" nil t nil fnnd)))
2814 : ;; `ls' could produce colorized output.
2815 2 : (goto-char (point-min))
2816 2 : (while
2817 2 : (re-search-forward tramp-display-escape-sequence-regexp nil t)
2818 2 : (replace-match "" nil nil))
2819 2 : (should (string-equal (format "%s\n" fnnd) (buffer-string)))
2820 2 : (should-not (get-buffer-window (current-buffer) t))
2821 :
2822 : ;; Second run. The output must be appended.
2823 2 : (goto-char (point-max))
2824 2 : (should (zerop (process-file "ls" nil t t fnnd)))
2825 : ;; `ls' could produce colorized output.
2826 2 : (goto-char (point-min))
2827 2 : (while
2828 2 : (re-search-forward tramp-display-escape-sequence-regexp nil t)
2829 2 : (replace-match "" nil nil))
2830 2 : (should
2831 2 : (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
2832 : ;; A non-nil DISPLAY must not raise the buffer.
2833 2 : (should-not (get-buffer-window (current-buffer) t))))
2834 :
2835 : ;; Cleanup.
2836 2 : (ignore-errors (delete-file tmp-name))))))
2837 :
2838 : (ert-deftest tramp-test27-start-file-process ()
2839 : "Check `start-file-process'."
2840 : :tags '(:expensive-test)
2841 1 : (skip-unless (tramp--test-enabled))
2842 1 : (skip-unless (tramp--test-sh-p))
2843 :
2844 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2845 2 : (let ((default-directory tramp-test-temporary-file-directory)
2846 2 : (tmp-name (tramp--test-make-temp-name nil quoted))
2847 : kill-buffer-query-functions proc)
2848 2 : (unwind-protect
2849 2 : (with-temp-buffer
2850 2 : (setq proc (start-file-process "test1" (current-buffer) "cat"))
2851 2 : (should (processp proc))
2852 2 : (should (equal (process-status proc) 'run))
2853 2 : (process-send-string proc "foo")
2854 2 : (process-send-eof proc)
2855 : ;; Read output.
2856 2 : (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2857 4 : (while (< (- (point-max) (point-min)) (length "foo"))
2858 2 : (accept-process-output proc 0.1)))
2859 2 : (should (string-equal (buffer-string) "foo")))
2860 :
2861 : ;; Cleanup.
2862 2 : (ignore-errors (delete-process proc)))
2863 :
2864 2 : (unwind-protect
2865 2 : (with-temp-buffer
2866 2 : (write-region "foo" nil tmp-name)
2867 2 : (should (file-exists-p tmp-name))
2868 2 : (setq proc
2869 2 : (start-file-process
2870 2 : "test2" (current-buffer)
2871 2 : "cat" (file-name-nondirectory tmp-name)))
2872 2 : (should (processp proc))
2873 : ;; Read output.
2874 2 : (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2875 4 : (while (< (- (point-max) (point-min)) (length "foo"))
2876 2 : (accept-process-output proc 0.1)))
2877 2 : (should (string-equal (buffer-string) "foo")))
2878 :
2879 : ;; Cleanup.
2880 2 : (ignore-errors
2881 2 : (delete-process proc)
2882 2 : (delete-file tmp-name)))
2883 :
2884 2 : (unwind-protect
2885 2 : (with-temp-buffer
2886 2 : (setq proc (start-file-process "test3" (current-buffer) "cat"))
2887 2 : (should (processp proc))
2888 2 : (should (equal (process-status proc) 'run))
2889 2 : (set-process-filter
2890 2 : proc
2891 4 : (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
2892 2 : (process-send-string proc "foo")
2893 2 : (process-send-eof proc)
2894 : ;; Read output.
2895 2 : (with-timeout (10 (ert-fail "`start-file-process' timed out"))
2896 4 : (while (< (- (point-max) (point-min)) (length "foo"))
2897 2 : (accept-process-output proc 0.1)))
2898 2 : (should (string-equal (buffer-string) "foo")))
2899 :
2900 : ;; Cleanup.
2901 2 : (ignore-errors (delete-process proc))))))
2902 :
2903 : (ert-deftest tramp-test28-shell-command ()
2904 : "Check `shell-command'."
2905 : :tags '(:expensive-test)
2906 1 : (skip-unless (tramp--test-enabled))
2907 1 : (skip-unless (tramp--test-sh-p))
2908 :
2909 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
2910 2 : (let ((tmp-name (tramp--test-make-temp-name nil quoted))
2911 2 : (default-directory tramp-test-temporary-file-directory)
2912 : ;; Suppress nasty messages.
2913 : (inhibit-message t)
2914 : kill-buffer-query-functions)
2915 2 : (unwind-protect
2916 2 : (with-temp-buffer
2917 2 : (write-region "foo" nil tmp-name)
2918 2 : (should (file-exists-p tmp-name))
2919 2 : (shell-command
2920 2 : (format "ls %s" (file-name-nondirectory tmp-name))
2921 2 : (current-buffer))
2922 : ;; `ls' could produce colorized output.
2923 2 : (goto-char (point-min))
2924 2 : (while
2925 2 : (re-search-forward tramp-display-escape-sequence-regexp nil t)
2926 2 : (replace-match "" nil nil))
2927 2 : (should
2928 2 : (string-equal
2929 2 : (format "%s\n" (file-name-nondirectory tmp-name))
2930 2 : (buffer-string))))
2931 :
2932 : ;; Cleanup.
2933 2 : (ignore-errors (delete-file tmp-name)))
2934 :
2935 2 : (unwind-protect
2936 2 : (with-temp-buffer
2937 2 : (write-region "foo" nil tmp-name)
2938 2 : (should (file-exists-p tmp-name))
2939 2 : (async-shell-command
2940 2 : (format "ls %s" (file-name-nondirectory tmp-name))
2941 2 : (current-buffer))
2942 : ;; Read output.
2943 2 : (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
2944 4 : (while (< (- (point-max) (point-min))
2945 4 : (1+ (length (file-name-nondirectory tmp-name))))
2946 2 : (accept-process-output
2947 2 : (get-buffer-process (current-buffer)) 0.1)))
2948 : ;; `ls' could produce colorized output.
2949 2 : (goto-char (point-min))
2950 2 : (while
2951 2 : (re-search-forward tramp-display-escape-sequence-regexp nil t)
2952 2 : (replace-match "" nil nil))
2953 : ;; There might be a nasty "Process *Async Shell* finished" message.
2954 2 : (goto-char (point-min))
2955 2 : (forward-line)
2956 2 : (narrow-to-region (point-min) (point))
2957 2 : (should
2958 2 : (string-equal
2959 2 : (format "%s\n" (file-name-nondirectory tmp-name))
2960 2 : (buffer-string))))
2961 :
2962 : ;; Cleanup.
2963 2 : (ignore-errors (delete-file tmp-name)))
2964 :
2965 2 : (unwind-protect
2966 2 : (with-temp-buffer
2967 2 : (write-region "foo" nil tmp-name)
2968 2 : (should (file-exists-p tmp-name))
2969 2 : (async-shell-command "read line; ls $line" (current-buffer))
2970 2 : (process-send-string
2971 2 : (get-buffer-process (current-buffer))
2972 2 : (format "%s\n" (file-name-nondirectory tmp-name)))
2973 : ;; Read output.
2974 2 : (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
2975 4 : (while (< (- (point-max) (point-min))
2976 4 : (1+ (length (file-name-nondirectory tmp-name))))
2977 2 : (accept-process-output
2978 2 : (get-buffer-process (current-buffer)) 0.1)))
2979 : ;; `ls' could produce colorized output.
2980 2 : (goto-char (point-min))
2981 2 : (while
2982 2 : (re-search-forward tramp-display-escape-sequence-regexp nil t)
2983 2 : (replace-match "" nil nil))
2984 : ;; There might be a nasty "Process *Async Shell* finished" message.
2985 2 : (goto-char (point-min))
2986 2 : (forward-line)
2987 2 : (narrow-to-region (point-min) (point))
2988 2 : (should
2989 2 : (string-equal
2990 2 : (format "%s\n" (file-name-nondirectory tmp-name))
2991 2 : (buffer-string))))
2992 :
2993 : ;; Cleanup.
2994 2 : (ignore-errors (delete-file tmp-name))))))
2995 :
2996 : (defun tramp--test-shell-command-to-string-asynchronously (command)
2997 : "Like `shell-command-to-string', but for asynchronous processes."
2998 6 : (with-temp-buffer
2999 6 : (async-shell-command command (current-buffer))
3000 6 : (with-timeout (10)
3001 12 : (while (get-buffer-process (current-buffer))
3002 6 : (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
3003 6 : (accept-process-output nil 0.1)
3004 6 : (buffer-substring-no-properties (point-min) (point-max))))
3005 :
3006 : ;; This test is inspired by Bug#23952.
3007 : (ert-deftest tramp-test29-environment-variables ()
3008 : "Check that remote processes set / unset environment variables properly."
3009 : :tags '(:expensive-test)
3010 1 : (skip-unless (tramp--test-enabled))
3011 1 : (skip-unless (tramp--test-sh-p))
3012 :
3013 1 : (dolist (this-shell-command-to-string
3014 : '(;; Synchronously.
3015 : shell-command-to-string
3016 : ;; Asynchronously.
3017 : tramp--test-shell-command-to-string-asynchronously))
3018 :
3019 2 : (let ((default-directory tramp-test-temporary-file-directory)
3020 : (shell-file-name "/bin/sh")
3021 2 : (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3022 : kill-buffer-query-functions)
3023 :
3024 2 : (unwind-protect
3025 : ;; Set a value.
3026 2 : (let ((process-environment
3027 2 : (cons (concat envvar "=foo") process-environment)))
3028 : ;; Default value.
3029 2 : (should
3030 2 : (string-match
3031 : "foo"
3032 2 : (funcall
3033 2 : this-shell-command-to-string
3034 2 : (format "echo -n ${%s:?bla}" envvar))))))
3035 :
3036 2 : (unwind-protect
3037 : ;; Set the empty value.
3038 2 : (let ((process-environment
3039 2 : (cons (concat envvar "=") process-environment)))
3040 : ;; Value is null.
3041 2 : (should
3042 2 : (string-match
3043 : "bla"
3044 2 : (funcall
3045 2 : this-shell-command-to-string
3046 2 : (format "echo -n ${%s:?bla}" envvar))))
3047 : ;; Variable is set.
3048 2 : (should
3049 2 : (string-match
3050 2 : (regexp-quote envvar)
3051 2 : (funcall this-shell-command-to-string "set")))))
3052 :
3053 : ;; We force a reconnect, in order to have a clean environment.
3054 2 : (tramp-cleanup-connection
3055 2 : (tramp-dissect-file-name tramp-test-temporary-file-directory)
3056 2 : 'keep-debug 'keep-password)
3057 2 : (unwind-protect
3058 : ;; Unset the variable.
3059 2 : (let ((tramp-remote-process-environment
3060 2 : (cons (concat envvar "=foo")
3061 2 : tramp-remote-process-environment)))
3062 : ;; Set the initial value, we want to unset below.
3063 2 : (should
3064 2 : (string-match
3065 : "foo"
3066 2 : (funcall
3067 2 : this-shell-command-to-string
3068 2 : (format "echo -n ${%s:?bla}" envvar))))
3069 2 : (let ((process-environment
3070 2 : (cons envvar process-environment)))
3071 : ;; Variable is unset.
3072 2 : (should
3073 2 : (string-match
3074 : "bla"
3075 2 : (funcall
3076 2 : this-shell-command-to-string
3077 2 : (format "echo -n ${%s:?bla}" envvar))))
3078 : ;; Variable is unset.
3079 2 : (should-not
3080 2 : (string-match
3081 2 : (regexp-quote envvar)
3082 2 : (funcall this-shell-command-to-string "set")))))))))
3083 :
3084 : ;; This test is inspired by Bug#27009.
3085 : (ert-deftest tramp-test29-environment-variables-and-port-numbers ()
3086 : "Check that two connections with separate ports are different."
3087 1 : (skip-unless (tramp--test-enabled))
3088 : ;; We test it only for the mock-up connection; otherwise there might
3089 : ;; be problems with the used ports.
3090 1 : (skip-unless
3091 1 : (and
3092 1 : (eq tramp-syntax 'default)
3093 1 : (string-equal
3094 1 : "mock" (file-remote-p tramp-test-temporary-file-directory 'method))))
3095 :
3096 : ;; We force a reconnect, in order to have a clean environment.
3097 1 : (dolist (dir `(,tramp-test-temporary-file-directory
3098 1 : "/mock:localhost#11111:" "/mock:localhost#22222:"))
3099 3 : (tramp-cleanup-connection
3100 3 : (tramp-dissect-file-name dir) 'keep-debug 'keep-password))
3101 :
3102 1 : (unwind-protect
3103 1 : (dolist (port '(11111 22222))
3104 2 : (let* ((default-directory
3105 2 : (format "/mock:localhost#%d:%s" port temporary-file-directory))
3106 : (shell-file-name "/bin/sh")
3107 2 : (envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
3108 : ;; We cannot use `process-environment', because this
3109 : ;; would be applied in `process-file'.
3110 : (tramp-remote-process-environment
3111 2 : (cons
3112 2 : (format "%s=%d" envvar port)
3113 2 : tramp-remote-process-environment)))
3114 2 : (should
3115 2 : (string-equal
3116 2 : (number-to-string port)
3117 2 : (shell-command-to-string (format "echo -n $%s" envvar))))))
3118 :
3119 : ;; Cleanup.
3120 1 : (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
3121 2 : (tramp-cleanup-connection (tramp-dissect-file-name dir)))))
3122 :
3123 : ;; The functions were introduced in Emacs 26.1.
3124 : (ert-deftest tramp-test30-explicit-shell-file-name ()
3125 : "Check that connection-local `explicit-shell-file-name' is set."
3126 : :tags '(:expensive-test)
3127 1 : (skip-unless (tramp--test-enabled))
3128 1 : (skip-unless (tramp--test-sh-p))
3129 : ;; Since Emacs 26.1.
3130 1 : (skip-unless (and (fboundp 'connection-local-set-profile-variables)
3131 1 : (fboundp 'connection-local-set-profiles)))
3132 :
3133 : ;; `connection-local-set-profile-variables' and
3134 : ;; `connection-local-set-profiles' exists since Emacs 26. We don't
3135 : ;; want to see compiler warnings for older Emacsen.
3136 1 : (let ((default-directory tramp-test-temporary-file-directory)
3137 : explicit-shell-file-name kill-buffer-query-functions)
3138 1 : (unwind-protect
3139 1 : (progn
3140 : ;; `shell-mode' would ruin our test, because it deletes all
3141 : ;; buffer local variables.
3142 1 : (put 'explicit-shell-file-name 'permanent-local t)
3143 : ;; Declare connection-local variable `explicit-shell-file-name'.
3144 1 : (with-no-warnings
3145 1 : (connection-local-set-profile-variables
3146 : 'remote-sh
3147 : '((explicit-shell-file-name . "/bin/sh")
3148 1 : (explicit-sh-args . ("-i"))))
3149 1 : (connection-local-set-profiles
3150 1 : `(:application tramp
3151 1 : :protocol ,(file-remote-p default-directory 'method)
3152 1 : :user ,(file-remote-p default-directory 'user)
3153 1 : :machine ,(file-remote-p default-directory 'host))
3154 1 : 'remote-sh))
3155 :
3156 : ;; Run interactive shell. Since the default directory is
3157 : ;; remote, `explicit-shell-file-name' shall be set in order
3158 : ;; to avoid a question.
3159 1 : (with-current-buffer (get-buffer-create "*shell*")
3160 1 : (ignore-errors (kill-process (current-buffer)))
3161 1 : (should-not explicit-shell-file-name)
3162 1 : (call-interactively 'shell)
3163 1 : (should explicit-shell-file-name)))
3164 :
3165 1 : (put 'explicit-shell-file-name 'permanent-local nil)
3166 1 : (kill-buffer "*shell*"))))
3167 :
3168 : (ert-deftest tramp-test31-vc-registered ()
3169 : "Check `vc-registered'."
3170 : :tags '(:expensive-test)
3171 1 : (skip-unless (tramp--test-enabled))
3172 1 : (skip-unless (tramp--test-sh-p))
3173 :
3174 : ;; TODO: This test fails.
3175 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3176 1 : (let* ((default-directory tramp-test-temporary-file-directory)
3177 1 : (tmp-name1 (tramp--test-make-temp-name nil quoted))
3178 1 : (tmp-name2 (expand-file-name "foo" tmp-name1))
3179 1 : (tramp-remote-process-environment tramp-remote-process-environment)
3180 : (vc-handled-backends
3181 1 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3182 1 : (cond
3183 1 : ((tramp-find-executable
3184 1 : v vc-git-program (tramp-get-remote-path v))
3185 : '(Git))
3186 1 : ((tramp-find-executable
3187 1 : v vc-hg-program (tramp-get-remote-path v))
3188 : '(Hg))
3189 1 : ((tramp-find-executable
3190 1 : v vc-bzr-program (tramp-get-remote-path v))
3191 0 : (setq tramp-remote-process-environment
3192 0 : (cons (format "BZR_HOME=%s"
3193 0 : (file-remote-p tmp-name1 'localname))
3194 0 : tramp-remote-process-environment))
3195 : ;; We must force a reconnect, in order to activate $BZR_HOME.
3196 0 : (tramp-cleanup-connection
3197 0 : (tramp-dissect-file-name tramp-test-temporary-file-directory)
3198 0 : 'keep-debug 'keep-password)
3199 : '(Bzr))
3200 1 : (t nil))))
3201 : ;; Suppress nasty messages.
3202 : (inhibit-message t))
3203 1 : (skip-unless vc-handled-backends)
3204 0 : (unless quoted (tramp--test-message "%s" vc-handled-backends))
3205 :
3206 0 : (unwind-protect
3207 0 : (progn
3208 0 : (make-directory tmp-name1)
3209 0 : (write-region "foo" nil tmp-name2)
3210 0 : (should (file-directory-p tmp-name1))
3211 0 : (should (file-exists-p tmp-name2))
3212 0 : (should-not (vc-registered tmp-name1))
3213 0 : (should-not (vc-registered tmp-name2))
3214 :
3215 0 : (let ((default-directory tmp-name1))
3216 : ;; Create empty repository, and register the file.
3217 : ;; Sometimes, creation of repository fails (bzr!); we
3218 : ;; skip the test then.
3219 0 : (condition-case nil
3220 0 : (vc-create-repo (car vc-handled-backends))
3221 0 : (error (skip-unless nil)))
3222 : ;; The structure of VC-FILESET is not documented. Let's
3223 : ;; hope it won't change.
3224 0 : (condition-case nil
3225 0 : (vc-register
3226 0 : (list (car vc-handled-backends)
3227 0 : (list (file-name-nondirectory tmp-name2))))
3228 : ;; `vc-register' has changed its arguments in Emacs 25.1.
3229 : (error
3230 0 : (vc-register
3231 0 : nil (list (car vc-handled-backends)
3232 0 : (list (file-name-nondirectory tmp-name2))))))
3233 : ;; vc-git uses an own process sentinel, Tramp's sentinel
3234 : ;; for flushing the cache isn't used.
3235 0 : (dired-uncache (concat (file-remote-p default-directory) "/"))
3236 0 : (should (vc-registered (file-name-nondirectory tmp-name2)))))
3237 :
3238 : ;; Cleanup.
3239 0 : (ignore-errors (delete-directory tmp-name1 'recursive))))))
3240 :
3241 : (ert-deftest tramp-test32-make-auto-save-file-name ()
3242 : "Check `make-auto-save-file-name'."
3243 1 : (skip-unless (tramp--test-enabled))
3244 :
3245 1 : (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3246 2 : (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
3247 2 : (tmp-name2 (tramp--test-make-temp-name nil quoted)))
3248 :
3249 2 : (unwind-protect
3250 2 : (progn
3251 : ;; Use default `auto-save-file-name-transforms' mechanism.
3252 2 : (let (tramp-auto-save-directory)
3253 2 : (with-temp-buffer
3254 2 : (setq buffer-file-name tmp-name1)
3255 2 : (should
3256 2 : (string-equal
3257 2 : (make-auto-save-file-name)
3258 : ;; This is taken from original `make-auto-save-file-name'.
3259 : ;; We call `convert-standard-filename', because on
3260 : ;; MS Windows the (local) colons must be replaced by
3261 : ;; exclamation marks.
3262 2 : (convert-standard-filename
3263 2 : (expand-file-name
3264 2 : (format
3265 : "#%s#"
3266 2 : (subst-char-in-string
3267 2 : ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
3268 2 : temporary-file-directory))))))
3269 :
3270 : ;; No mapping.
3271 2 : (let (tramp-auto-save-directory auto-save-file-name-transforms)
3272 2 : (with-temp-buffer
3273 2 : (setq buffer-file-name tmp-name1)
3274 2 : (should
3275 2 : (string-equal
3276 2 : (make-auto-save-file-name)
3277 2 : (funcall
3278 2 : (if quoted 'tramp-compat-file-name-quote 'identity)
3279 2 : (expand-file-name
3280 2 : (format "#%s#" (file-name-nondirectory tmp-name1))
3281 2 : tramp-test-temporary-file-directory))))))
3282 :
3283 : ;; TODO: The following two cases don't work yet.
3284 2 : (when nil
3285 : ;; Use default `tramp-auto-save-directory' mechanism.
3286 0 : (let ((tramp-auto-save-directory tmp-name2))
3287 0 : (with-temp-buffer
3288 0 : (setq buffer-file-name tmp-name1)
3289 0 : (should
3290 0 : (string-equal
3291 0 : (make-auto-save-file-name)
3292 : ;; This is taken from Tramp.
3293 0 : (expand-file-name
3294 0 : (format
3295 : "#%s#"
3296 0 : (tramp-subst-strs-in-string
3297 : '(("_" . "|")
3298 : ("/" . "_a")
3299 : (":" . "_b")
3300 : ("|" . "__")
3301 : ("[" . "_l")
3302 : ("]" . "_r"))
3303 0 : (tramp-compat-file-name-unquote tmp-name1)))
3304 0 : tmp-name2)))
3305 0 : (should (file-directory-p tmp-name2))))
3306 :
3307 : ;; Relative file names shall work, too.
3308 0 : (let ((tramp-auto-save-directory "."))
3309 0 : (with-temp-buffer
3310 0 : (setq buffer-file-name tmp-name1
3311 0 : default-directory tmp-name2)
3312 0 : (should
3313 0 : (string-equal
3314 0 : (make-auto-save-file-name)
3315 : ;; This is taken from Tramp.
3316 0 : (expand-file-name
3317 0 : (format
3318 : "#%s#"
3319 0 : (tramp-subst-strs-in-string
3320 : '(("_" . "|")
3321 : ("/" . "_a")
3322 : (":" . "_b")
3323 : ("|" . "__")
3324 : ("[" . "_l")
3325 : ("]" . "_r"))
3326 0 : (tramp-compat-file-name-unquote tmp-name1)))
3327 0 : tmp-name2)))
3328 2 : (should (file-directory-p tmp-name2)))))
3329 2 : ) ;; TODO
3330 :
3331 : ;; Cleanup.
3332 2 : (ignore-errors (delete-file tmp-name1))
3333 2 : (ignore-errors (delete-directory tmp-name2 'recursive))))))
3334 :
3335 : ;; The functions were introduced in Emacs 26.1.
3336 : (ert-deftest tramp-test33-make-nearby-temp-file ()
3337 : "Check `make-nearby-temp-file' and `temporary-file-directory'."
3338 1 : (skip-unless (tramp--test-enabled))
3339 : ;; Since Emacs 26.1.
3340 1 : (skip-unless
3341 1 : (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
3342 :
3343 : ;; `make-nearby-temp-file' and `temporary-file-directory' exists
3344 : ;; since Emacs 26. We don't want to see compiler warnings for older
3345 : ;; Emacsen.
3346 1 : (let ((default-directory tramp-test-temporary-file-directory)
3347 : tmp-file)
3348 : ;; The remote host shall know a temporary file directory.
3349 1 : (should (stringp (with-no-warnings (temporary-file-directory))))
3350 1 : (should
3351 1 : (string-equal
3352 1 : (file-remote-p default-directory)
3353 1 : (file-remote-p (with-no-warnings (temporary-file-directory)))))
3354 :
3355 : ;; The temporary file shall be located on the remote host.
3356 1 : (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test")))
3357 1 : (should (file-exists-p tmp-file))
3358 1 : (should (file-regular-p tmp-file))
3359 1 : (should
3360 1 : (string-equal
3361 1 : (file-remote-p default-directory)
3362 1 : (file-remote-p tmp-file)))
3363 1 : (delete-file tmp-file)
3364 1 : (should-not (file-exists-p tmp-file))
3365 :
3366 1 : (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test" 'dir)))
3367 1 : (should (file-exists-p tmp-file))
3368 1 : (should (file-directory-p tmp-file))
3369 1 : (delete-directory tmp-file)
3370 1 : (should-not (file-exists-p tmp-file))))
3371 :
3372 : (defun tramp--test-adb-p ()
3373 : "Check, whether the remote host runs Android.
3374 : This requires restrictions of file name syntax."
3375 7 : (tramp-adb-file-name-p tramp-test-temporary-file-directory))
3376 :
3377 : (defun tramp--test-docker-p ()
3378 : "Check, whether the docker method is used.
3379 : This does not support some special file names."
3380 8 : (string-equal
3381 8 : "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
3382 :
3383 : (defun tramp--test-ftp-p ()
3384 : "Check, whether an FTP-like method is used.
3385 : This does not support globbing characters in file names (yet)."
3386 : ;; Globbing characters are ??, ?* and ?\[.
3387 12 : (string-match
3388 12 : "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
3389 :
3390 : (defun tramp--test-gvfs-p (&optional method)
3391 : "Check, whether the remote host runs a GVFS based method.
3392 : This requires restrictions of file name syntax."
3393 38 : (or (member method tramp-gvfs-methods)
3394 38 : (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)))
3395 :
3396 : (defun tramp--test-hpux-p ()
3397 : "Check, whether the remote host runs HP-UX.
3398 : Several special characters do not work properly there."
3399 : ;; We must refill the cache. `file-truename' does it.
3400 8 : (with-parsed-tramp-file-name
3401 8 : (file-truename tramp-test-temporary-file-directory) nil
3402 8 : (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
3403 :
3404 : (defun tramp--test-rsync-p ()
3405 : "Check, whether the rsync method is used.
3406 : This does not support special file names."
3407 8 : (string-equal
3408 8 : "rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
3409 :
3410 : (defun tramp--test-sh-p ()
3411 : "Check, whether the remote host runs a based method from tramp-sh.el."
3412 36 : (eq
3413 36 : (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
3414 36 : 'tramp-sh-file-name-handler))
3415 :
3416 : (defun tramp--test-windows-nt-and-batch ()
3417 : "Check, whether the locale host runs MS Windows in batch mode.
3418 : This does not support special characters."
3419 5 : (and (eq system-type 'windows-nt) noninteractive))
3420 :
3421 : (defun tramp--test-windows-nt-and-pscp-psftp-p ()
3422 : "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
3423 : This does not support utf8 based file transfer."
3424 8 : (and (eq system-type 'windows-nt)
3425 0 : (string-match
3426 0 : (regexp-opt '("pscp" "psftp"))
3427 8 : (file-remote-p tramp-test-temporary-file-directory 'method))))
3428 :
3429 : (defun tramp--test-windows-nt-or-smb-p ()
3430 : "Check, whether the locale or remote host runs MS Windows.
3431 : This requires restrictions of file name syntax."
3432 28 : (or (eq system-type 'windows-nt)
3433 28 : (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
3434 :
3435 : (defun tramp--test-check-files (&rest files)
3436 : "Run a simple but comprehensive test over every file in FILES."
3437 : ;; TODO: The quoted case does not work.
3438 : ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3439 8 : (let (quoted)
3440 : ;; We must use `file-truename' for the temporary directory,
3441 : ;; because it could be located on a symlinked directory. This
3442 : ;; would let the test fail.
3443 8 : (let* ((tramp-test-temporary-file-directory
3444 8 : (file-truename tramp-test-temporary-file-directory))
3445 8 : (tmp-name1 (tramp--test-make-temp-name nil quoted))
3446 8 : (tmp-name2 (tramp--test-make-temp-name 'local quoted))
3447 8 : (files (delq nil files))
3448 8 : (process-environment process-environment))
3449 8 : (unwind-protect
3450 8 : (progn
3451 8 : (make-directory tmp-name1)
3452 8 : (make-directory tmp-name2)
3453 :
3454 8 : (dolist (elt files)
3455 76 : (let* ((file1 (expand-file-name elt tmp-name1))
3456 76 : (file2 (expand-file-name elt tmp-name2))
3457 76 : (file3 (expand-file-name (concat elt "foo") tmp-name1)))
3458 76 : (write-region elt nil file1)
3459 76 : (should (file-exists-p file1))
3460 :
3461 : ;; Check file contents.
3462 76 : (with-temp-buffer
3463 76 : (insert-file-contents file1)
3464 76 : (should (string-equal (buffer-string) elt)))
3465 :
3466 : ;; Copy file both directions.
3467 76 : (copy-file file1 tmp-name2)
3468 76 : (should (file-exists-p file2))
3469 76 : (delete-file file1)
3470 76 : (should-not (file-exists-p file1))
3471 76 : (copy-file file2 tmp-name1)
3472 76 : (should (file-exists-p file1))
3473 :
3474 : ;; Method "smb" supports `make-symbolic-link' only if the
3475 : ;; remote host has CIFS capabilities. tramp-adb.el and
3476 : ;; tramp-gvfs.el do not support symbolic links at all.
3477 76 : (condition-case err
3478 76 : (progn
3479 76 : (make-symbolic-link file1 file3)
3480 76 : (should (file-symlink-p file3))
3481 76 : (should
3482 76 : (string-equal
3483 76 : (expand-file-name file1) (file-truename file3)))
3484 76 : (should
3485 76 : (string-equal
3486 76 : (funcall
3487 76 : (if quoted 'tramp-compat-file-name-quote 'identity)
3488 76 : (car (file-attributes file3)))
3489 76 : (file-remote-p (file-truename file1) 'localname)))
3490 : ;; Check file contents.
3491 76 : (with-temp-buffer
3492 76 : (insert-file-contents file3)
3493 76 : (should (string-equal (buffer-string) elt)))
3494 76 : (delete-file file3))
3495 : (file-error
3496 0 : (should
3497 0 : (string-equal (error-message-string err)
3498 76 : "make-symbolic-link not supported"))))))
3499 :
3500 : ;; Check file names.
3501 8 : (should (equal (directory-files
3502 8 : tmp-name1 nil directory-files-no-dot-files-regexp)
3503 8 : (sort (copy-sequence files) 'string-lessp)))
3504 8 : (should (equal (directory-files
3505 8 : tmp-name2 nil directory-files-no-dot-files-regexp)
3506 8 : (sort (copy-sequence files) 'string-lessp)))
3507 :
3508 : ;; `substitute-in-file-name' could return different
3509 : ;; values. For `adb', there could be strange file
3510 : ;; permissions preventing overwriting a file. We don't
3511 : ;; care in this testcase.
3512 8 : (dolist (elt files)
3513 76 : (let ((file1
3514 76 : (substitute-in-file-name (expand-file-name elt tmp-name1)))
3515 : (file2
3516 76 : (substitute-in-file-name
3517 76 : (expand-file-name elt tmp-name2))))
3518 76 : (ignore-errors (write-region elt nil file1))
3519 76 : (should (file-exists-p file1))
3520 76 : (ignore-errors (write-region elt nil file2 nil 'nomessage))
3521 76 : (should (file-exists-p file2))))
3522 :
3523 8 : (should (equal (directory-files
3524 8 : tmp-name1 nil directory-files-no-dot-files-regexp)
3525 8 : (directory-files
3526 8 : tmp-name2 nil directory-files-no-dot-files-regexp)))
3527 :
3528 : ;; Check directory creation. We use a subdirectory "foo"
3529 : ;; in order to avoid conflicts with previous file name tests.
3530 8 : (dolist (elt files)
3531 76 : (let* ((elt1 (concat elt "foo"))
3532 76 : (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
3533 76 : (file2 (expand-file-name elt file1))
3534 76 : (file3 (expand-file-name elt1 file1)))
3535 76 : (make-directory file1 'parents)
3536 76 : (should (file-directory-p file1))
3537 76 : (write-region elt nil file2)
3538 76 : (should (file-exists-p file2))
3539 76 : (should
3540 76 : (equal
3541 76 : (directory-files
3542 76 : file1 nil directory-files-no-dot-files-regexp)
3543 76 : `(,elt)))
3544 76 : (should
3545 76 : (equal
3546 76 : (caar (directory-files-and-attributes
3547 76 : file1 nil directory-files-no-dot-files-regexp))
3548 76 : elt))
3549 :
3550 : ;; Check symlink in `directory-files-and-attributes'.
3551 76 : (condition-case err
3552 76 : (progn
3553 76 : (make-symbolic-link file2 file3)
3554 76 : (should (file-symlink-p file3))
3555 76 : (should
3556 76 : (string-equal
3557 76 : (caar (directory-files-and-attributes
3558 76 : file1 nil (regexp-quote elt1)))
3559 76 : elt1))
3560 76 : (should
3561 76 : (string-equal
3562 76 : (funcall
3563 76 : (if quoted 'tramp-compat-file-name-quote 'identity)
3564 76 : (cadr (car (directory-files-and-attributes
3565 76 : file1 nil (regexp-quote elt1)))))
3566 76 : (file-remote-p (file-truename file2) 'localname)))
3567 76 : (delete-file file3)
3568 76 : (should-not (file-exists-p file3)))
3569 : (file-error
3570 0 : (should (string-equal (error-message-string err)
3571 76 : "make-symbolic-link not supported"))))
3572 :
3573 76 : (delete-file file2)
3574 76 : (should-not (file-exists-p file2))
3575 76 : (delete-directory file1)
3576 76 : (should-not (file-exists-p file1))))
3577 :
3578 : ;; Check, that environment variables are set correctly.
3579 8 : (when (and tramp--test-expensive-test (tramp--test-sh-p))
3580 8 : (dolist (elt files)
3581 76 : (let ((envvar (concat "VAR_" (upcase (md5 elt))))
3582 76 : (default-directory tramp-test-temporary-file-directory)
3583 76 : (process-environment process-environment))
3584 76 : (setenv envvar elt)
3585 : ;; The value of PS1 could confuse Tramp's detection
3586 : ;; of process output. So we unset it temporarily.
3587 76 : (setenv "PS1")
3588 76 : (with-temp-buffer
3589 76 : (should (zerop (process-file "env" nil t nil)))
3590 76 : (goto-char (point-min))
3591 76 : (should
3592 76 : (re-search-forward
3593 76 : (format
3594 : "^%s=%s$"
3595 76 : (regexp-quote envvar)
3596 76 : (regexp-quote (getenv envvar))))))))))
3597 :
3598 : ;; Cleanup.
3599 8 : (ignore-errors (delete-directory tmp-name1 'recursive))
3600 8 : (ignore-errors (delete-directory tmp-name2 'recursive))))))
3601 :
3602 : (defun tramp--test-special-characters ()
3603 : "Perform the test in `tramp-test34-special-characters*'."
3604 : ;; Newlines, slashes and backslashes in file names are not
3605 : ;; supported. So we don't test. And we don't test the tab
3606 : ;; character on Windows or Cygwin, because the backslash is
3607 : ;; interpreted as a path separator, preventing "\t" from being
3608 : ;; expanded to <TAB>.
3609 4 : (tramp--test-check-files
3610 4 : (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3611 : "foo bar baz"
3612 4 : (if (or (tramp--test-adb-p)
3613 4 : (tramp--test-docker-p)
3614 4 : (eq system-type 'cygwin))
3615 : " foo bar baz "
3616 4 : " foo\tbar baz\t"))
3617 : "$foo$bar$$baz$"
3618 : "-foo-bar-baz-"
3619 : "%foo%bar%baz%"
3620 : "&foo&bar&baz&"
3621 4 : (unless (or (tramp--test-ftp-p)
3622 4 : (tramp--test-gvfs-p)
3623 4 : (tramp--test-windows-nt-or-smb-p))
3624 4 : "?foo?bar?baz?")
3625 4 : (unless (or (tramp--test-ftp-p)
3626 4 : (tramp--test-gvfs-p)
3627 4 : (tramp--test-windows-nt-or-smb-p))
3628 4 : "*foo*bar*baz*")
3629 4 : (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3630 : "'foo'bar'baz'"
3631 4 : "'foo\"bar'baz\"")
3632 : "#foo~bar#baz~"
3633 4 : (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3634 : "!foo!bar!baz!"
3635 4 : "!foo|bar!baz|")
3636 4 : (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3637 : ";foo;bar;baz;"
3638 4 : ":foo;bar:baz;")
3639 4 : (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
3640 4 : "<foo>bar<baz>")
3641 : "(foo)bar(baz)"
3642 4 : (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
3643 4 : "{foo}bar{baz}"))
3644 :
3645 : ;; These tests are inspired by Bug#17238.
3646 : (ert-deftest tramp-test34-special-characters ()
3647 : "Check special characters in file names."
3648 1 : (skip-unless (tramp--test-enabled))
3649 1 : (skip-unless (not (tramp--test-rsync-p)))
3650 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3651 :
3652 1 : (tramp--test-special-characters))
3653 :
3654 : (ert-deftest tramp-test34-special-characters-with-stat ()
3655 : "Check special characters in file names.
3656 : Use the `stat' command."
3657 : :tags '(:expensive-test)
3658 1 : (skip-unless (tramp--test-enabled))
3659 1 : (skip-unless (tramp--test-sh-p))
3660 1 : (skip-unless (not (tramp--test-rsync-p)))
3661 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3662 1 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3663 1 : (skip-unless (tramp-get-remote-stat v)))
3664 :
3665 1 : (let ((tramp-connection-properties
3666 1 : (append
3667 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3668 1 : "perl" nil))
3669 1 : tramp-connection-properties)))
3670 1 : (tramp--test-special-characters)))
3671 :
3672 : (ert-deftest tramp-test34-special-characters-with-perl ()
3673 : "Check special characters in file names.
3674 : Use the `perl' command."
3675 : :tags '(:expensive-test)
3676 1 : (skip-unless (tramp--test-enabled))
3677 1 : (skip-unless (tramp--test-sh-p))
3678 1 : (skip-unless (not (tramp--test-rsync-p)))
3679 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3680 1 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3681 1 : (skip-unless (tramp-get-remote-perl v)))
3682 :
3683 1 : (let ((tramp-connection-properties
3684 1 : (append
3685 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3686 : "stat" nil)
3687 : ;; See `tramp-sh-handle-file-truename'.
3688 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3689 1 : "readlink" nil))
3690 1 : tramp-connection-properties)))
3691 1 : (tramp--test-special-characters)))
3692 :
3693 : (ert-deftest tramp-test34-special-characters-with-ls ()
3694 : "Check special characters in file names.
3695 : Use the `ls' command."
3696 : :tags '(:expensive-test)
3697 1 : (skip-unless (tramp--test-enabled))
3698 1 : (skip-unless (tramp--test-sh-p))
3699 1 : (skip-unless (not (tramp--test-rsync-p)))
3700 1 : (skip-unless (not (tramp--test-windows-nt-and-batch)))
3701 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3702 :
3703 1 : (let ((tramp-connection-properties
3704 1 : (append
3705 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3706 : "perl" nil)
3707 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3708 : "stat" nil)
3709 : ;; See `tramp-sh-handle-file-truename'.
3710 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3711 1 : "readlink" nil))
3712 1 : tramp-connection-properties)))
3713 1 : (tramp--test-special-characters)))
3714 :
3715 : (defun tramp--test-utf8 ()
3716 : "Perform the test in `tramp-test35-utf8*'."
3717 4 : (let* ((utf8 (if (and (eq system-type 'darwin)
3718 4 : (memq 'utf-8-hfs (coding-system-list)))
3719 4 : 'utf-8-hfs 'utf-8))
3720 4 : (coding-system-for-read utf8)
3721 4 : (coding-system-for-write utf8)
3722 : (file-name-coding-system
3723 4 : (coding-system-change-eol-conversion utf8 'unix)))
3724 4 : (tramp--test-check-files
3725 4 : (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
3726 4 : (unless (tramp--test-hpux-p)
3727 4 : "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
3728 : "银河系漫游指南系列"
3729 4 : "Автостопом по гала́ктике")))
3730 :
3731 : (ert-deftest tramp-test35-utf8 ()
3732 : "Check UTF8 encoding in file names and file contents."
3733 1 : (skip-unless (tramp--test-enabled))
3734 1 : (skip-unless (not (tramp--test-docker-p)))
3735 1 : (skip-unless (not (tramp--test-rsync-p)))
3736 1 : (skip-unless (not (tramp--test-windows-nt-and-batch)))
3737 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3738 :
3739 1 : (tramp--test-utf8))
3740 :
3741 : (ert-deftest tramp-test35-utf8-with-stat ()
3742 : "Check UTF8 encoding in file names and file contents.
3743 : Use the `stat' command."
3744 : :tags '(:expensive-test)
3745 1 : (skip-unless (tramp--test-enabled))
3746 1 : (skip-unless (tramp--test-sh-p))
3747 1 : (skip-unless (not (tramp--test-docker-p)))
3748 1 : (skip-unless (not (tramp--test-rsync-p)))
3749 1 : (skip-unless (not (tramp--test-windows-nt-and-batch)))
3750 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3751 1 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3752 1 : (skip-unless (tramp-get-remote-stat v)))
3753 :
3754 1 : (let ((tramp-connection-properties
3755 1 : (append
3756 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3757 1 : "perl" nil))
3758 1 : tramp-connection-properties)))
3759 1 : (tramp--test-utf8)))
3760 :
3761 : (ert-deftest tramp-test35-utf8-with-perl ()
3762 : "Check UTF8 encoding in file names and file contents.
3763 : Use the `perl' command."
3764 : :tags '(:expensive-test)
3765 1 : (skip-unless (tramp--test-enabled))
3766 1 : (skip-unless (tramp--test-sh-p))
3767 1 : (skip-unless (not (tramp--test-docker-p)))
3768 1 : (skip-unless (not (tramp--test-rsync-p)))
3769 1 : (skip-unless (not (tramp--test-windows-nt-and-batch)))
3770 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3771 1 : (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
3772 1 : (skip-unless (tramp-get-remote-perl v)))
3773 :
3774 1 : (let ((tramp-connection-properties
3775 1 : (append
3776 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3777 : "stat" nil)
3778 : ;; See `tramp-sh-handle-file-truename'.
3779 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3780 1 : "readlink" nil))
3781 1 : tramp-connection-properties)))
3782 1 : (tramp--test-utf8)))
3783 :
3784 : (ert-deftest tramp-test35-utf8-with-ls ()
3785 : "Check UTF8 encoding in file names and file contents.
3786 : Use the `ls' command."
3787 : :tags '(:expensive-test)
3788 1 : (skip-unless (tramp--test-enabled))
3789 1 : (skip-unless (tramp--test-sh-p))
3790 1 : (skip-unless (not (tramp--test-docker-p)))
3791 1 : (skip-unless (not (tramp--test-rsync-p)))
3792 1 : (skip-unless (not (tramp--test-windows-nt-and-batch)))
3793 1 : (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
3794 :
3795 1 : (let ((tramp-connection-properties
3796 1 : (append
3797 1 : `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3798 : "perl" nil)
3799 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3800 : "stat" nil)
3801 : ;; See `tramp-sh-handle-file-truename'.
3802 1 : (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
3803 1 : "readlink" nil))
3804 1 : tramp-connection-properties)))
3805 1 : (tramp--test-utf8)))
3806 :
3807 : (defun tramp--test-timeout-handler ()
3808 : (interactive)
3809 0 : (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
3810 :
3811 : ;; This test is inspired by Bug#16928.
3812 : (ert-deftest tramp-test36-asynchronous-requests ()
3813 : "Check parallel asynchronous requests.
3814 : Such requests could arrive from timers, process filters and
3815 : process sentinels. They shall not disturb each other."
3816 : :tags '(:expensive-test)
3817 1 : (skip-unless (tramp--test-enabled))
3818 1 : (skip-unless (tramp--test-sh-p))
3819 :
3820 : ;; This test could be blocked on hydra. So we set a timeout of 300
3821 : ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
3822 1 : (with-timeout (300 (tramp--test-timeout-handler))
3823 1 : (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler)
3824 1 : (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
3825 1 : (let* (;; For the watchdog.
3826 1 : (default-directory (expand-file-name temporary-file-directory))
3827 : (watchdog
3828 1 : (start-process
3829 1 : "*watchdog*" nil shell-file-name shell-command-switch
3830 1 : (format "sleep 300; kill -USR1 %d" (emacs-pid))))
3831 1 : (tmp-name (tramp--test-make-temp-name))
3832 1 : (default-directory tmp-name)
3833 : ;; Do not cache Tramp properties.
3834 : (remote-file-name-inhibit-cache t)
3835 : (process-file-side-effects t)
3836 : ;; Suppress nasty messages.
3837 : (inhibit-message t)
3838 : ;; Do not run delayed timers.
3839 : (timer-max-repeats 0)
3840 : ;; Number of asynchronous processes for test.
3841 : (number-proc 10)
3842 : ;; On hydra, timings are bad.
3843 : (timer-repeat
3844 1 : (cond
3845 1 : ((getenv "EMACS_HYDRA_CI") 10)
3846 1 : (t 1)))
3847 : ;; We must distinguish due to performance reasons.
3848 : (timer-operation
3849 1 : (cond
3850 1 : ((string-equal "mock" (file-remote-p tmp-name 'method))
3851 : 'vc-registered)
3852 1 : (t 'file-attributes)))
3853 : timer buffers kill-buffer-query-functions)
3854 :
3855 1 : (unwind-protect
3856 1 : (progn
3857 1 : (make-directory tmp-name)
3858 :
3859 : ;; Setup a timer in order to raise an ordinary command
3860 : ;; again and again. `vc-registered' is well suited,
3861 : ;; because there are many checks.
3862 1 : (setq
3863 : timer
3864 1 : (run-at-time
3865 1 : 0 timer-repeat
3866 : (lambda ()
3867 12 : (when buffers
3868 12 : (let ((time (float-time))
3869 12 : (default-directory tmp-name)
3870 : (file
3871 12 : (buffer-name (nth (random (length buffers)) buffers))))
3872 12 : (tramp--test-message
3873 12 : "Start timer %s %s" file (current-time-string))
3874 12 : (funcall timer-operation file)
3875 : ;; Adjust timer if it takes too much time.
3876 12 : (when (> (- (float-time) time) timer-repeat)
3877 4 : (setq timer-repeat (* 1.5 timer-repeat))
3878 4 : (setf (timer--repeat-delay timer) timer-repeat)
3879 12 : (tramp--test-message "Increase timer %s" timer-repeat))
3880 12 : (tramp--test-message
3881 13 : "Stop timer %s %s" file (current-time-string)))))))
3882 :
3883 : ;; Create temporary buffers. The number of buffers
3884 : ;; corresponds to the number of processes; it could be
3885 : ;; increased in order to make pressure on Tramp.
3886 1 : (dotimes (_i number-proc)
3887 10 : (setq buffers (cons (generate-new-buffer "foo") buffers)))
3888 :
3889 : ;; Open asynchronous processes. Set process filter and sentinel.
3890 1 : (dolist (buf buffers)
3891 : ;; Activate timer.
3892 10 : (sit-for 0.01 'nodisp)
3893 10 : (let ((proc
3894 10 : (start-file-process-shell-command
3895 10 : (buffer-name buf) buf
3896 10 : (concat
3897 : "(read line && echo $line >$line);"
3898 : "(read line && cat $line);"
3899 10 : "(read line && rm $line)")))
3900 10 : (file (expand-file-name (buffer-name buf))))
3901 : ;; Remember the file name. Add counter.
3902 10 : (process-put proc 'foo file)
3903 10 : (process-put proc 'bar 0)
3904 : ;; Add process filter.
3905 10 : (set-process-filter
3906 10 : proc
3907 : (lambda (proc string)
3908 10 : (with-current-buffer (process-buffer proc)
3909 10 : (insert string))
3910 10 : (unless (zerop (length string))
3911 20 : (should (file-attributes (process-get proc 'foo))))))
3912 : ;; Add process sentinel.
3913 10 : (set-process-sentinel
3914 10 : proc
3915 : (lambda (proc _state)
3916 20 : (should-not (file-attributes (process-get proc 'foo)))))))
3917 :
3918 : ;; Send a string. Use a random order of the buffers. Mix
3919 : ;; with regular operation.
3920 1 : (let ((buffers (copy-sequence buffers)))
3921 31 : (while buffers
3922 : ;; Activate timer.
3923 30 : (sit-for 0.01 'nodisp)
3924 30 : (let* ((buf (nth (random (length buffers)) buffers))
3925 30 : (proc (get-buffer-process buf))
3926 30 : (file (process-get proc 'foo))
3927 30 : (count (process-get proc 'bar)))
3928 30 : (tramp--test-message
3929 30 : "Start action %d %s %s" count buf (current-time-string))
3930 : ;; Regular operation prior process action.
3931 30 : (if (= count 0)
3932 10 : (should-not (file-attributes file))
3933 30 : (should (file-attributes file)))
3934 : ;; Send string to process.
3935 30 : (process-send-string proc (format "%s\n" (buffer-name buf)))
3936 30 : (accept-process-output proc 0.1 nil 0)
3937 : ;; Give the watchdog a chance.
3938 30 : (read-event nil nil 0.01)
3939 : ;; Regular operation post process action.
3940 30 : (if (= count 2)
3941 10 : (should-not (file-attributes file))
3942 30 : (should (file-attributes file)))
3943 30 : (tramp--test-message
3944 30 : "Stop action %d %s %s" count buf (current-time-string))
3945 30 : (process-put proc 'bar (1+ count))
3946 30 : (unless (process-live-p proc)
3947 30 : (setq buffers (delq buf buffers))))))
3948 :
3949 : ;; Checks. All process output shall exists in the
3950 : ;; respective buffers. All created files shall be
3951 : ;; deleted.
3952 1 : (tramp--test-message "Check %s" (current-time-string))
3953 1 : (dolist (buf buffers)
3954 10 : (with-current-buffer buf
3955 10 : (should (string-equal (format "%s\n" buf) (buffer-string)))))
3956 1 : (should-not
3957 1 : (directory-files
3958 1 : tmp-name nil directory-files-no-dot-files-regexp)))
3959 :
3960 : ;; Cleanup.
3961 1 : (define-key special-event-map [sigusr1] 'ignore)
3962 1 : (ignore-errors (quit-process watchdog))
3963 1 : (dolist (buf buffers)
3964 10 : (ignore-errors (delete-process (get-buffer-process buf)))
3965 10 : (ignore-errors (kill-buffer buf)))
3966 1 : (ignore-errors (cancel-timer timer))
3967 1 : (ignore-errors (delete-directory tmp-name 'recursive)))))))
3968 :
3969 : (ert-deftest tramp-test37-recursive-load ()
3970 : "Check that Tramp does not fail due to recursive load."
3971 1 : (skip-unless (tramp--test-enabled))
3972 :
3973 1 : (let ((default-directory (expand-file-name temporary-file-directory)))
3974 1 : (dolist (code
3975 1 : (list
3976 1 : (format
3977 1 : "(expand-file-name %S)" tramp-test-temporary-file-directory)
3978 1 : (format
3979 : "(let ((default-directory %S)) (expand-file-name %S))"
3980 1 : tramp-test-temporary-file-directory
3981 1 : temporary-file-directory)))
3982 2 : (should-not
3983 2 : (string-match
3984 : "Recursive load"
3985 2 : (shell-command-to-string
3986 2 : (format
3987 : "%s -batch -Q -L %s --eval %s"
3988 2 : (expand-file-name invocation-name invocation-directory)
3989 2 : (mapconcat 'shell-quote-argument load-path " -L ")
3990 2 : (shell-quote-argument code))))))))
3991 :
3992 : (ert-deftest tramp-test38-remote-load-path ()
3993 : "Check that Tramp autoloads its packages with remote `load-path'."
3994 : ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
3995 : ;; It shall still work, when a remote file name is in the
3996 : ;; `load-path'.
3997 1 : (let ((default-directory (expand-file-name temporary-file-directory))
3998 : (code
3999 : "(let ((force-load-messages t) \
4000 : (load-path (cons \"/foo:bar:\" load-path))) \
4001 : (tramp-cleanup-all-connections))"))
4002 1 : (should
4003 1 : (string-match
4004 1 : (format
4005 : "Loading %s"
4006 1 : (expand-file-name
4007 1 : "tramp-cmds" (file-name-directory (locate-library "tramp"))))
4008 1 : (shell-command-to-string
4009 1 : (format
4010 : "%s -batch -Q -L %s -l tramp-sh --eval %s"
4011 1 : (expand-file-name invocation-name invocation-directory)
4012 1 : (mapconcat 'shell-quote-argument load-path " -L ")
4013 1 : (shell-quote-argument code)))))))
4014 :
4015 : (ert-deftest tramp-test39-unload ()
4016 : "Check that Tramp and its subpackages unload completely.
4017 : Since it unloads Tramp, it shall be the last test to run."
4018 : :tags '(:expensive-test)
4019 1 : (skip-unless noninteractive)
4020 :
4021 1 : (when (featurep 'tramp)
4022 1 : (unload-feature 'tramp 'force)
4023 : ;; No Tramp feature must be left.
4024 0 : (should-not (featurep 'tramp))
4025 0 : (should-not (all-completions "tramp" (delq 'tramp-tests features)))
4026 : ;; `file-name-handler-alist' must be clean.
4027 0 : (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
4028 : ;; There shouldn't be left a bound symbol, except buffer-local
4029 : ;; variables, and autoload functions. We do not regard our test
4030 : ;; symbols, and the Tramp unload hooks.
4031 0 : (mapatoms
4032 : (lambda (x)
4033 0 : (and (or (and (boundp x) (null (local-variable-if-set-p x)))
4034 0 : (and (functionp x) (null (autoloadp (symbol-function x)))))
4035 0 : (string-match "^tramp" (symbol-name x))
4036 0 : (not (string-match "^tramp--?test" (symbol-name x)))
4037 0 : (not (string-match "unload-hook$" (symbol-name x)))
4038 0 : (ert-fail (format "`%s' still bound" x)))))
4039 : ;; The defstruct `tramp-file-name' and all its internal functions
4040 : ;; shall be purged.
4041 0 : (should-not (cl--find-class 'tramp-file-name))
4042 0 : (mapatoms
4043 : (lambda (x)
4044 0 : (and (functionp x)
4045 0 : (string-match "tramp-file-name" (symbol-name x))
4046 0 : (ert-fail (format "Structure function `%s' still exists" x)))))
4047 : ;; There shouldn't be left a hook function containing a Tramp
4048 : ;; function. We do not regard the Tramp unload hooks.
4049 0 : (mapatoms
4050 : (lambda (x)
4051 0 : (and (boundp x)
4052 0 : (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
4053 0 : (not (string-match "unload-hook$" (symbol-name x)))
4054 0 : (consp (symbol-value x))
4055 0 : (ignore-errors (all-completions "tramp" (symbol-value x)))
4056 0 : (ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
4057 :
4058 : ;; TODO:
4059 :
4060 : ;; * dired-compress-file
4061 : ;; * dired-uncache
4062 : ;; * file-acl
4063 : ;; * file-name-case-insensitive-p
4064 : ;; * file-selinux-context
4065 : ;; * find-backup-file-name
4066 : ;; * set-file-acl
4067 : ;; * set-file-selinux-context
4068 :
4069 : ;; * Work on skipped tests. Make a comment, when it is impossible.
4070 : ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
4071 : ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
4072 : ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
4073 : ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'.
4074 :
4075 : (defun tramp-test-all (&optional interactive)
4076 : "Run all tests for \\[tramp]."
4077 : (interactive "p")
4078 0 : (funcall
4079 0 : (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
4080 :
4081 : (provide 'tramp-tests)
4082 : ;;; tramp-tests.el ends here
|