Commit | Line | Data |
---|---|---|
a213a541 MA |
1 | ;;; tramp-tests.el --- Tests of remote file access |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2013-2014 Free Software Foundation, Inc. |
a213a541 MA |
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 | ||
1c49d6c2 MA |
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. Set | |
1baa1e49 | 25 | ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order |
8ee0219f MA |
26 | ;; to overwrite the default value. If you want to skip tests |
27 | ;; accessing a remote host, set this environment variable to | |
28 | ;; "/dev/null" or whatever is appropriate on your system. | |
a213a541 | 29 | |
8ee0219f MA |
30 | ;; When running the tests in batch mode, it must NOT require an |
31 | ;; interactive password prompt unless the environment variable | |
1baa1e49 | 32 | ;; $REMOTE_ALLOW_PASSWORD is set. |
1c49d6c2 MA |
33 | |
34 | ;; A whole test run can be performed calling the command `tramp-test-all'. | |
a213a541 MA |
35 | |
36 | ;;; Code: | |
37 | ||
38 | (require 'ert) | |
39 | (require 'tramp) | |
581d24e7 MA |
40 | (require 'vc) |
41 | (require 'vc-bzr) | |
42 | (require 'vc-git) | |
43 | (require 'vc-hg) | |
44 | ||
45 | (declare-function tramp-find-executable "tramp-sh") | |
46 | (declare-function tramp-get-remote-path "tramp-sh") | |
162427fe | 47 | (defvar tramp-copy-size-limit) |
a213a541 MA |
48 | |
49 | ;; There is no default value on w32 systems, which could work out of the box. | |
50 | (defconst tramp-test-temporary-file-directory | |
8ee0219f | 51 | (cond |
1baa1e49 | 52 | ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) |
8ee0219f MA |
53 | ((eq system-type 'windows-nt) null-device) |
54 | (t (format "/ssh::%s" temporary-file-directory))) | |
a213a541 MA |
55 | "Temporary directory for Tramp tests.") |
56 | ||
dd7691b7 MA |
57 | (setq password-cache-expiry nil |
58 | tramp-verbose 0 | |
2a2e6726 | 59 | tramp-copy-size-limit nil |
a213a541 | 60 | tramp-message-show-message nil) |
8ee0219f MA |
61 | |
62 | ;; Disable interactive passwords in batch mode. | |
1baa1e49 | 63 | (when (and noninteractive (not (getenv "REMOTE_ALLOW_PASSWORD"))) |
8ee0219f MA |
64 | (defalias 'tramp-read-passwd 'ignore)) |
65 | ||
1c49d6c2 MA |
66 | ;; This shall happen on hydra only. |
67 | (when (getenv "NIX_STORE") | |
68 | (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) | |
a213a541 MA |
69 | |
70 | (defvar tramp--test-enabled-checked nil | |
71 | "Cached result of `tramp--test-enabled'. | |
72 | If the function did run, the value is a cons cell, the `cdr' | |
73 | being the result.") | |
74 | ||
75 | (defun tramp--test-enabled () | |
76 | "Whether remote file access is enabled." | |
77 | (unless (consp tramp--test-enabled-checked) | |
78 | (setq | |
79 | tramp--test-enabled-checked | |
80 | (cons | |
81 | t (ignore-errors | |
82 | (and | |
83 | (file-remote-p tramp-test-temporary-file-directory) | |
84 | (file-directory-p tramp-test-temporary-file-directory) | |
85 | (file-writable-p tramp-test-temporary-file-directory)))))) | |
154ba796 | 86 | |
5b5774e5 | 87 | (when (cdr tramp--test-enabled-checked) |
162427fe | 88 | ;; Cleanup connection. |
154ba796 MA |
89 | (tramp-cleanup-connection |
90 | (tramp-dissect-file-name tramp-test-temporary-file-directory) | |
91 | nil 'keep-password)) | |
92 | ||
a213a541 MA |
93 | ;; Return result. |
94 | (cdr tramp--test-enabled-checked)) | |
95 | ||
2a2e6726 | 96 | (defun tramp--test-make-temp-name (&optional local) |
a213a541 MA |
97 | "Create a temporary file name for test." |
98 | (expand-file-name | |
2a2e6726 MA |
99 | (make-temp-name "tramp-test") |
100 | (if local temporary-file-directory tramp-test-temporary-file-directory))) | |
a213a541 | 101 | |
d9386b0c MA |
102 | (defmacro tramp--instrument-test-case (verbose &rest body) |
103 | "Run BODY with `tramp-verbose' equal VERBOSE. | |
104 | Print the the content of the Tramp debug buffer, if BODY does not | |
105 | eval properly in `should', `should-not' or `should-error'." | |
154ba796 MA |
106 | (declare (indent 1) (debug (natnump body))) |
107 | `(let ((tramp-verbose ,verbose) | |
2a2e6726 | 108 | (tramp-message-show-message t) |
154ba796 | 109 | (tramp-debug-on-error t)) |
d9386b0c | 110 | (condition-case err |
2a2e6726 MA |
111 | ;; In general, we cannot use a timeout here: this would |
112 | ;; prevent traces when the test runs into an error. | |
113 | ; (with-timeout (10 (ert-fail "`tramp--instrument-test-case' timed out")) | |
114 | (progn | |
115 | ,@body) | |
154ba796 MA |
116 | (ert-test-skipped |
117 | (signal (car err) (cdr err))) | |
2a2e6726 | 118 | ((error quit) |
d9386b0c | 119 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil |
154ba796 MA |
120 | (with-current-buffer (tramp-get-connection-buffer v) |
121 | (message "%s" (buffer-string))) | |
d9386b0c MA |
122 | (with-current-buffer (tramp-get-debug-buffer v) |
123 | (message "%s" (buffer-string)))) | |
154ba796 | 124 | (message "%s" err) |
d9386b0c | 125 | (signal (car err) (cdr err)))))) |
d9386b0c | 126 | |
a213a541 MA |
127 | (ert-deftest tramp-test00-availability () |
128 | "Test availability of Tramp functions." | |
129 | :expected-result (if (tramp--test-enabled) :passed :failed) | |
130 | (should (ignore-errors | |
131 | (and | |
132 | (file-remote-p tramp-test-temporary-file-directory) | |
133 | (file-directory-p tramp-test-temporary-file-directory) | |
134 | (file-writable-p tramp-test-temporary-file-directory))))) | |
135 | ||
136 | (ert-deftest tramp-test01-file-name-syntax () | |
137 | "Check remote file name syntax." | |
138 | ;; Simple cases. | |
139 | (should (tramp-tramp-file-p "/method::")) | |
140 | (should (tramp-tramp-file-p "/host:")) | |
141 | (should (tramp-tramp-file-p "/user@:")) | |
142 | (should (tramp-tramp-file-p "/user@host:")) | |
143 | (should (tramp-tramp-file-p "/method:host:")) | |
144 | (should (tramp-tramp-file-p "/method:user@:")) | |
145 | (should (tramp-tramp-file-p "/method:user@host:")) | |
146 | (should (tramp-tramp-file-p "/method:user@email@host:")) | |
147 | ||
148 | ;; Using a port. | |
149 | (should (tramp-tramp-file-p "/host#1234:")) | |
150 | (should (tramp-tramp-file-p "/user@host#1234:")) | |
151 | (should (tramp-tramp-file-p "/method:host#1234:")) | |
152 | (should (tramp-tramp-file-p "/method:user@host#1234:")) | |
153 | ||
154 | ;; Using an IPv4 address. | |
155 | (should (tramp-tramp-file-p "/1.2.3.4:")) | |
156 | (should (tramp-tramp-file-p "/user@1.2.3.4:")) | |
157 | (should (tramp-tramp-file-p "/method:1.2.3.4:")) | |
158 | (should (tramp-tramp-file-p "/method:user@1.2.3.4:")) | |
159 | ||
160 | ;; Using an IPv6 address. | |
161 | (should (tramp-tramp-file-p "/[]:")) | |
162 | (should (tramp-tramp-file-p "/[::1]:")) | |
163 | (should (tramp-tramp-file-p "/user@[::1]:")) | |
164 | (should (tramp-tramp-file-p "/method:[::1]:")) | |
165 | (should (tramp-tramp-file-p "/method:user@[::1]:")) | |
166 | ||
167 | ;; Local file name part. | |
168 | (should (tramp-tramp-file-p "/host:/:")) | |
169 | (should (tramp-tramp-file-p "/method:::")) | |
170 | (should (tramp-tramp-file-p "/method::/path/to/file")) | |
171 | (should (tramp-tramp-file-p "/method::file")) | |
172 | ||
173 | ;; Multihop. | |
174 | (should (tramp-tramp-file-p "/method1:|method2::")) | |
175 | (should (tramp-tramp-file-p "/method1:host1|host2:")) | |
176 | (should (tramp-tramp-file-p "/method1:host1|method2:host2:")) | |
177 | (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:")) | |
178 | (should (tramp-tramp-file-p | |
179 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:")) | |
180 | ||
181 | ;; No strings. | |
182 | (should-not (tramp-tramp-file-p nil)) | |
183 | (should-not (tramp-tramp-file-p 'symbol)) | |
184 | ;; "/:" suppresses file name handlers. | |
185 | (should-not (tramp-tramp-file-p "/::")) | |
186 | (should-not (tramp-tramp-file-p "/:@:")) | |
187 | (should-not (tramp-tramp-file-p "/:[]:")) | |
188 | ;; Multihops require a method. | |
189 | (should-not (tramp-tramp-file-p "/host1|host2:")) | |
190 | ;; Methods or hostnames shall be at least two characters on MS Windows. | |
191 | (when (memq system-type '(cygwin windows-nt)) | |
192 | (should-not (tramp-tramp-file-p "/c:/path/to/file")) | |
193 | (should-not (tramp-tramp-file-p "/c::/path/to/file")))) | |
194 | ||
195 | (ert-deftest tramp-test02-file-name-dissect () | |
196 | "Check remote file name components." | |
197 | (let ((tramp-default-method "default-method") | |
198 | (tramp-default-user "default-user") | |
199 | (tramp-default-host "default-host")) | |
200 | ;; Expand `tramp-default-user' and `tramp-default-host'. | |
201 | (should (string-equal | |
202 | (file-remote-p "/method::") | |
203 | (format "/%s:%s@%s:" "method" "default-user" "default-host"))) | |
204 | (should (string-equal (file-remote-p "/method::" 'method) "method")) | |
205 | (should (string-equal (file-remote-p "/method::" 'user) "default-user")) | |
206 | (should (string-equal (file-remote-p "/method::" 'host) "default-host")) | |
207 | (should (string-equal (file-remote-p "/method::" 'localname) "")) | |
208 | ||
209 | ;; Expand `tramp-default-method' and `tramp-default-user'. | |
210 | (should (string-equal | |
211 | (file-remote-p "/host:") | |
212 | (format "/%s:%s@%s:" "default-method" "default-user" "host"))) | |
213 | (should (string-equal (file-remote-p "/host:" 'method) "default-method")) | |
214 | (should (string-equal (file-remote-p "/host:" 'user) "default-user")) | |
215 | (should (string-equal (file-remote-p "/host:" 'host) "host")) | |
216 | (should (string-equal (file-remote-p "/host:" 'localname) "")) | |
217 | ||
218 | ;; Expand `tramp-default-method' and `tramp-default-host'. | |
219 | (should (string-equal | |
220 | (file-remote-p "/user@:") | |
221 | (format "/%s:%s@%s:" "default-method""user" "default-host"))) | |
222 | (should (string-equal (file-remote-p "/user@:" 'method) "default-method")) | |
223 | (should (string-equal (file-remote-p "/user@:" 'user) "user")) | |
224 | (should (string-equal (file-remote-p "/user@:" 'host) "default-host")) | |
225 | (should (string-equal (file-remote-p "/user@:" 'localname) "")) | |
226 | ||
227 | ;; Expand `tramp-default-method'. | |
228 | (should (string-equal | |
229 | (file-remote-p "/user@host:") | |
230 | (format "/%s:%s@%s:" "default-method" "user" "host"))) | |
231 | (should (string-equal | |
232 | (file-remote-p "/user@host:" 'method) "default-method")) | |
233 | (should (string-equal (file-remote-p "/user@host:" 'user) "user")) | |
234 | (should (string-equal (file-remote-p "/user@host:" 'host) "host")) | |
235 | (should (string-equal (file-remote-p "/user@host:" 'localname) "")) | |
236 | ||
237 | ;; Expand `tramp-default-user'. | |
238 | (should (string-equal | |
239 | (file-remote-p "/method:host:") | |
240 | (format "/%s:%s@%s:" "method" "default-user" "host"))) | |
241 | (should (string-equal (file-remote-p "/method:host:" 'method) "method")) | |
242 | (should (string-equal (file-remote-p "/method:host:" 'user) "default-user")) | |
243 | (should (string-equal (file-remote-p "/method:host:" 'host) "host")) | |
244 | (should (string-equal (file-remote-p "/method:host:" 'localname) "")) | |
245 | ||
246 | ;; Expand `tramp-default-host'. | |
247 | (should (string-equal | |
248 | (file-remote-p "/method:user@:") | |
249 | (format "/%s:%s@%s:" "method" "user" "default-host"))) | |
250 | (should (string-equal (file-remote-p "/method:user@:" 'method) "method")) | |
251 | (should (string-equal (file-remote-p "/method:user@:" 'user) "user")) | |
252 | (should (string-equal (file-remote-p "/method:user@:" 'host) | |
253 | "default-host")) | |
254 | (should (string-equal (file-remote-p "/method:user@:" 'localname) "")) | |
255 | ||
256 | ;; No expansion. | |
257 | (should (string-equal | |
258 | (file-remote-p "/method:user@host:") | |
259 | (format "/%s:%s@%s:" "method" "user" "host"))) | |
260 | (should (string-equal | |
261 | (file-remote-p "/method:user@host:" 'method) "method")) | |
262 | (should (string-equal (file-remote-p "/method:user@host:" 'user) "user")) | |
263 | (should (string-equal (file-remote-p "/method:user@host:" 'host) "host")) | |
264 | (should (string-equal (file-remote-p "/method:user@host:" 'localname) "")) | |
265 | ||
266 | ;; No expansion. | |
267 | (should (string-equal | |
268 | (file-remote-p "/method:user@email@host:") | |
269 | (format "/%s:%s@%s:" "method" "user@email" "host"))) | |
270 | (should (string-equal | |
271 | (file-remote-p "/method:user@email@host:" 'method) "method")) | |
272 | (should (string-equal | |
273 | (file-remote-p "/method:user@email@host:" 'user) "user@email")) | |
274 | (should (string-equal | |
275 | (file-remote-p "/method:user@email@host:" 'host) "host")) | |
276 | (should (string-equal | |
277 | (file-remote-p "/method:user@email@host:" 'localname) "")) | |
278 | ||
279 | ;; Expand `tramp-default-method' and `tramp-default-user'. | |
280 | (should (string-equal | |
281 | (file-remote-p "/host#1234:") | |
282 | (format "/%s:%s@%s:" "default-method" "default-user" "host#1234"))) | |
283 | (should (string-equal | |
284 | (file-remote-p "/host#1234:" 'method) "default-method")) | |
285 | (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user")) | |
286 | (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234")) | |
287 | (should (string-equal (file-remote-p "/host#1234:" 'localname) "")) | |
288 | ||
289 | ;; Expand `tramp-default-method'. | |
290 | (should (string-equal | |
291 | (file-remote-p "/user@host#1234:") | |
292 | (format "/%s:%s@%s:" "default-method" "user" "host#1234"))) | |
293 | (should (string-equal | |
294 | (file-remote-p "/user@host#1234:" 'method) "default-method")) | |
295 | (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user")) | |
296 | (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234")) | |
297 | (should (string-equal (file-remote-p "/user@host#1234:" 'localname) "")) | |
298 | ||
299 | ;; Expand `tramp-default-user'. | |
300 | (should (string-equal | |
301 | (file-remote-p "/method:host#1234:") | |
302 | (format "/%s:%s@%s:" "method" "default-user" "host#1234"))) | |
303 | (should (string-equal | |
304 | (file-remote-p "/method:host#1234:" 'method) "method")) | |
305 | (should (string-equal | |
306 | (file-remote-p "/method:host#1234:" 'user) "default-user")) | |
307 | (should (string-equal | |
308 | (file-remote-p "/method:host#1234:" 'host) "host#1234")) | |
309 | (should (string-equal (file-remote-p "/method:host#1234:" 'localname) "")) | |
310 | ||
311 | ;; No expansion. | |
312 | (should (string-equal | |
313 | (file-remote-p "/method:user@host#1234:") | |
314 | (format "/%s:%s@%s:" "method" "user" "host#1234"))) | |
315 | (should (string-equal | |
316 | (file-remote-p "/method:user@host#1234:" 'method) "method")) | |
317 | (should (string-equal | |
318 | (file-remote-p "/method:user@host#1234:" 'user) "user")) | |
319 | (should (string-equal | |
320 | (file-remote-p "/method:user@host#1234:" 'host) "host#1234")) | |
321 | (should (string-equal | |
322 | (file-remote-p "/method:user@host#1234:" 'localname) "")) | |
323 | ||
324 | ;; Expand `tramp-default-method' and `tramp-default-user'. | |
325 | (should (string-equal | |
326 | (file-remote-p "/1.2.3.4:") | |
327 | (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) | |
328 | (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method")) | |
329 | (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user")) | |
330 | (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4")) | |
331 | (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) "")) | |
332 | ||
333 | ;; Expand `tramp-default-method'. | |
334 | (should (string-equal | |
335 | (file-remote-p "/user@1.2.3.4:") | |
336 | (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4"))) | |
337 | (should (string-equal | |
338 | (file-remote-p "/user@1.2.3.4:" 'method) "default-method")) | |
339 | (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user")) | |
340 | (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4")) | |
341 | (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) "")) | |
342 | ||
343 | ;; Expand `tramp-default-user'. | |
344 | (should (string-equal | |
345 | (file-remote-p "/method:1.2.3.4:") | |
346 | (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4"))) | |
347 | (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method")) | |
348 | (should (string-equal | |
349 | (file-remote-p "/method:1.2.3.4:" 'user) "default-user")) | |
350 | (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4")) | |
351 | (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) "")) | |
352 | ||
353 | ;; No expansion. | |
354 | (should (string-equal | |
355 | (file-remote-p "/method:user@1.2.3.4:") | |
356 | (format "/%s:%s@%s:" "method" "user" "1.2.3.4"))) | |
357 | (should (string-equal | |
358 | (file-remote-p "/method:user@1.2.3.4:" 'method) "method")) | |
359 | (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user")) | |
360 | (should (string-equal | |
361 | (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4")) | |
362 | (should (string-equal | |
363 | (file-remote-p "/method:user@1.2.3.4:" 'localname) "")) | |
364 | ||
927fbd6b MA |
365 | ;; Expand `tramp-default-method', `tramp-default-user' and |
366 | ;; `tramp-default-host'. | |
367 | (should (string-equal | |
368 | (file-remote-p "/[]:") | |
369 | (format | |
370 | "/%s:%s@%s:" "default-method" "default-user" "default-host"))) | |
371 | (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) | |
372 | (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) | |
373 | (should (string-equal (file-remote-p "/[]:" 'host) "default-host")) | |
374 | (should (string-equal (file-remote-p "/[]:" 'localname) "")) | |
375 | ||
376 | ;; Expand `tramp-default-method' and `tramp-default-user'. | |
377 | (let ((tramp-default-host "::1")) | |
378 | (should (string-equal | |
379 | (file-remote-p "/[]:") | |
380 | (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) | |
381 | (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) | |
382 | (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) | |
383 | (should (string-equal (file-remote-p "/[]:" 'host) "::1")) | |
384 | (should (string-equal (file-remote-p "/[]:" 'localname) ""))) | |
a213a541 MA |
385 | |
386 | ;; Expand `tramp-default-method' and `tramp-default-user'. | |
387 | (should (string-equal | |
388 | (file-remote-p "/[::1]:") | |
389 | (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) | |
390 | (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method")) | |
391 | (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user")) | |
392 | (should (string-equal (file-remote-p "/[::1]:" 'host) "::1")) | |
393 | (should (string-equal (file-remote-p "/[::1]:" 'localname) "")) | |
394 | ||
395 | ;; Expand `tramp-default-method'. | |
396 | (should (string-equal | |
397 | (file-remote-p "/user@[::1]:") | |
398 | (format "/%s:%s@%s:" "default-method" "user" "[::1]"))) | |
399 | (should (string-equal | |
400 | (file-remote-p "/user@[::1]:" 'method) "default-method")) | |
401 | (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user")) | |
402 | (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1")) | |
403 | (should (string-equal (file-remote-p "/user@[::1]:" 'localname) "")) | |
404 | ||
405 | ;; Expand `tramp-default-user'. | |
406 | (should (string-equal | |
407 | (file-remote-p "/method:[::1]:") | |
408 | (format "/%s:%s@%s:" "method" "default-user" "[::1]"))) | |
409 | (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method")) | |
410 | (should (string-equal | |
411 | (file-remote-p "/method:[::1]:" 'user) "default-user")) | |
412 | (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1")) | |
413 | (should (string-equal (file-remote-p "/method:[::1]:" 'localname) "")) | |
414 | ||
415 | ;; No expansion. | |
416 | (should (string-equal | |
417 | (file-remote-p "/method:user@[::1]:") | |
418 | (format "/%s:%s@%s:" "method" "user" "[::1]"))) | |
419 | (should (string-equal | |
420 | (file-remote-p "/method:user@[::1]:" 'method) "method")) | |
421 | (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user")) | |
422 | (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1")) | |
423 | (should (string-equal | |
424 | (file-remote-p "/method:user@[::1]:" 'localname) "")) | |
425 | ||
426 | ;; Local file name part. | |
427 | (should (string-equal (file-remote-p "/host:/:" 'localname) "/:")) | |
428 | (should (string-equal (file-remote-p "/method:::" 'localname) ":")) | |
429 | (should (string-equal (file-remote-p "/method:: " 'localname) " ")) | |
430 | (should (string-equal (file-remote-p "/method::file" 'localname) "file")) | |
431 | (should (string-equal | |
432 | (file-remote-p "/method::/path/to/file" 'localname) | |
433 | "/path/to/file")) | |
434 | ||
435 | ;; Multihop. | |
436 | (should | |
437 | (string-equal | |
438 | (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file") | |
439 | (format "/%s:%s@%s:" "method2" "user2" "host2"))) | |
440 | (should | |
441 | (string-equal | |
442 | (file-remote-p | |
443 | "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) | |
444 | "method2")) | |
445 | (should | |
446 | (string-equal | |
447 | (file-remote-p | |
448 | "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) | |
449 | "user2")) | |
450 | (should | |
451 | (string-equal | |
452 | (file-remote-p | |
453 | "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) | |
454 | "host2")) | |
455 | (should | |
456 | (string-equal | |
457 | (file-remote-p | |
458 | "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname) | |
459 | "/path/to/file")) | |
460 | ||
461 | (should | |
462 | (string-equal | |
463 | (file-remote-p | |
464 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file") | |
465 | (format "/%s:%s@%s:" "method3" "user3" "host3"))) | |
466 | (should | |
467 | (string-equal | |
468 | (file-remote-p | |
469 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" | |
470 | 'method) | |
471 | "method3")) | |
472 | (should | |
473 | (string-equal | |
474 | (file-remote-p | |
475 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" | |
476 | 'user) | |
477 | "user3")) | |
478 | (should | |
479 | (string-equal | |
480 | (file-remote-p | |
481 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" | |
482 | 'host) | |
483 | "host3")) | |
484 | (should | |
485 | (string-equal | |
486 | (file-remote-p | |
487 | "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" | |
488 | 'localname) | |
489 | "/path/to/file")))) | |
490 | ||
491 | (ert-deftest tramp-test03-file-name-defaults () | |
492 | "Check default values for some methods." | |
493 | ;; Default values in tramp-adb.el. | |
494 | (should (string-equal (file-remote-p "/adb::" 'host) "")) | |
495 | ;; Default values in tramp-ftp.el. | |
496 | (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp")) | |
497 | (dolist (u '("ftp" "anonymous")) | |
498 | (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp"))) | |
499 | ;; Default values in tramp-gvfs.el. | |
927fbd6b MA |
500 | (when (and (load "tramp-gvfs" 'noerror 'nomessage) |
501 | (symbol-value 'tramp-gvfs-enabled)) | |
502 | (should (string-equal (file-remote-p "/synce::" 'user) nil))) | |
a213a541 MA |
503 | ;; Default values in tramp-gw.el. |
504 | (dolist (m '("tunnel" "socks")) | |
927fbd6b MA |
505 | (should |
506 | (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) | |
a213a541 MA |
507 | ;; Default values in tramp-sh.el. |
508 | (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) | |
509 | (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su"))) | |
510 | (dolist (m '("su" "sudo" "ksu")) | |
511 | (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))) | |
512 | (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) | |
927fbd6b MA |
513 | (should |
514 | (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) | |
a213a541 MA |
515 | ;; Default values in tramp-smb.el. |
516 | (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb")) | |
517 | (should (string-equal (file-remote-p "/smb::" 'user) nil))) | |
518 | ||
519 | (ert-deftest tramp-test04-substitute-in-file-name () | |
520 | "Check `substitute-in-file-name'." | |
521 | (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo")) | |
927fbd6b MA |
522 | (should |
523 | (string-equal | |
524 | (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) | |
525 | (should | |
526 | (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) | |
527 | (should | |
528 | (string-equal | |
529 | (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo")) | |
530 | (should | |
531 | (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) | |
a213a541 MA |
532 | (let (process-environment) |
533 | (should | |
927fbd6b MA |
534 | (string-equal |
535 | (substitute-in-file-name "/method:host:/path/$FOO") | |
536 | "/method:host:/path/$FOO")) | |
a213a541 | 537 | (setenv "FOO" "bla") |
927fbd6b MA |
538 | (should |
539 | (string-equal | |
540 | (substitute-in-file-name "/method:host:/path/$FOO") | |
541 | "/method:host:/path/bla")) | |
542 | (should | |
543 | (string-equal | |
544 | (substitute-in-file-name "/method:host:/path/$$FOO") | |
545 | "/method:host:/path/$FOO")))) | |
a213a541 MA |
546 | |
547 | (ert-deftest tramp-test05-expand-file-name () | |
548 | "Check `expand-file-name'." | |
927fbd6b MA |
549 | (should |
550 | (string-equal | |
551 | (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) | |
552 | (should | |
553 | (string-equal | |
554 | (expand-file-name "/method:host:/path/../file") "/method:host:/file"))) | |
a213a541 MA |
555 | |
556 | (ert-deftest tramp-test06-directory-file-name () | |
557 | "Check `directory-file-name'. | |
558 | This checks also `file-name-as-directory', `file-name-directory' | |
559 | and `file-name-nondirectory'." | |
927fbd6b MA |
560 | (should |
561 | (string-equal | |
562 | (directory-file-name "/method:host:/path/to/file") | |
563 | "/method:host:/path/to/file")) | |
564 | (should | |
565 | (string-equal | |
566 | (directory-file-name "/method:host:/path/to/file/") | |
567 | "/method:host:/path/to/file")) | |
568 | (should | |
569 | (string-equal | |
570 | (file-name-as-directory "/method:host:/path/to/file") | |
571 | "/method:host:/path/to/file/")) | |
572 | (should | |
573 | (string-equal | |
574 | (file-name-as-directory "/method:host:/path/to/file/") | |
575 | "/method:host:/path/to/file/")) | |
576 | (should | |
577 | (string-equal | |
578 | (file-name-directory "/method:host:/path/to/file") | |
579 | "/method:host:/path/to/")) | |
580 | (should | |
581 | (string-equal | |
582 | (file-name-directory "/method:host:/path/to/file/") | |
583 | "/method:host:/path/to/file/")) | |
584 | (should | |
585 | (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) | |
586 | (should | |
587 | (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) | |
588 | (should-not | |
589 | (file-remote-p | |
590 | (unhandled-file-name-directory "/method:host:/path/to/file")))) | |
a213a541 MA |
591 | |
592 | (ert-deftest tramp-test07-file-exists-p () | |
6865f4d5 | 593 | "Check `file-exist-p', `write-region' and `delete-file'." |
1c49d6c2 | 594 | (skip-unless (tramp--test-enabled)) |
0010ca51 | 595 | |
1c49d6c2 MA |
596 | (let ((tmp-name (tramp--test-make-temp-name))) |
597 | (should-not (file-exists-p tmp-name)) | |
598 | (write-region "foo" nil tmp-name) | |
599 | (should (file-exists-p tmp-name)) | |
600 | (delete-file tmp-name) | |
601 | (should-not (file-exists-p tmp-name)))) | |
a213a541 MA |
602 | |
603 | (ert-deftest tramp-test08-file-local-copy () | |
604 | "Check `file-local-copy'." | |
605 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 606 | |
a213a541 MA |
607 | (let ((tmp-name1 (tramp--test-make-temp-name)) |
608 | tmp-name2) | |
609 | (unwind-protect | |
610 | (progn | |
611 | (write-region "foo" nil tmp-name1) | |
612 | (should (setq tmp-name2 (file-local-copy tmp-name1))) | |
613 | (with-temp-buffer | |
614 | (insert-file-contents tmp-name2) | |
615 | (should (string-equal (buffer-string) "foo")))) | |
616 | (ignore-errors | |
617 | (delete-file tmp-name1) | |
618 | (delete-file tmp-name2))))) | |
619 | ||
620 | (ert-deftest tramp-test09-insert-file-contents () | |
621 | "Check `insert-file-contents'." | |
622 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 623 | |
a213a541 MA |
624 | (let ((tmp-name (tramp--test-make-temp-name))) |
625 | (unwind-protect | |
626 | (progn | |
627 | (write-region "foo" nil tmp-name) | |
628 | (with-temp-buffer | |
629 | (insert-file-contents tmp-name) | |
8ee0219f MA |
630 | (should (string-equal (buffer-string) "foo")) |
631 | (insert-file-contents tmp-name) | |
632 | (should (string-equal (buffer-string) "foofoo")) | |
633 | ;; Insert partly. | |
634 | (insert-file-contents tmp-name nil 1 3) | |
635 | (should (string-equal (buffer-string) "oofoofoo")) | |
636 | ;; Replace. | |
637 | (insert-file-contents tmp-name nil nil nil 'replace) | |
a213a541 MA |
638 | (should (string-equal (buffer-string) "foo")))) |
639 | (ignore-errors (delete-file tmp-name))))) | |
640 | ||
641 | (ert-deftest tramp-test10-write-region () | |
642 | "Check `write-region'." | |
643 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 644 | |
a213a541 MA |
645 | (let ((tmp-name (tramp--test-make-temp-name))) |
646 | (unwind-protect | |
647 | (progn | |
648 | (with-temp-buffer | |
649 | (insert "foo") | |
650 | (write-region nil nil tmp-name)) | |
651 | (with-temp-buffer | |
652 | (insert-file-contents tmp-name) | |
8ee0219f MA |
653 | (should (string-equal (buffer-string) "foo"))) |
654 | ;; Append. | |
655 | (with-temp-buffer | |
656 | (insert "bla") | |
657 | (write-region nil nil tmp-name 'append)) | |
658 | (with-temp-buffer | |
659 | (insert-file-contents tmp-name) | |
660 | (should (string-equal (buffer-string) "foobla"))) | |
661 | ;; Write string. | |
662 | (write-region "foo" nil tmp-name) | |
663 | (with-temp-buffer | |
664 | (insert-file-contents tmp-name) | |
665 | (should (string-equal (buffer-string) "foo"))) | |
666 | ;; Write partly. | |
667 | (with-temp-buffer | |
668 | (insert "123456789") | |
669 | (write-region 3 5 tmp-name)) | |
670 | (with-temp-buffer | |
671 | (insert-file-contents tmp-name) | |
2a2e6726 | 672 | (should (string-equal (buffer-string) "34")))) |
162427fe | 673 | (ignore-errors (delete-file tmp-name))))) |
a213a541 MA |
674 | |
675 | (ert-deftest tramp-test11-copy-file () | |
676 | "Check `copy-file'." | |
677 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 678 | |
a213a541 | 679 | (let ((tmp-name1 (tramp--test-make-temp-name)) |
2a2e6726 MA |
680 | (tmp-name2 (tramp--test-make-temp-name)) |
681 | (tmp-name3 (tramp--test-make-temp-name)) | |
682 | (tmp-name4 (tramp--test-make-temp-name 'local)) | |
683 | (tmp-name5 (tramp--test-make-temp-name 'local))) | |
684 | ||
685 | ;; Copy on remote side. | |
a213a541 MA |
686 | (unwind-protect |
687 | (progn | |
688 | (write-region "foo" nil tmp-name1) | |
689 | (copy-file tmp-name1 tmp-name2) | |
690 | (should (file-exists-p tmp-name2)) | |
691 | (with-temp-buffer | |
692 | (insert-file-contents tmp-name2) | |
2a2e6726 MA |
693 | (should (string-equal (buffer-string) "foo"))) |
694 | (should-error (copy-file tmp-name1 tmp-name2)) | |
695 | (copy-file tmp-name1 tmp-name2 'ok) | |
696 | (make-directory tmp-name3) | |
697 | (copy-file tmp-name1 tmp-name3) | |
698 | (should | |
699 | (file-exists-p | |
700 | (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) | |
701 | (ignore-errors (delete-file tmp-name1)) | |
702 | (ignore-errors (delete-file tmp-name2)) | |
703 | (ignore-errors (delete-directory tmp-name3 'recursive))) | |
704 | ||
705 | ;; Copy from remote side to local side. | |
706 | (unwind-protect | |
707 | (progn | |
708 | (write-region "foo" nil tmp-name1) | |
709 | (copy-file tmp-name1 tmp-name4) | |
710 | (should (file-exists-p tmp-name4)) | |
711 | (with-temp-buffer | |
712 | (insert-file-contents tmp-name4) | |
713 | (should (string-equal (buffer-string) "foo"))) | |
714 | (should-error (copy-file tmp-name1 tmp-name4)) | |
715 | (copy-file tmp-name1 tmp-name4 'ok) | |
716 | (make-directory tmp-name5) | |
717 | (copy-file tmp-name1 tmp-name5) | |
718 | (should | |
719 | (file-exists-p | |
720 | (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) | |
721 | (ignore-errors (delete-file tmp-name1)) | |
722 | (ignore-errors (delete-file tmp-name4)) | |
723 | (ignore-errors (delete-directory tmp-name5 'recursive))) | |
724 | ||
725 | ;; Copy from local side to remote side. | |
726 | (unwind-protect | |
727 | (progn | |
728 | (write-region "foo" nil tmp-name4 nil 'nomessage) | |
729 | (copy-file tmp-name4 tmp-name1) | |
730 | (should (file-exists-p tmp-name1)) | |
731 | (with-temp-buffer | |
732 | (insert-file-contents tmp-name1) | |
733 | (should (string-equal (buffer-string) "foo"))) | |
734 | (should-error (copy-file tmp-name4 tmp-name1)) | |
735 | (copy-file tmp-name4 tmp-name1 'ok) | |
736 | (make-directory tmp-name3) | |
737 | (copy-file tmp-name4 tmp-name3) | |
738 | (should | |
739 | (file-exists-p | |
740 | (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) | |
741 | (ignore-errors (delete-file tmp-name1)) | |
742 | (ignore-errors (delete-file tmp-name4)) | |
743 | (ignore-errors (delete-directory tmp-name3 'recursive))))) | |
a213a541 MA |
744 | |
745 | (ert-deftest tramp-test12-rename-file () | |
746 | "Check `rename-file'." | |
747 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 748 | |
a213a541 | 749 | (let ((tmp-name1 (tramp--test-make-temp-name)) |
2a2e6726 MA |
750 | (tmp-name2 (tramp--test-make-temp-name)) |
751 | (tmp-name3 (tramp--test-make-temp-name)) | |
752 | (tmp-name4 (tramp--test-make-temp-name 'local)) | |
753 | (tmp-name5 (tramp--test-make-temp-name 'local))) | |
754 | ||
755 | ;; Rename on remote side. | |
a213a541 MA |
756 | (unwind-protect |
757 | (progn | |
758 | (write-region "foo" nil tmp-name1) | |
759 | (rename-file tmp-name1 tmp-name2) | |
760 | (should-not (file-exists-p tmp-name1)) | |
761 | (should (file-exists-p tmp-name2)) | |
762 | (with-temp-buffer | |
763 | (insert-file-contents tmp-name2) | |
2a2e6726 MA |
764 | (should (string-equal (buffer-string) "foo"))) |
765 | (write-region "foo" nil tmp-name1) | |
766 | (should-error (rename-file tmp-name1 tmp-name2)) | |
767 | (rename-file tmp-name1 tmp-name2 'ok) | |
768 | (should-not (file-exists-p tmp-name1)) | |
769 | (write-region "foo" nil tmp-name1) | |
770 | (make-directory tmp-name3) | |
771 | (rename-file tmp-name1 tmp-name3) | |
772 | (should-not (file-exists-p tmp-name1)) | |
773 | (should | |
774 | (file-exists-p | |
775 | (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) | |
776 | (ignore-errors (delete-file tmp-name1)) | |
777 | (ignore-errors (delete-file tmp-name2)) | |
778 | (ignore-errors (delete-directory tmp-name3 'recursive))) | |
779 | ||
780 | ;; Rename from remote side to local side. | |
781 | (unwind-protect | |
782 | (progn | |
783 | (write-region "foo" nil tmp-name1) | |
784 | (rename-file tmp-name1 tmp-name4) | |
785 | (should-not (file-exists-p tmp-name1)) | |
786 | (should (file-exists-p tmp-name4)) | |
787 | (with-temp-buffer | |
788 | (insert-file-contents tmp-name4) | |
789 | (should (string-equal (buffer-string) "foo"))) | |
790 | (write-region "foo" nil tmp-name1) | |
791 | (should-error (rename-file tmp-name1 tmp-name4)) | |
792 | (rename-file tmp-name1 tmp-name4 'ok) | |
793 | (should-not (file-exists-p tmp-name1)) | |
794 | (write-region "foo" nil tmp-name1) | |
795 | (make-directory tmp-name5) | |
796 | (rename-file tmp-name1 tmp-name5) | |
797 | (should-not (file-exists-p tmp-name1)) | |
798 | (should | |
799 | (file-exists-p | |
800 | (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) | |
801 | (ignore-errors (delete-file tmp-name1)) | |
802 | (ignore-errors (delete-file tmp-name4)) | |
803 | (ignore-errors (delete-directory tmp-name5 'recursive))) | |
804 | ||
805 | ;; Rename from local side to remote side. | |
806 | (unwind-protect | |
807 | (progn | |
808 | (write-region "foo" nil tmp-name4 nil 'nomessage) | |
809 | (rename-file tmp-name4 tmp-name1) | |
810 | (should-not (file-exists-p tmp-name4)) | |
811 | (should (file-exists-p tmp-name1)) | |
812 | (with-temp-buffer | |
813 | (insert-file-contents tmp-name1) | |
814 | (should (string-equal (buffer-string) "foo"))) | |
815 | (write-region "foo" nil tmp-name4 nil 'nomessage) | |
816 | (should-error (rename-file tmp-name4 tmp-name1)) | |
817 | (rename-file tmp-name4 tmp-name1 'ok) | |
818 | (should-not (file-exists-p tmp-name4)) | |
819 | (write-region "foo" nil tmp-name4 nil 'nomessage) | |
820 | (make-directory tmp-name3) | |
821 | (rename-file tmp-name4 tmp-name3) | |
822 | (should-not (file-exists-p tmp-name4)) | |
823 | (should | |
824 | (file-exists-p | |
825 | (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) | |
826 | (ignore-errors (delete-file tmp-name1)) | |
827 | (ignore-errors (delete-file tmp-name4)) | |
828 | (ignore-errors (delete-directory tmp-name3 'recursive))))) | |
a213a541 MA |
829 | |
830 | (ert-deftest tramp-test13-make-directory () | |
831 | "Check `make-directory'. | |
832 | This tests also `file-directory-p' and `file-accessible-directory-p'." | |
833 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 834 | |
a213a541 MA |
835 | (let ((tmp-name (tramp--test-make-temp-name))) |
836 | (unwind-protect | |
837 | (progn | |
838 | (make-directory tmp-name) | |
839 | (should (file-directory-p tmp-name)) | |
840 | (should (file-accessible-directory-p tmp-name))) | |
841 | (ignore-errors (delete-directory tmp-name))))) | |
842 | ||
843 | (ert-deftest tramp-test14-delete-directory () | |
844 | "Check `delete-directory'." | |
845 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 846 | |
a213a541 MA |
847 | (let ((tmp-name (tramp--test-make-temp-name))) |
848 | ;; Delete empty directory. | |
849 | (make-directory tmp-name) | |
850 | (should (file-directory-p tmp-name)) | |
851 | (delete-directory tmp-name) | |
852 | (should-not (file-directory-p tmp-name)) | |
853 | ;; Delete non-empty directory. | |
854 | (make-directory tmp-name) | |
855 | (write-region "foo" nil (expand-file-name "bla" tmp-name)) | |
154ba796 | 856 | (should-error (delete-directory tmp-name) :type 'file-error) |
a213a541 MA |
857 | (delete-directory tmp-name 'recursive) |
858 | (should-not (file-directory-p tmp-name)))) | |
859 | ||
860 | (ert-deftest tramp-test15-copy-directory () | |
861 | "Check `copy-directory'." | |
862 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 863 | |
a213a541 MA |
864 | (let* ((tmp-name1 (tramp--test-make-temp-name)) |
865 | (tmp-name2 (tramp--test-make-temp-name)) | |
866 | (tmp-name3 (expand-file-name | |
867 | (file-name-nondirectory tmp-name1) tmp-name2)) | |
868 | (tmp-name4 (expand-file-name "foo" tmp-name1)) | |
869 | (tmp-name5 (expand-file-name "foo" tmp-name2)) | |
870 | (tmp-name6 (expand-file-name "foo" tmp-name3))) | |
871 | (unwind-protect | |
872 | (progn | |
873 | ;; Copy empty directory. | |
874 | (make-directory tmp-name1) | |
875 | (write-region "foo" nil tmp-name4) | |
876 | (should (file-directory-p tmp-name1)) | |
877 | (should (file-exists-p tmp-name4)) | |
5b5774e5 | 878 | (copy-directory tmp-name1 tmp-name2) |
a213a541 MA |
879 | (should (file-directory-p tmp-name2)) |
880 | (should (file-exists-p tmp-name5)) | |
881 | ;; Target directory does exist already. | |
5b5774e5 | 882 | (copy-directory tmp-name1 tmp-name2) |
a213a541 MA |
883 | (should (file-directory-p tmp-name3)) |
884 | (should (file-exists-p tmp-name6))) | |
3cd4192f MA |
885 | (ignore-errors |
886 | (delete-directory tmp-name1 'recursive) | |
887 | (delete-directory tmp-name2 'recursive))))) | |
a213a541 MA |
888 | |
889 | (ert-deftest tramp-test16-directory-files () | |
890 | "Check `directory-files'." | |
891 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 892 | |
a213a541 MA |
893 | (let* ((tmp-name1 (tramp--test-make-temp-name)) |
894 | (tmp-name2 (expand-file-name "bla" tmp-name1)) | |
895 | (tmp-name3 (expand-file-name "foo" tmp-name1))) | |
896 | (unwind-protect | |
897 | (progn | |
898 | (make-directory tmp-name1) | |
899 | (write-region "foo" nil tmp-name2) | |
900 | (write-region "bla" nil tmp-name3) | |
901 | (should (file-directory-p tmp-name1)) | |
902 | (should (file-exists-p tmp-name2)) | |
903 | (should (file-exists-p tmp-name3)) | |
904 | (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) | |
905 | (should (equal (directory-files tmp-name1 'full) | |
906 | `(,(concat tmp-name1 "/.") | |
907 | ,(concat tmp-name1 "/..") | |
908 | ,tmp-name2 ,tmp-name3))) | |
909 | (should (equal (directory-files | |
910 | tmp-name1 nil directory-files-no-dot-files-regexp) | |
911 | '("bla" "foo"))) | |
912 | (should (equal (directory-files | |
913 | tmp-name1 'full directory-files-no-dot-files-regexp) | |
914 | `(,tmp-name2 ,tmp-name3)))) | |
3cd4192f | 915 | (ignore-errors (delete-directory tmp-name1 'recursive))))) |
a213a541 MA |
916 | |
917 | (ert-deftest tramp-test17-insert-directory () | |
918 | "Check `insert-directory'." | |
919 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 920 | |
a213a541 MA |
921 | (let* ((tmp-name1 (tramp--test-make-temp-name)) |
922 | (tmp-name2 (expand-file-name "foo" tmp-name1))) | |
923 | (unwind-protect | |
924 | (progn | |
925 | (make-directory tmp-name1) | |
926 | (write-region "foo" nil tmp-name2) | |
927 | (should (file-directory-p tmp-name1)) | |
928 | (should (file-exists-p tmp-name2)) | |
929 | (with-temp-buffer | |
930 | (insert-directory tmp-name1 nil) | |
931 | (goto-char (point-min)) | |
932 | (should (looking-at-p (regexp-quote tmp-name1)))) | |
933 | (with-temp-buffer | |
934 | (insert-directory tmp-name1 "-al") | |
935 | (goto-char (point-min)) | |
936 | (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) | |
937 | (with-temp-buffer | |
938 | (insert-directory (file-name-as-directory tmp-name1) "-al") | |
939 | (goto-char (point-min)) | |
940 | (should | |
941 | (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) | |
942 | (with-temp-buffer | |
943 | (insert-directory | |
944 | (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) | |
945 | (goto-char (point-min)) | |
946 | (should | |
76c92fdd | 947 | (looking-at-p |
d9386b0c | 948 | "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$")))) |
3cd4192f | 949 | (ignore-errors (delete-directory tmp-name1 'recursive))))) |
a213a541 MA |
950 | |
951 | (ert-deftest tramp-test18-file-attributes () | |
952 | "Check `file-attributes'. | |
953 | This tests also `file-readable-p' and `file-regular-p'." | |
954 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 955 | |
a213a541 MA |
956 | (let ((tmp-name (tramp--test-make-temp-name)) |
957 | attr) | |
958 | (unwind-protect | |
959 | (progn | |
960 | (write-region "foo" nil tmp-name) | |
961 | (should (file-exists-p tmp-name)) | |
962 | (setq attr (file-attributes tmp-name)) | |
963 | (should (consp attr)) | |
964 | (should (file-exists-p tmp-name)) | |
965 | (should (file-readable-p tmp-name)) | |
966 | (should (file-regular-p tmp-name)) | |
967 | ;; We do not test inodes and device numbers. | |
968 | (should (null (car attr))) | |
969 | (should (numberp (nth 1 attr))) ;; Link. | |
970 | (should (numberp (nth 2 attr))) ;; Uid. | |
971 | (should (numberp (nth 3 attr))) ;; Gid. | |
972 | ;; Last access time. | |
973 | (should (stringp (current-time-string (nth 4 attr)))) | |
974 | ;; Last modification time. | |
975 | (should (stringp (current-time-string (nth 5 attr)))) | |
976 | ;; Last status change time. | |
977 | (should (stringp (current-time-string (nth 6 attr)))) | |
978 | (should (numberp (nth 7 attr))) ;; Size. | |
979 | (should (stringp (nth 8 attr))) ;; Modes. | |
980 | ||
981 | (setq attr (file-attributes tmp-name 'string)) | |
982 | (should (stringp (nth 2 attr))) ;; Uid. | |
983 | (should (stringp (nth 3 attr))) ;; Gid. | |
984 | (delete-file tmp-name) | |
985 | ||
986 | (make-directory tmp-name) | |
987 | (should (file-exists-p tmp-name)) | |
988 | (should (file-readable-p tmp-name)) | |
989 | (should-not (file-regular-p tmp-name)) | |
990 | (setq attr (file-attributes tmp-name)) | |
991 | (should (eq (car attr) t))) | |
3cd4192f | 992 | (ignore-errors (delete-directory tmp-name))))) |
a213a541 MA |
993 | |
994 | (ert-deftest tramp-test19-directory-files-and-attributes () | |
995 | "Check `directory-files-and-attributes'." | |
996 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 997 | |
154ba796 | 998 | ;; `directory-files-and-attributes' contains also values for "../". |
fbaddd63 | 999 | ;; Ensure that this doesn't change during tests, for |
154ba796 MA |
1000 | ;; example due to handling temporary files. |
1001 | (let* ((tmp-name1 (tramp--test-make-temp-name)) | |
1002 | (tmp-name2 (expand-file-name "bla" tmp-name1)) | |
1003 | attr) | |
a213a541 MA |
1004 | (unwind-protect |
1005 | (progn | |
154ba796 MA |
1006 | (make-directory tmp-name1) |
1007 | (should (file-directory-p tmp-name1)) | |
1008 | (make-directory tmp-name2) | |
1009 | (should (file-directory-p tmp-name2)) | |
1010 | (write-region "foo" nil (expand-file-name "foo" tmp-name2)) | |
1011 | (write-region "bar" nil (expand-file-name "bar" tmp-name2)) | |
1012 | (write-region "boz" nil (expand-file-name "boz" tmp-name2)) | |
1013 | (setq attr (directory-files-and-attributes tmp-name2)) | |
a213a541 MA |
1014 | (should (consp attr)) |
1015 | (dolist (elt attr) | |
154ba796 MA |
1016 | (should |
1017 | (equal (file-attributes (expand-file-name (car elt) tmp-name2)) | |
1018 | (cdr elt)))) | |
1019 | (setq attr (directory-files-and-attributes tmp-name2 'full)) | |
a213a541 | 1020 | (dolist (elt attr) |
154ba796 MA |
1021 | (should |
1022 | (equal (file-attributes (car elt)) (cdr elt)))) | |
1023 | (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) | |
a213a541 | 1024 | (should (equal (mapcar 'car attr) '("bar" "boz")))) |
154ba796 | 1025 | (ignore-errors (delete-directory tmp-name1 'recursive))))) |
a213a541 MA |
1026 | |
1027 | (ert-deftest tramp-test20-file-modes () | |
1028 | "Check `file-modes'. | |
1029 | This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |
1030 | (skip-unless (tramp--test-enabled)) | |
76c92fdd MA |
1031 | (skip-unless |
1032 | (not | |
1033 | (memq | |
1034 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
154ba796 MA |
1035 | '(tramp-adb-file-name-handler |
1036 | tramp-gvfs-file-name-handler | |
1037 | tramp-smb-file-name-handler)))) | |
0010ca51 | 1038 | |
8ee0219f | 1039 | (let ((tmp-name (tramp--test-make-temp-name))) |
a213a541 MA |
1040 | (unwind-protect |
1041 | (progn | |
8ee0219f MA |
1042 | (write-region "foo" nil tmp-name) |
1043 | (should (file-exists-p tmp-name)) | |
1044 | (set-file-modes tmp-name #o777) | |
1045 | (should (= (file-modes tmp-name) #o777)) | |
1046 | (should (file-executable-p tmp-name)) | |
1047 | (should (file-writable-p tmp-name)) | |
1048 | (set-file-modes tmp-name #o444) | |
1049 | (should (= (file-modes tmp-name) #o444)) | |
1050 | (should-not (file-executable-p tmp-name)) | |
1051 | ;; A file is always writable for user "root". | |
2a2e6726 | 1052 | (unless (zerop (nth 2 (file-attributes tmp-name))) |
8ee0219f | 1053 | (should-not (file-writable-p tmp-name)))) |
3cd4192f | 1054 | (ignore-errors (delete-file tmp-name))))) |
a213a541 MA |
1055 | |
1056 | (ert-deftest tramp-test21-file-links () | |
1057 | "Check `file-symlink-p'. | |
1058 | This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |
1059 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 1060 | |
a213a541 MA |
1061 | (let ((tmp-name1 (tramp--test-make-temp-name)) |
1062 | (tmp-name2 (tramp--test-make-temp-name)) | |
2a2e6726 | 1063 | (tmp-name3 (tramp--test-make-temp-name 'local))) |
a213a541 MA |
1064 | (unwind-protect |
1065 | (progn | |
1066 | (write-region "foo" nil tmp-name1) | |
1067 | (should (file-exists-p tmp-name1)) | |
76c92fdd MA |
1068 | ;; Method "smb" supports `make-symbolic-link' only if the |
1069 | ;; remote host has CIFS capabilities. tramp-adb.el and | |
1070 | ;; tramp-gvfs.el do not support symbolic links at all. | |
1071 | (condition-case err | |
1072 | (make-symbolic-link tmp-name1 tmp-name2) | |
1073 | (file-error | |
1074 | (skip-unless | |
1075 | (not (string-equal (error-message-string err) | |
1076 | "make-symbolic-link not supported"))))) | |
a213a541 MA |
1077 | (should (file-symlink-p tmp-name2)) |
1078 | (should-error (make-symbolic-link tmp-name1 tmp-name2)) | |
1079 | (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) | |
1080 | (should (file-symlink-p tmp-name2)) | |
1081 | ;; `tmp-name3' is a local file name. | |
1082 | (should-error (make-symbolic-link tmp-name1 tmp-name3))) | |
3cd4192f MA |
1083 | (ignore-errors |
1084 | (delete-file tmp-name1) | |
1085 | (delete-file tmp-name2))) | |
a213a541 MA |
1086 | |
1087 | (unwind-protect | |
1088 | (progn | |
1089 | (write-region "foo" nil tmp-name1) | |
1090 | (should (file-exists-p tmp-name1)) | |
1091 | (add-name-to-file tmp-name1 tmp-name2) | |
1092 | (should-not (file-symlink-p tmp-name2)) | |
1093 | (should-error (add-name-to-file tmp-name1 tmp-name2)) | |
1094 | (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) | |
1095 | (should-not (file-symlink-p tmp-name2)) | |
1096 | ;; `tmp-name3' is a local file name. | |
1097 | (should-error (add-name-to-file tmp-name1 tmp-name3))) | |
3cd4192f MA |
1098 | (ignore-errors |
1099 | (delete-file tmp-name1) | |
1100 | (delete-file tmp-name2))) | |
a213a541 MA |
1101 | |
1102 | (unwind-protect | |
1103 | (progn | |
1104 | (write-region "foo" nil tmp-name1) | |
1105 | (should (file-exists-p tmp-name1)) | |
1106 | (make-symbolic-link tmp-name1 tmp-name2) | |
1107 | (should (file-symlink-p tmp-name2)) | |
927fbd6b MA |
1108 | (should-not (string-equal tmp-name2 (file-truename tmp-name2))) |
1109 | (should | |
2a2e6726 MA |
1110 | (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) |
1111 | (should (file-equal-p tmp-name1 tmp-name2))) | |
3cd4192f MA |
1112 | (ignore-errors |
1113 | (delete-file tmp-name1) | |
154ba796 MA |
1114 | (delete-file tmp-name2))) |
1115 | ||
1116 | ;; `file-truename' shall preserve trailing link of directories. | |
2a2e6726 MA |
1117 | (unless (file-symlink-p tramp-test-temporary-file-directory) |
1118 | (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) | |
1119 | (dir2 (file-name-as-directory dir1))) | |
1120 | (should (string-equal (file-truename dir1) (expand-file-name dir1))) | |
1121 | (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) | |
a213a541 MA |
1122 | |
1123 | (ert-deftest tramp-test22-file-times () | |
1124 | "Check `set-file-times' and `file-newer-than-file-p'." | |
1125 | (skip-unless (tramp--test-enabled)) | |
76c92fdd MA |
1126 | (skip-unless |
1127 | (not | |
1128 | (memq | |
1129 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
1130 | '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) | |
0010ca51 | 1131 | |
a213a541 MA |
1132 | (let ((tmp-name1 (tramp--test-make-temp-name)) |
1133 | (tmp-name2 (tramp--test-make-temp-name)) | |
1134 | (tmp-name3 (tramp--test-make-temp-name))) | |
1135 | (unwind-protect | |
1136 | (progn | |
1137 | (write-region "foo" nil tmp-name1) | |
1138 | (should (file-exists-p tmp-name1)) | |
1139 | (should (consp (nth 5 (file-attributes tmp-name1)))) | |
154ba796 MA |
1140 | ;; '(0 0) means don't know, and will be replaced by |
1141 | ;; `current-time'. Therefore, we use '(0 1). | |
1142 | ;; We skip the test, if the remote handler is not able to | |
1143 | ;; set the correct time. | |
1144 | (skip-unless (set-file-times tmp-name1 '(0 1))) | |
76c92fdd MA |
1145 | ;; Dumb busyboxes are not able to return the date correctly. |
1146 | ;; They say "don't know. | |
1147 | (skip-unless (not (equal (nth 5 (file-attributes tmp-name1)) '(0 0)))) | |
a213a541 MA |
1148 | (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) |
1149 | (write-region "bla" nil tmp-name2) | |
1150 | (should (file-exists-p tmp-name2)) | |
1151 | (should (file-newer-than-file-p tmp-name2 tmp-name1)) | |
1152 | ;; `tmp-name3' does not exist. | |
1153 | (should (file-newer-than-file-p tmp-name2 tmp-name3)) | |
1154 | (should-not (file-newer-than-file-p tmp-name3 tmp-name1))) | |
3cd4192f MA |
1155 | (ignore-errors |
1156 | (delete-file tmp-name1) | |
1157 | (delete-file tmp-name2))))) | |
a213a541 MA |
1158 | |
1159 | (ert-deftest tramp-test23-visited-file-modtime () | |
1160 | "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." | |
1161 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 1162 | |
a213a541 MA |
1163 | (let ((tmp-name (tramp--test-make-temp-name))) |
1164 | (unwind-protect | |
1165 | (progn | |
1166 | (write-region "foo" nil tmp-name) | |
1167 | (should (file-exists-p tmp-name)) | |
1168 | (with-temp-buffer | |
1169 | (insert-file-contents tmp-name) | |
1170 | (should (verify-visited-file-modtime)) | |
1171 | (set-visited-file-modtime '(0 1)) | |
1172 | (should (verify-visited-file-modtime)) | |
1173 | (should (equal (visited-file-modtime) '(0 1 0 0))))) | |
3cd4192f | 1174 | (ignore-errors (delete-file tmp-name))))) |
a213a541 MA |
1175 | |
1176 | (ert-deftest tramp-test24-file-name-completion () | |
1177 | "Check `file-name-completion' and `file-name-all-completions'." | |
1178 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 1179 | |
a213a541 MA |
1180 | (let ((tmp-name (tramp--test-make-temp-name))) |
1181 | (unwind-protect | |
1182 | (progn | |
1183 | (make-directory tmp-name) | |
1184 | (should (file-directory-p tmp-name)) | |
1185 | (write-region "foo" nil (expand-file-name "foo" tmp-name)) | |
1186 | (write-region "bar" nil (expand-file-name "bold" tmp-name)) | |
1187 | (make-directory (expand-file-name "boz" tmp-name)) | |
1188 | (should (equal (file-name-completion "fo" tmp-name) "foo")) | |
1189 | (should (equal (file-name-completion "b" tmp-name) "bo")) | |
1190 | (should | |
1191 | (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) | |
1192 | (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) | |
1193 | (should | |
1194 | (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) | |
1195 | '("bold" "boz/")))) | |
3cd4192f | 1196 | (ignore-errors (delete-directory tmp-name 'recursive))))) |
a213a541 MA |
1197 | |
1198 | (ert-deftest tramp-test25-load () | |
1199 | "Check `load'." | |
1200 | (skip-unless (tramp--test-enabled)) | |
0010ca51 | 1201 | |
a213a541 MA |
1202 | (let ((tmp-name (tramp--test-make-temp-name))) |
1203 | (unwind-protect | |
1204 | (progn | |
1205 | (load tmp-name 'noerror 'nomessage) | |
1206 | (should-not (featurep 'tramp-test-load)) | |
1207 | (write-region "(provide 'tramp-test-load)" nil tmp-name) | |
1208 | ;; `load' in lread.c does not pass `must-suffix'. Why? | |
1209 | ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) | |
1210 | (load tmp-name nil 'nomessage 'nosuffix) | |
1211 | (should (featurep 'tramp-test-load))) | |
3cd4192f MA |
1212 | (ignore-errors |
1213 | (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) | |
1214 | (delete-file tmp-name))))) | |
a213a541 MA |
1215 | |
1216 | (ert-deftest tramp-test26-process-file () | |
1217 | "Check `process-file'." | |
1218 | (skip-unless (tramp--test-enabled)) | |
76c92fdd MA |
1219 | (skip-unless |
1220 | (not | |
1221 | (memq | |
1222 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
1223 | '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) | |
0010ca51 | 1224 | |
927fbd6b | 1225 | (let ((tmp-name (tramp--test-make-temp-name)) |
154ba796 MA |
1226 | (default-directory tramp-test-temporary-file-directory) |
1227 | kill-buffer-query-functions) | |
927fbd6b MA |
1228 | (unwind-protect |
1229 | (progn | |
1230 | ;; We cannot use "/bin/true" and "/bin/false"; those paths | |
1231 | ;; do not exist on hydra. | |
1232 | (should (zerop (process-file "true"))) | |
1233 | (should-not (zerop (process-file "false"))) | |
1234 | (should-not (zerop (process-file "binary-does-not-exist"))) | |
1235 | (with-temp-buffer | |
1236 | (write-region "foo" nil tmp-name) | |
cad6dfb6 MA |
1237 | (should (file-exists-p tmp-name)) |
1238 | (should | |
1239 | (zerop | |
1240 | (process-file "ls" nil t nil (file-name-nondirectory tmp-name)))) | |
76c92fdd MA |
1241 | ;; `ls' could produce colorized output. |
1242 | (goto-char (point-min)) | |
1243 | (while (re-search-forward tramp-color-escape-sequence-regexp nil t) | |
1244 | (replace-match "" nil nil)) | |
cad6dfb6 MA |
1245 | (should |
1246 | (string-equal | |
1247 | (format "%s\n" (file-name-nondirectory tmp-name)) | |
1248 | (buffer-string))))) | |
3cd4192f | 1249 | (ignore-errors (delete-file tmp-name))))) |
a213a541 MA |
1250 | |
1251 | (ert-deftest tramp-test27-start-file-process () | |
1252 | "Check `start-file-process'." | |
1253 | (skip-unless (tramp--test-enabled)) | |
76c92fdd MA |
1254 | (skip-unless |
1255 | (not | |
1256 | (memq | |
1257 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
154ba796 MA |
1258 | '(tramp-adb-file-name-handler |
1259 | tramp-gvfs-file-name-handler | |
1260 | tramp-smb-file-name-handler)))) | |
0010ca51 | 1261 | |
a213a541 MA |
1262 | (let ((default-directory tramp-test-temporary-file-directory) |
1263 | (tmp-name (tramp--test-make-temp-name)) | |
1264 | kill-buffer-query-functions proc) | |
1265 | (unwind-protect | |
1266 | (with-temp-buffer | |
1267 | (setq proc (start-file-process "test1" (current-buffer) "cat")) | |
1268 | (should (processp proc)) | |
1269 | (should (equal (process-status proc) 'run)) | |
1270 | (process-send-string proc "foo") | |
1271 | (process-send-eof proc) | |
1272 | (accept-process-output proc 1) | |
1273 | (should (string-equal (buffer-string) "foo"))) | |
3cd4192f | 1274 | (ignore-errors (delete-process proc))) |
a213a541 MA |
1275 | |
1276 | (unwind-protect | |
1277 | (with-temp-buffer | |
1278 | (write-region "foo" nil tmp-name) | |
1279 | (should (file-exists-p tmp-name)) | |
1280 | (setq proc | |
1281 | (start-file-process | |
1282 | "test2" (current-buffer) | |
1283 | "cat" (file-name-nondirectory tmp-name))) | |
1284 | (should (processp proc)) | |
1285 | (accept-process-output proc 1) | |
1286 | (should (string-equal (buffer-string) "foo"))) | |
3cd4192f MA |
1287 | (ignore-errors |
1288 | (delete-process proc) | |
1289 | (delete-file tmp-name))) | |
a213a541 MA |
1290 | |
1291 | (unwind-protect | |
1292 | (progn | |
1293 | (setq proc (start-file-process "test3" nil "cat")) | |
1294 | (should (processp proc)) | |
1295 | (should (equal (process-status proc) 'run)) | |
1296 | (set-process-filter | |
cad6dfb6 | 1297 | proc (lambda (_p s) (should (string-equal s "foo")))) |
a213a541 MA |
1298 | (process-send-string proc "foo") |
1299 | (process-send-eof proc) | |
1300 | (accept-process-output proc 1)) | |
3cd4192f | 1301 | (ignore-errors (delete-process proc))))) |
a213a541 MA |
1302 | |
1303 | (ert-deftest tramp-test28-shell-command () | |
1304 | "Check `shell-command'." | |
1305 | (skip-unless (tramp--test-enabled)) | |
76c92fdd MA |
1306 | (skip-unless |
1307 | (not | |
1308 | (memq | |
1309 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
154ba796 MA |
1310 | '(tramp-adb-file-name-handler |
1311 | tramp-gvfs-file-name-handler | |
1312 | tramp-smb-file-name-handler)))) | |
0010ca51 | 1313 | |
927fbd6b | 1314 | (let ((tmp-name (tramp--test-make-temp-name)) |
154ba796 MA |
1315 | (default-directory tramp-test-temporary-file-directory) |
1316 | kill-buffer-query-functions) | |
927fbd6b MA |
1317 | (unwind-protect |
1318 | (with-temp-buffer | |
5a327e99 | 1319 | (write-region "foo" nil tmp-name) |
cad6dfb6 MA |
1320 | (should (file-exists-p tmp-name)) |
1321 | (shell-command | |
1322 | (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) | |
76c92fdd MA |
1323 | ;; `ls' could produce colorized output. |
1324 | (goto-char (point-min)) | |
1325 | (while (re-search-forward tramp-color-escape-sequence-regexp nil t) | |
1326 | (replace-match "" nil nil)) | |
cad6dfb6 MA |
1327 | (should |
1328 | (string-equal | |
1329 | (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) | |
1330 | (ignore-errors (delete-file tmp-name))) | |
1331 | ||
1332 | (unwind-protect | |
1333 | (with-temp-buffer | |
5a327e99 | 1334 | (write-region "foo" nil tmp-name) |
cad6dfb6 MA |
1335 | (should (file-exists-p tmp-name)) |
1336 | (async-shell-command | |
1337 | (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) | |
76c92fdd | 1338 | (accept-process-output (get-buffer-process (current-buffer)) 1) |
154ba796 MA |
1339 | (with-timeout (10 (ert-fail "`async-shell-command' timed out")) |
1340 | (while | |
1341 | (ignore-errors | |
1342 | (memq (process-status (get-buffer-process (current-buffer))) | |
1343 | '(run open))) | |
1344 | (accept-process-output (get-buffer-process (current-buffer)) 1))) | |
76c92fdd MA |
1345 | ;; `ls' could produce colorized output. |
1346 | (goto-char (point-min)) | |
1347 | (while (re-search-forward tramp-color-escape-sequence-regexp nil t) | |
1348 | (replace-match "" nil nil)) | |
cad6dfb6 MA |
1349 | (should |
1350 | (string-equal | |
1351 | (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) | |
1352 | (ignore-errors (delete-file tmp-name))) | |
1353 | ||
1354 | (unwind-protect | |
1355 | (with-temp-buffer | |
1356 | (write-region "foo" nil tmp-name) | |
1357 | (should (file-exists-p tmp-name)) | |
1358 | (async-shell-command "read line; ls $line" (current-buffer)) | |
1359 | (process-send-string | |
1360 | (get-buffer-process (current-buffer)) | |
1361 | (format "%s\n" (file-name-nondirectory tmp-name))) | |
76c92fdd | 1362 | (accept-process-output (get-buffer-process (current-buffer)) 1) |
154ba796 MA |
1363 | (with-timeout (10 (ert-fail "`async-shell-command' timed out")) |
1364 | (while | |
1365 | (ignore-errors | |
1366 | (memq (process-status (get-buffer-process (current-buffer))) | |
1367 | '(run open))) | |
1368 | (accept-process-output (get-buffer-process (current-buffer)) 1))) | |
cad6dfb6 MA |
1369 | (should |
1370 | (string-equal | |
1371 | (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) | |
3cd4192f MA |
1372 | (ignore-errors (delete-file tmp-name))))) |
1373 | ||
581d24e7 MA |
1374 | (ert-deftest tramp-test29-vc-registered () |
1375 | "Check `vc-registered'." | |
1376 | (skip-unless (tramp--test-enabled)) | |
1377 | (skip-unless | |
1378 | (eq | |
1379 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
1380 | 'tramp-sh-file-name-handler)) | |
581d24e7 MA |
1381 | |
1382 | (let* ((default-directory tramp-test-temporary-file-directory) | |
1383 | (tmp-name1 (tramp--test-make-temp-name)) | |
1384 | (tmp-name2 (expand-file-name "foo" tmp-name1)) | |
1385 | (vc-handled-backends | |
1386 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil | |
1387 | (cond | |
1388 | ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) | |
1389 | '(Bzr)) | |
1390 | ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) | |
1391 | '(Git)) | |
1392 | ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) | |
1393 | '(Hg)) | |
1394 | (t nil))))) | |
1395 | (skip-unless vc-handled-backends) | |
1396 | (message "%s" vc-handled-backends) | |
1397 | ||
1398 | (unwind-protect | |
1399 | (progn | |
1400 | (make-directory tmp-name1) | |
1401 | (write-region "foo" nil tmp-name2) | |
1402 | (should (file-directory-p tmp-name1)) | |
1403 | (should (file-exists-p tmp-name2)) | |
1404 | (should-not (vc-registered tmp-name1)) | |
1405 | (should-not (vc-registered tmp-name2)) | |
1406 | ||
1407 | (let ((default-directory tmp-name1)) | |
1408 | ;; Create empty repository, and register the file. | |
1409 | (vc-create-repo (car vc-handled-backends)) | |
1410 | ;; The structure of VC-FILESET is not documented. Let's | |
1411 | ;; hope it won't change. | |
1412 | (vc-register | |
1413 | nil (list (car vc-handled-backends) | |
1414 | (list (file-name-nondirectory tmp-name2))))) | |
1415 | (should (vc-registered tmp-name2))) | |
1416 | ||
1417 | (ignore-errors (delete-directory tmp-name1 'recursive))))) | |
1418 | ||
2a2e6726 MA |
1419 | (defun tramp--test-check-files (&rest files) |
1420 | "Runs a simple but comprehensive test over every file in FILES." | |
1421 | (let ((tmp-name (tramp--test-make-temp-name))) | |
3cd4192f MA |
1422 | (unwind-protect |
1423 | (progn | |
1424 | (make-directory tmp-name) | |
2a2e6726 MA |
1425 | (dolist (elt files) |
1426 | (let ((file (expand-file-name elt tmp-name))) | |
1427 | (write-region elt nil file) | |
3cd4192f MA |
1428 | (should (file-exists-p file)) |
1429 | ;; Check file contents. | |
1430 | (with-temp-buffer | |
1431 | (insert-file-contents file) | |
2a2e6726 | 1432 | (should (string-equal (buffer-string) elt))))) |
0010ca51 | 1433 | ;; Check file names. |
82407168 MA |
1434 | (should (equal (directory-files |
1435 | tmp-name nil directory-files-no-dot-files-regexp) | |
2a2e6726 | 1436 | (sort files 'string-lessp)))) |
3cd4192f | 1437 | (ignore-errors (delete-directory tmp-name 'recursive))))) |
a213a541 | 1438 | |
2a2e6726 MA |
1439 | ;; This test is inspired by Bug#17238. |
1440 | (ert-deftest tramp-test30-special-characters () | |
1441 | "Check special characters in file names." | |
1442 | (skip-unless (tramp--test-enabled)) | |
1443 | ||
1444 | ;; Newlines and slashes in file names are not supported. So we don't test. | |
1445 | (tramp--test-check-files | |
1446 | " foo bar\tbaz " | |
1447 | "$foo$bar$$baz$" | |
1448 | "-foo-bar-baz-" | |
1449 | "%foo%bar%baz%" | |
1450 | "&foo&bar&baz&" | |
1451 | "?foo?bar?baz?" | |
1452 | "*foo*bar*baz*" | |
1453 | "'foo\"bar'baz\"" | |
1454 | "\\foo\\bar\\baz\\" | |
1455 | "#foo#bar#baz#" | |
1456 | "!foo|bar!baz|" | |
1457 | ":foo;bar:baz;" | |
1458 | "<foo>bar<baz>" | |
1459 | "(foo)bar(baz)")) | |
1460 | ||
1461 | (ert-deftest tramp-test31-utf8 () | |
1462 | "Check UTF8 encoding in file names and file contents." | |
1463 | (skip-unless (tramp--test-enabled)) | |
1464 | ||
1465 | (let ((coding-system-for-read 'utf-8) | |
1466 | (coding-system-for-write 'utf-8)) | |
1467 | (tramp--test-check-files | |
1468 | "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" | |
1469 | "银河系漫游指南系列" | |
1470 | "Автостопом по гала́ктике"))) | |
1471 | ||
162427fe | 1472 | ;; This test is inspired by Bug#16928. |
2a2e6726 | 1473 | (ert-deftest tramp-test32-asynchronous-requests () |
162427fe MA |
1474 | "Check parallel asynchronous requests. |
1475 | Such requests could arrive from timers, process filters and | |
1476 | process sentinels. They shall not disturb each other." | |
1477 | ;; Mark as failed until bug has been fixed. | |
1478 | :expected-result :failed | |
1479 | (skip-unless (tramp--test-enabled)) | |
1480 | (skip-unless | |
1481 | (eq | |
1482 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | |
1483 | 'tramp-sh-file-name-handler)) | |
1484 | ||
1485 | ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This | |
1486 | ;; has the side effect, that this test fails instead to abort. Good | |
1487 | ;; for hydra. | |
1488 | (tramp--instrument-test-case 0 | |
1489 | (let* ((tmp-name (tramp--test-make-temp-name)) | |
1490 | (default-directory tmp-name) | |
1491 | (remote-file-name-inhibit-cache t) | |
1492 | timer buffers kill-buffer-query-functions) | |
1493 | ||
1494 | (unwind-protect | |
1495 | (progn | |
1496 | (make-directory tmp-name) | |
1497 | ||
1498 | ;; Setup a timer in order to raise an ordinary command again | |
1499 | ;; and again. `vc-registered' is well suited, because there | |
1500 | ;; are many checks. | |
1501 | (setq | |
1502 | timer | |
1503 | (run-at-time | |
1504 | 0 1 | |
1505 | (lambda () | |
1506 | (when buffers | |
1507 | (vc-registered | |
1508 | (buffer-name (nth (random (length buffers)) buffers))))))) | |
1509 | ||
1510 | ;; Create temporary buffers. The number of buffers | |
1511 | ;; corresponds to the number of processes; it could be | |
1512 | ;; increased in order to make pressure on Tramp. | |
1513 | (dotimes (i 5) | |
1514 | (add-to-list 'buffers (generate-new-buffer "*temp*"))) | |
1515 | ||
1516 | ;; Open asynchronous processes. Set process sentinel. | |
1517 | (dolist (buf buffers) | |
1518 | (async-shell-command "read line; touch $line; echo $line" buf) | |
1519 | (set-process-sentinel | |
1520 | (get-buffer-process buf) | |
1521 | (lambda (proc _state) | |
1522 | (delete-file (buffer-name (process-buffer proc)))))) | |
1523 | ||
1524 | ;; Send a string. Use a random order of the buffers. Mix | |
1525 | ;; with regular operation. | |
1526 | (let ((buffers (copy-sequence buffers)) | |
1527 | buf) | |
1528 | (while buffers | |
1529 | (setq buf (nth (random (length buffers)) buffers)) | |
1530 | (process-send-string | |
1531 | (get-buffer-process buf) (format "'%s'\n" buf)) | |
1532 | (file-attributes (buffer-name buf)) | |
1533 | (setq buffers (delq buf buffers)))) | |
1534 | ||
1535 | ;; Wait until the whole output has been read. | |
1536 | (with-timeout ((* 10 (length buffers)) | |
1537 | (ert-fail "`async-shell-command' timed out")) | |
1538 | (let ((buffers (copy-sequence buffers)) | |
1539 | buf) | |
1540 | (while buffers | |
1541 | (setq buf (nth (random (length buffers)) buffers)) | |
1542 | (if (ignore-errors | |
1543 | (memq (process-status (get-buffer-process buf)) | |
1544 | '(run open))) | |
1545 | (accept-process-output (get-buffer-process buf) 0.1) | |
1546 | (setq buffers (delq buf buffers)))))) | |
1547 | ||
1548 | ;; Check. | |
1549 | (dolist (buf buffers) | |
1550 | (with-current-buffer buf | |
1551 | (should | |
1552 | (string-equal (format "'%s'\n" buf) (buffer-string))))) | |
1553 | (should-not | |
1554 | (directory-files tmp-name nil directory-files-no-dot-files-regexp))) | |
1555 | ||
1556 | ;; Cleanup. | |
1557 | (ignore-errors (cancel-timer timer)) | |
1558 | (ignore-errors (delete-directory tmp-name 'recursive)) | |
1559 | (dolist (buf buffers) | |
1560 | (ignore-errors (kill-buffer buf))))))) | |
1561 | ||
2a2e6726 MA |
1562 | (ert-deftest tramp-test33-recursive-load () |
1563 | "Check that Tramp does not fail due to recursive load." | |
1564 | (skip-unless (tramp--test-enabled)) | |
1565 | ||
1566 | (dolist (code | |
1567 | (list | |
1568 | (format | |
1569 | "(expand-file-name %S))" | |
1570 | tramp-test-temporary-file-directory) | |
1571 | (format | |
1572 | "(let ((default-directory %S)) (expand-file-name %S))" | |
1573 | tramp-test-temporary-file-directory | |
1574 | temporary-file-directory))) | |
1575 | (should-not | |
1576 | (string-match | |
1577 | "Recursive load" | |
1578 | (shell-command-to-string | |
1579 | (format | |
1580 | "%s -batch -Q -L %s --eval %s" | |
1581 | (expand-file-name invocation-name invocation-directory) | |
1582 | (mapconcat 'shell-quote-argument load-path " -L ") | |
1583 | (shell-quote-argument code))))))) | |
1584 | ||
1585 | (ert-deftest tramp-test34-unload () | |
1586 | "Check that Tramp and its subpackages unload completely. | |
1587 | Since it unloads Tramp, it shall be the last test to run." | |
1588 | ;; Mark as failed until all symbols are unbound. | |
1589 | :expected-result (if (featurep 'tramp) :failed :passed) | |
1590 | (when (featurep 'tramp) | |
1591 | (unload-feature 'tramp 'force) | |
1592 | ;; No Tramp feature must be left. | |
1593 | (should-not (featurep 'tramp)) | |
1594 | (should-not (all-completions "tramp" (delq 'tramp-tests features))) | |
1595 | ;; `file-name-handler-alist' must be clean. | |
1596 | (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) | |
1597 | ;; There shouldn't be left a bound symbol. We do not regard our | |
1598 | ;; test symbols, and the Tramp unload hooks. | |
1599 | (mapatoms | |
1600 | (lambda (x) | |
1601 | (and (or (boundp x) (functionp x)) | |
1602 | (string-match "^tramp" (symbol-name x)) | |
1603 | (not (string-match "^tramp--?test" (symbol-name x))) | |
1604 | (not (string-match "unload-hook$" (symbol-name x))) | |
1605 | (ert-fail (format "`%s' still bound" x))))) | |
1606 | ; (progn (message "`%s' still bound" x))))) | |
1607 | ;; There shouldn't be left a hook function containing a Tramp | |
1608 | ;; function. We do not regard the Tramp unload hooks. | |
1609 | (mapatoms | |
1610 | (lambda (x) | |
1611 | (and (boundp x) | |
1612 | (string-match "-hooks?$" (symbol-name x)) | |
1613 | (not (string-match "unload-hook$" (symbol-name x))) | |
1614 | (consp (symbol-value x)) | |
1615 | (ignore-errors (all-completions "tramp" (symbol-value x))) | |
1616 | (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) | |
1617 | ||
a213a541 MA |
1618 | ;; TODO: |
1619 | ||
1620 | ;; * dired-compress-file | |
1621 | ;; * dired-uncache | |
1622 | ;; * file-acl | |
1623 | ;; * file-ownership-preserved-p | |
1624 | ;; * file-selinux-context | |
1625 | ;; * find-backup-file-name | |
1626 | ;; * make-auto-save-file-name | |
1627 | ;; * set-file-acl | |
1628 | ;; * set-file-selinux-context | |
a213a541 | 1629 | |
76c92fdd | 1630 | ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). |
162427fe | 1631 | ;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message). |
2a2e6726 MA |
1632 | ;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when |
1633 | ;; target is a dumb busybox). Seems to be in `directory-files'. | |
1634 | ;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'. | |
1635 | ;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set | |
1636 | ;; expected error. | |
1baa1e49 | 1637 | |
a213a541 MA |
1638 | (defun tramp-test-all (&optional interactive) |
1639 | "Run all tests for \\[tramp]." | |
1640 | (interactive "p") | |
1641 | (funcall | |
1642 | (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) | |
1643 | ||
1644 | (provide 'tramp-tests) | |
1645 | ;;; tramp-tests.el ends here |