From: Michael Albinus Date: Sun, 4 Dec 2016 11:12:06 +0000 (+0100) Subject: Implement quoting the local part of a remote file name X-Git-Tag: emacs-26.0.90~1208 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=35a86f0b6fe5634e94212964657c538739743d72;p=emacs.git Implement quoting the local part of a remote file name * doc/emacs/files.texi (Quoted File Names): * etc/NEWS: Mention quoting the local part of a remote file name. * lisp/net/tramp.el (tramp-dissect-file-name): Check with `tramp-tramp-file-p'. (tramp-quoted-name-p, tramp-quote-name, tramp-unquote-name): New defsubst. (tramp-handle-substitute-in-file-name) (tramp-handle-make-auto-save-file-name): Handle quoted files. (tramp-shell-quote-argument): Unquote argument. * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename): Handle quoted files. * test/lisp/net/tramp-tests.el (tramp--test-expensive-test): New defvar. (tramp--test-make-temp-name): New argument QUOTED. (tramp-test01-file-name-syntax) (tramp-test02-file-name-dissect) (tramp-test04-substitute-in-file-name) (tramp-test05-expand-file-name, tramp-test07-file-exists-p) (tramp-test08-file-local-copy) (tramp-test09-insert-file-contents) (tramp-test10-write-region, tramp-test11-copy-file) (tramp-test12-rename-file, tramp-test13-make-directory) (tramp-test14-delete-directory, tramp-test15-copy-directory) (tramp-test16-directory-files) (tramp-test17-insert-directory) (tramp-test18-file-attributes) (tramp-test19-directory-files-and-attributes) (tramp-test20-file-modes, tramp-test21-file-links) (tramp-test22-file-times, tramp-test23-visited-file-modtime) (tramp-test24-file-name-completion, tramp-test25-load) (tramp-test26-process-file, tramp-test27-start-file-process) (tramp-test28-shell-command, tramp-test30-vc-registered) (tramp-test31-make-auto-save-file-name) (tramp--test-check-files) (tramp-test35-asynchronous-requests): Test also quoted file names. (tramp--test-shell-command-to-string-asynchronously): Rename. (tramp-test29-environment-variables): Use it. --- diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 7bf46908739..ef362e9a529 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1870,6 +1870,11 @@ prevent it from being treated as a remote file name. Thus, if you have a directory named @file{/foo:} and a file named @file{bar} in it, you can refer to that file in Emacs as @samp{/:/foo:/bar}. + If you want to quote only special characters in the local part of a +remote file name, you can quote just the local part. +@samp{/baz:/:/foo:/bar} refers to the file @file{bar} of directory +@file{/foo:} on the host @file{baz}. + @samp{/:} can also prevent @samp{~} from being treated as a special character for a user's home directory. For example, @file{/:/tmp/~hack} refers to a file whose name is @file{~hack} in directory @file{/tmp}. diff --git a/etc/NEWS b/etc/NEWS index f7565b04ef8..a62668a2625 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -268,6 +268,12 @@ variable of this kind to swap modifiers in Emacs. --- ** New input methods: 'cyrillic-tuvan', 'polish-prefix'. ++++ +** File name quoting by adding the prefix "/:" is now possible for the +local part of a remote file name. Thus, if you have a directory named +"/~" on the remote host "foo", you can prevent it from being +substituted by a home directory by writing it as "/foo:/:/~/file". + * Editing Changes in Emacs 26.1 diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f44a4d37e78..c87b4068630 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1146,7 +1146,9 @@ target of the symlink differ." (tramp-make-tramp-file-name method user host (with-tramp-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order + (let ((result nil) ; result steps in reverse order + (quoted (tramp-quoted-name-p localname)) + (localname (tramp-unquote-name localname))) (tramp-message v 4 "Finding true name for `%s'" filename) (cond ;; Use GNU readlink --canonicalize-missing where available. @@ -1241,6 +1243,7 @@ target of the symlink differ." (when (string= "" result) (setq result "/"))))) + (when quoted (setq result (tramp-quote-name result))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 956cf152e3f..a92b602e36a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1239,9 +1239,9 @@ localname (file name on remote host) and hop. If NODEFAULT is non-nil, the file name parts are not expanded to their default values." (save-match-data + (unless (tramp-tramp-file-p name) + (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match - (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) (let ((method (match-string (nth 1 tramp-file-name-structure) name)) (user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) @@ -1679,6 +1679,27 @@ FILE must be a local file name on a connection identified via VEC." (font-lock-add-keywords 'emacs-lisp-mode '("\\")) +(defsubst tramp-quoted-name-p (name) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name, check the local part of NAME." + (string-match "^/:" (or (file-remote-p name 'localname) name))) + +(defsubst tramp-quote-name (name) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name, the local part of NAME is quoted." + (concat (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))) + +(defsubst tramp-unquote-name (name) + "Remove quotation prefix \"/:\" from file NAME. +If NAME is a remote file name, the local part of NAME is unquoted." + (save-match-data + (let ((localname (or (file-remote-p name 'localname) name))) + (when (tramp-quoted-name-p localname) + (setq + localname + (replace-match (if (= (length localname) 2) "/" "") nil t localname))) + (concat (file-remote-p name) localname)))) + (defun tramp-drop-volume-letter (name) "Cut off unnecessary drive letter from file NAME. The functions `tramp-*-handle-expand-file-name' call `expand-file-name' @@ -3323,20 +3344,23 @@ User is always nil." (defun tramp-handle-substitute-in-file-name (filename) "Like `substitute-in-file-name' for Tramp files. \"//\" and \"/~\" substitute only in the local filename part." - ;; First, we must replace environment variables. - (setq filename (tramp-replace-environment-variables filename)) - (with-parsed-tramp-file-name filename nil - ;; Ignore in LOCALNAME everything before "//" or "/~". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) - (setq filename - (concat (file-remote-p filename) - (replace-match "\\1" nil nil localname))) - ;; "/m:h:~" does not work for completion. We use "/m:h:~/". - (when (string-match "~$" filename) - (setq filename (concat filename "/")))) - ;; We do not want to replace environment variables, again. - (let (process-environment) - (tramp-run-real-handler 'substitute-in-file-name (list filename))))) + ;; Check, whether the local part is a quoted file name. + (if (tramp-quoted-name-p filename) + filename + ;; First, we must replace environment variables. + (setq filename (tramp-replace-environment-variables filename)) + (with-parsed-tramp-file-name filename nil + ;; Ignore in LOCALNAME everything before "//" or "/~". + (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (setq filename + (concat (file-remote-p filename) + (replace-match "\\1" nil nil localname))) + ;; "/m:h:~" does not work for completion. We use "/m:h:~/". + (when (string-match "~$" filename) + (setq filename (concat filename "/")))) + ;; We do not want to replace environment variables, again. + (let (process-environment) + (tramp-run-real-handler 'substitute-in-file-name (list filename)))))) (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." @@ -4080,7 +4104,7 @@ this file, if that variable is non-nil." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (buffer-file-name)) + (tramp-unquote-name (buffer-file-name))) tramp-auto-save-directory)))) ;; Run plain `make-auto-save-file-name'. (tramp-run-real-handler 'make-auto-save-file-name nil))) @@ -4318,7 +4342,7 @@ T1 and T2 are time values (as returned by `current-time' for example)." Only works for Bourne-like shells." (let ((system-type 'not-windows)) (save-match-data - (let ((result (shell-quote-argument s)) + (let ((result (shell-quote-argument (tramp-unquote-name s))) (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line)))) (when (and (>= (length result) 2) (string= (substring result 0 2) "\\~")) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d88dbce4683..c2984dfc776 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -79,6 +79,11 @@ (when (getenv "NIX_STORE") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) +(defvar tramp--test-expensive-test + (null + (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) + "Whether expensive tests are run.") + (defvar tramp--test-enabled-checked nil "Cached result of `tramp--test-enabled'. If the function did run, the value is a cons cell, the `cdr' @@ -106,11 +111,15 @@ being the result.") ;; Return result. (cdr tramp--test-enabled-checked)) -(defun tramp--test-make-temp-name (&optional local) - "Create a temporary file name for test." - (expand-file-name - (make-temp-name "tramp-test") - (if local temporary-file-directory tramp-test-temporary-file-directory))) +(defun tramp--test-make-temp-name (&optional local quoted) + "Create a temporary file name for test. +If LOCAL is non-nil, a local file is created. +If QUOTED is non-nil, the local part of the file is quoted." + (funcall + (if quoted 'tramp-quote-name 'identity) + (expand-file-name + (make-temp-name "tramp-test") + (if local temporary-file-directory tramp-test-temporary-file-directory)))) (defmacro tramp--instrument-test-case (verbose &rest body) "Run BODY with `tramp-verbose' equal VERBOSE. @@ -175,8 +184,11 @@ handled properly. BODY shall not contain a timeout." ;; Local file name part. (should (tramp-tramp-file-p "/host:/:")) (should (tramp-tramp-file-p "/method:::")) + (should (tramp-tramp-file-p "/method::/:")) (should (tramp-tramp-file-p "/method::/path/to/file")) + (should (tramp-tramp-file-p "/method::/:/path/to/file")) (should (tramp-tramp-file-p "/method::file")) + (should (tramp-tramp-file-p "/method::/:file")) ;; Multihop. (should (tramp-tramp-file-p "/method1:|method2::")) @@ -191,11 +203,11 @@ handled properly. BODY shall not contain a timeout." ;; No strings. (should-not (tramp-tramp-file-p nil)) (should-not (tramp-tramp-file-p 'symbol)) - ;; "/:" suppresses file name handlers. + ;; Quote with "/:" suppresses file name handlers. (should-not (tramp-tramp-file-p "/::")) (should-not (tramp-tramp-file-p "/:@:")) (should-not (tramp-tramp-file-p "/:[]:")) - ;; Methods or hostnames shall be at least two characters on MS Windows. + ;; Methods or host names shall be at least two characters on MS Windows. (let ((system-type 'windows-nt)) (should-not (tramp-tramp-file-p "/c:/path/to/file")) (should-not (tramp-tramp-file-p "/c::/path/to/file"))) @@ -504,7 +516,10 @@ handled properly. BODY shall not contain a timeout." (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file") + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file")) (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" "method1" "user1" "host1" "method2" "user2" "host2" @@ -512,31 +527,46 @@ handled properly. BODY shall not contain a timeout." (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") 'method) "method3")) (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") 'user) "user3")) (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") 'host) "host3")) (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") 'localname) "/path/to/file")) (should (string-equal (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") 'hop) (format "%s:%s@%s|%s:%s@%s|" "method1" "user1" "host1" "method2" "user2" "host2"))))) @@ -576,12 +606,35 @@ handled properly. BODY shall not contain a timeout." (string-equal (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) (should - (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) + (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path//foo") + "/method:host:/:/path//foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path///foo") + "/method:host:/:/path///foo")) + (should (string-equal (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo")) (should (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/~/foo") + "/method:host:/:/path/~/foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path//~/foo") + "/method:host:/:/path//~/foo")) + (let (process-environment) (should (string-equal @@ -595,7 +648,21 @@ handled properly. BODY shall not contain a timeout." (should (string-equal (substitute-in-file-name "/method:host:/path/$$FOO") - "/method:host:/path/$FOO")))) + "/method:host:/path/$FOO")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$FOO") + "/method:host:/:/path/$FOO")) + (setenv "FOO" "bla") + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$FOO") + "/method:host:/:/path/$FOO")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$$FOO") + "/method:host:/:/path/$$FOO")))) (ert-deftest tramp-test05-expand-file-name () "Check `expand-file-name'." @@ -604,7 +671,19 @@ handled properly. BODY shall not contain a timeout." (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) (should (string-equal - (expand-file-name "/method:host:/path/../file") "/method:host:/file"))) + (expand-file-name "/method:host:/path/../file") "/method:host:/file")) + ;; Quoting local part. + (should + (string-equal + (expand-file-name "/method:host:/:/path/./file") + "/method:host:/:/path/file")) + (should + (string-equal + (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file")) + (should + (string-equal + (expand-file-name "/method:host:/:~/path/./file") + "/method:host:/:~/path/file"))) (ert-deftest tramp-test06-directory-file-name () "Check `directory-file-name'. @@ -665,433 +744,445 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `file-exist-p', `write-region' and `delete-file'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (should-not (file-exists-p tmp-name)) - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (delete-file tmp-name) - (should-not (file-exists-p tmp-name)))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (delete-file tmp-name) + (should-not (file-exists-p tmp-name))))) (ert-deftest tramp-test08-file-local-copy () "Check `file-local-copy'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name1 (tramp--test-make-temp-name)) - tmp-name2) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (setq tmp-name2 (file-local-copy tmp-name1))) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - ;; Check also that a file transfer with compression works. - (let ((default-directory tramp-test-temporary-file-directory) - (tramp-copy-size-limit 4) - (tramp-inline-compress-start-size 2)) - (delete-file tmp-name2) - (should (setq tmp-name2 (file-local-copy tmp-name1))))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + tmp-name2) + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (setq tmp-name2 (file-local-copy tmp-name1))) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + ;; Check also that a file transfer with compression works. + (let ((default-directory tramp-test-temporary-file-directory) + (tramp-copy-size-limit 4) + (tramp-inline-compress-start-size 2)) + (delete-file tmp-name2) + (should (setq tmp-name2 (file-local-copy tmp-name1))))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2)))))) (ert-deftest tramp-test09-insert-file-contents () "Check `insert-file-contents'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) - ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) - ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foofoo")) + ;; Insert partly. + (insert-file-contents tmp-name nil 1 3) + (should (string-equal (buffer-string) "oofoofoo")) + ;; Replace. + (insert-file-contents tmp-name nil nil nil 'replace) + (should (string-equal (buffer-string) "foo")))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) (ert-deftest tramp-test10-write-region () "Check `write-region'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (with-temp-buffer - (insert "foo") - (write-region nil nil tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Append. - (with-temp-buffer - (insert "bla") - (write-region nil nil tmp-name 'append)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foobla"))) - ;; Write string. - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Write partly. - (with-temp-buffer - (insert "123456789") - (write-region 3 5 tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "34")))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (with-temp-buffer + (insert "foo") + (write-region nil nil tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo"))) + ;; Append. + (with-temp-buffer + (insert "bla") + (write-region nil nil tmp-name 'append)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foobla"))) + ;; Write string. + (write-region "foo" nil tmp-name) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo"))) + ;; Write partly. + (with-temp-buffer + (insert "123456789") + (write-region 3 5 tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "34")))) - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) (ert-deftest tramp-test11-copy-file () "Check `copy-file'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Copy on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name2)) - (copy-file tmp-name1 tmp-name2 'ok) - (make-directory tmp-name3) - (copy-file tmp-name1 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Copy from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name4) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name4)) - (copy-file tmp-name1 tmp-name4 'ok) - (make-directory tmp-name5) - (copy-file tmp-name1 tmp-name5) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Copy from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (copy-file tmp-name4 tmp-name1) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name4 tmp-name1)) - (copy-file tmp-name4 tmp-name1 'ok) - (make-directory tmp-name3) - (copy-file tmp-name4 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted)) + (tmp-name4 (tramp--test-make-temp-name 'local quoted)) + (tmp-name5 (tramp--test-make-temp-name 'local quoted))) + + ;; Copy on remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (copy-file tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name2)) + (copy-file tmp-name1 tmp-name2 'ok) + (make-directory tmp-name3) + (copy-file tmp-name1 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Copy from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (copy-file tmp-name1 tmp-name4) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name4)) + (copy-file tmp-name1 tmp-name4 'ok) + (make-directory tmp-name5) + (copy-file tmp-name1 tmp-name5) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Copy from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (copy-file tmp-name4 tmp-name1) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name4 tmp-name1)) + (copy-file tmp-name4 tmp-name1 'ok) + (make-directory tmp-name3) + (copy-file tmp-name4 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive)))))) (ert-deftest tramp-test12-rename-file () "Check `rename-file'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Rename on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name2) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name2)) - (rename-file tmp-name1 tmp-name2 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name3) - (rename-file tmp-name1 tmp-name3) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Rename from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name4) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name4)) - (rename-file tmp-name1 tmp-name4 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name5) - (rename-file tmp-name1 tmp-name5) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Rename from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (rename-file tmp-name4 tmp-name1) - (should-not (file-exists-p tmp-name4)) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (should-error (rename-file tmp-name4 tmp-name1)) - (rename-file tmp-name4 tmp-name1 'ok) - (should-not (file-exists-p tmp-name4)) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (make-directory tmp-name3) - (rename-file tmp-name4 tmp-name3) - (should-not (file-exists-p tmp-name4)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted)) + (tmp-name4 (tramp--test-make-temp-name 'local quoted)) + (tmp-name5 (tramp--test-make-temp-name 'local quoted))) - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) + ;; Rename on remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (rename-file tmp-name1 tmp-name2) + (should-not (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name2)) + (rename-file tmp-name1 tmp-name2 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name3) + (rename-file tmp-name1 tmp-name3) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Rename from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (rename-file tmp-name1 tmp-name4) + (should-not (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name4)) + (rename-file tmp-name1 tmp-name4 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name5) + (rename-file tmp-name1 tmp-name5) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Rename from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (rename-file tmp-name4 tmp-name1) + (should-not (file-exists-p tmp-name4)) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (should-error (rename-file tmp-name4 tmp-name1)) + (rename-file tmp-name4 tmp-name1 'ok) + (should-not (file-exists-p tmp-name4)) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (make-directory tmp-name3) + (rename-file tmp-name4 tmp-name3) + (should-not (file-exists-p tmp-name4)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive)))))) (ert-deftest tramp-test13-make-directory () "Check `make-directory'. This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2)) - (make-directory tmp-name2 'parents) - (should (file-directory-p tmp-name2)) - (should (file-accessible-directory-p tmp-name2))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) + (unwind-protect + (progn + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (should (file-accessible-directory-p tmp-name1)) + (should-error (make-directory tmp-name2)) + (make-directory tmp-name2 'parents) + (should (file-directory-p tmp-name2)) + (should (file-accessible-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) (ert-deftest tramp-test14-delete-directory () "Check `delete-directory'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - ;; Delete empty directory. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (delete-directory tmp-name) - (should-not (file-directory-p tmp-name)) - ;; Delete non-empty directory. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (write-region "foo" nil (expand-file-name "bla" tmp-name)) - (should (file-exists-p (expand-file-name "bla" tmp-name))) - (should-error (delete-directory tmp-name)) - (delete-directory tmp-name 'recursive) - (should-not (file-directory-p tmp-name)))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + ;; Delete empty directory. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (delete-directory tmp-name) + (should-not (file-directory-p tmp-name)) + ;; Delete non-empty directory. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (write-region "foo" nil (expand-file-name "bla" tmp-name)) + (should (file-exists-p (expand-file-name "bla" tmp-name))) + (should-error (delete-directory tmp-name)) + (delete-directory tmp-name 'recursive) + (should-not (file-directory-p tmp-name))))) (ert-deftest tramp-test15-copy-directory () "Check `copy-directory'." (skip-unless (tramp--test-enabled)) - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (expand-file-name - (file-name-nondirectory tmp-name1) tmp-name2)) - (tmp-name4 (expand-file-name "foo" tmp-name1)) - (tmp-name5 (expand-file-name "foo" tmp-name2)) - (tmp-name6 (expand-file-name "foo" tmp-name3))) - - ;; Copy complete directory. - (unwind-protect - (progn - ;; Copy empty directory. - (make-directory tmp-name1) - (write-region "foo" nil tmp-name4) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name2)) - (should (file-exists-p tmp-name5)) - ;; Target directory does exist already. - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name3)) - (should (file-exists-p tmp-name6))) - - ;; Cleanup. - (ignore-errors - (delete-directory tmp-name1 'recursive) - (delete-directory tmp-name2 'recursive))) - - ;; Copy directory contents. - (unwind-protect - (progn - ;; Copy empty directory. - (make-directory tmp-name1) - (write-region "foo" nil tmp-name4) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) - (should (file-directory-p tmp-name2)) - (should (file-exists-p tmp-name5)) - ;; Target directory does exist already. - (delete-file tmp-name5) - (should-not (file-exists-p tmp-name5)) - (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) - (should (file-directory-p tmp-name2)) - (should (file-exists-p tmp-name5)) - (should-not (file-directory-p tmp-name3)) - (should-not (file-exists-p tmp-name6))) - - ;; Cleanup. - (ignore-errors - (delete-directory tmp-name1 'recursive) - (delete-directory tmp-name2 'recursive))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (expand-file-name + (file-name-nondirectory tmp-name1) tmp-name2)) + (tmp-name4 (expand-file-name "foo" tmp-name1)) + (tmp-name5 (expand-file-name "foo" tmp-name2)) + (tmp-name6 (expand-file-name "foo" tmp-name3))) + + ;; Copy complete directory. + (unwind-protect + (progn + ;; Copy empty directory. + (make-directory tmp-name1) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (copy-directory tmp-name1 tmp-name2) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + ;; Target directory does exist already. + (copy-directory tmp-name1 tmp-name2) + (should (file-directory-p tmp-name3)) + (should (file-exists-p tmp-name6))) + + ;; Cleanup. + (ignore-errors + (delete-directory tmp-name1 'recursive) + (delete-directory tmp-name2 'recursive))) + + ;; Copy directory contents. + (unwind-protect + (progn + ;; Copy empty directory. + (make-directory tmp-name1) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + ;; Target directory does exist already. + (delete-file tmp-name5) + (should-not (file-exists-p tmp-name5)) + (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + (should-not (file-directory-p tmp-name3)) + (should-not (file-exists-p tmp-name6))) + + ;; Cleanup. + (ignore-errors + (delete-directory tmp-name1 'recursive) + (delete-directory tmp-name2 'recursive)))))) (ert-deftest tramp-test16-directory-files () "Check `directory-files'." (skip-unless (tramp--test-enabled)) - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - (tmp-name3 (expand-file-name "foo" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (write-region "bla" nil tmp-name3) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should (file-exists-p tmp-name3)) - (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) - (should (equal (directory-files tmp-name1 'full) - `(,(concat tmp-name1 "/.") - ,(concat tmp-name1 "/..") - ,tmp-name2 ,tmp-name3))) - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - '("bla" "foo"))) - (should (equal (directory-files - tmp-name1 'full directory-files-no-dot-files-regexp) - `(,tmp-name2 ,tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "bla" tmp-name1)) + (tmp-name3 (expand-file-name "foo" tmp-name1))) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (write-region "bla" nil tmp-name3) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (should (file-exists-p tmp-name3)) + (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) + (should (equal (directory-files tmp-name1 'full) + `(,(concat tmp-name1 "/.") + ,(concat tmp-name1 "/..") + ,tmp-name2 ,tmp-name3))) + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + '("bla" "foo"))) + (should (equal (directory-files + tmp-name1 'full directory-files-no-dot-files-regexp) + `(,tmp-name2 ,tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) (ert-deftest tramp-test17-insert-directory () "Check `insert-directory'." (skip-unless (tramp--test-enabled)) - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - ;; We test for the summary line. Keyword "total" could be localized. - (process-environment - (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-directory tmp-name1 nil) - (goto-char (point-min)) - (should (looking-at-p (regexp-quote tmp-name1)))) - (with-temp-buffer - (insert-directory tmp-name1 "-al") - (goto-char (point-min)) - (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory (file-name-as-directory tmp-name1) "-al") - (goto-char (point-min)) - (should - (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory - (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) - (goto-char (point-min)) - (should - (looking-at-p - (concat - ;; There might be a summary line. - "\\(total.+[[:digit:]]+\n\\)?" - ;; We don't know in which order ".", ".." and "foo" appear. - "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + ;; We test for the summary line. Keyword "total" could be localized. + (process-environment + (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-directory tmp-name1 nil) + (goto-char (point-min)) + (should (looking-at-p (regexp-quote tmp-name1)))) + (with-temp-buffer + (insert-directory tmp-name1 "-al") + (goto-char (point-min)) + (should + (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) + (with-temp-buffer + (insert-directory (file-name-as-directory tmp-name1) "-al") + (goto-char (point-min)) + (should + (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) + (with-temp-buffer + (insert-directory + (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) + (goto-char (point-min)) + (should + (looking-at-p + (concat + ;; There might be a summary line. + "\\(total.+[[:digit:]]+\n\\)?" + ;; We don't know in which order ".", ".." and "foo" appear. + "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. @@ -1099,148 +1190,156 @@ This tests also `file-readable-p', `file-regular-p' and `file-ownership-preserved-p'." (skip-unless (tramp--test-enabled)) - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - ;; File name with "//". - (tmp-name3 - (format - "%s%s" - (file-remote-p tmp-name1) - (replace-regexp-in-string - "/" "//" (file-remote-p tmp-name1 'localname)))) - attr) - (unwind-protect - (progn - ;; `file-ownership-preserved-p' should return t for - ;; non-existing files. It is implemented only in tramp-sh.el. - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name1 'group))) - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should (file-regular-p tmp-name1)) - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name1 'group))) - - ;; We do not test inodes and device numbers. - (setq attr (file-attributes tmp-name1)) - (should (consp attr)) - (should (null (car attr))) - (should (numberp (nth 1 attr))) ;; Link. - (should (numberp (nth 2 attr))) ;; Uid. - (should (numberp (nth 3 attr))) ;; Gid. - ;; Last access time. - (should (stringp (current-time-string (nth 4 attr)))) - ;; Last modification time. - (should (stringp (current-time-string (nth 5 attr)))) - ;; Last status change time. - (should (stringp (current-time-string (nth 6 attr)))) - (should (numberp (nth 7 attr))) ;; Size. - (should (stringp (nth 8 attr))) ;; Modes. - - (setq attr (file-attributes tmp-name1 'string)) - (should (stringp (nth 2 attr))) ;; Uid. - (should (stringp (nth 3 attr))) ;; Gid. - - (condition-case err - (progn - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name2 'group))) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-symlink-p tmp-name2)) - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name2 'group))) - (setq attr (file-attributes tmp-name2)) - (should (string-equal - (car attr) - (file-remote-p (file-truename tmp-name1) 'localname))) - (delete-file tmp-name2)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - ;; Check, that "//" in symlinks are handled properly. - (with-temp-buffer - (let ((default-directory tramp-test-temporary-file-directory)) - (shell-command - (format - "ln -s %s %s" - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name2))) - t))) - (when (file-symlink-p tmp-name2) - (setq attr (file-attributes tmp-name2)) - (should - (string-equal - (car attr) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)))) - (delete-file tmp-name2)) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + ;; File name with "//". + (tmp-name3 + (format + "%s%s" + (file-remote-p tmp-name1) + (replace-regexp-in-string + "/" "//" (file-remote-p tmp-name1 'localname)))) + attr) + (unwind-protect + (progn + ;; `file-ownership-preserved-p' should return t for + ;; non-existing files. It is implemented only in tramp-sh.el. + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + + ;; We do not test inodes and device numbers. + (setq attr (file-attributes tmp-name1)) + (should (consp attr)) + (should (null (car attr))) + (should (numberp (nth 1 attr))) ;; Link. + (should (numberp (nth 2 attr))) ;; Uid. + (should (numberp (nth 3 attr))) ;; Gid. + ;; Last access time. + (should (stringp (current-time-string (nth 4 attr)))) + ;; Last modification time. + (should (stringp (current-time-string (nth 5 attr)))) + ;; Last status change time. + (should (stringp (current-time-string (nth 6 attr)))) + (should (numberp (nth 7 attr))) ;; Size. + (should (stringp (nth 8 attr))) ;; Modes. + + (setq attr (file-attributes tmp-name1 'string)) + (should (stringp (nth 2 attr))) ;; Uid. + (should (stringp (nth 3 attr))) ;; Gid. + + (condition-case err + (progn + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-symlink-p tmp-name2)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (setq attr (file-attributes tmp-name2)) + (should + (string-equal + (funcall + (if quoted 'tramp-quote-name 'identity) + (car attr)) + (file-remote-p (file-truename tmp-name1) 'localname))) + (delete-file tmp-name2)) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + + ;; Check, that "//" in symlinks are handled properly. + (with-temp-buffer + (let ((default-directory tramp-test-temporary-file-directory)) + (shell-command + (format + "ln -s %s %s" + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3)) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name2))) + t))) + (when (file-symlink-p tmp-name2) + (setq attr (file-attributes tmp-name2)) + (should + (string-equal + (car attr) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3)))) + (delete-file tmp-name2)) + + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (delete-file tmp-name1) + (make-directory tmp-name1) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should-not (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (setq attr (file-attributes tmp-name1)) + (should (eq (car attr) t))) - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name1 'group))) - (delete-file tmp-name1) - (make-directory tmp-name1) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should-not (file-regular-p tmp-name1)) - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name1 'group))) - (setq attr (file-attributes tmp-name1)) - (should (eq (car attr) t))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1)) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)))))) (ert-deftest tramp-test19-directory-files-and-attributes () "Check `directory-files-and-attributes'." (skip-unless (tramp--test-enabled)) - ;; `directory-files-and-attributes' contains also values for "../". - ;; Ensure that this doesn't change during tests, for - ;; example due to handling temporary files. - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - attr) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (make-directory tmp-name2) - (should (file-directory-p tmp-name2)) - (write-region "foo" nil (expand-file-name "foo" tmp-name2)) - (write-region "bar" nil (expand-file-name "bar" tmp-name2)) - (write-region "boz" nil (expand-file-name "boz" tmp-name2)) - (setq attr (directory-files-and-attributes tmp-name2)) - (should (consp attr)) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (dolist (elt attr) - (unless - (equal - (nth 5 - (file-attributes (expand-file-name (car elt) tmp-name2))) - '(0 0)) - (should - (equal (file-attributes (expand-file-name (car elt) tmp-name2)) - (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 'full)) - (dolist (elt attr) - (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) - (should - (equal (file-attributes (car elt)) (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) - (should (equal (mapcar 'car attr) '("bar" "boz")))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; `directory-files-and-attributes' contains also values for + ;; "../". Ensure that this doesn't change during tests, for + ;; example due to handling temporary files. + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "bla" tmp-name1)) + attr) + (unwind-protect + (progn + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (make-directory tmp-name2) + (should (file-directory-p tmp-name2)) + (write-region "foo" nil (expand-file-name "foo" tmp-name2)) + (write-region "bar" nil (expand-file-name "bar" tmp-name2)) + (write-region "boz" nil (expand-file-name "boz" tmp-name2)) + (setq attr (directory-files-and-attributes tmp-name2)) + (should (consp attr)) + ;; Dumb remote shells without perl(1) or stat(1) are not + ;; able to return the date correctly. They say "don't know". + (dolist (elt attr) + (unless + (equal + (nth + 5 (file-attributes (expand-file-name (car elt) tmp-name2))) + '(0 0)) + (should + (equal (file-attributes (expand-file-name (car elt) tmp-name2)) + (cdr elt))))) + (setq attr (directory-files-and-attributes tmp-name2 'full)) + (dolist (elt attr) + (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) + (should + (equal (file-attributes (car elt)) (cdr elt))))) + (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) + (should (equal (mapcar 'car attr) '("bar" "boz")))) - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) (ert-deftest tramp-test20-file-modes () "Check `file-modes'. @@ -1248,261 +1347,271 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (set-file-modes tmp-name #o777) - (should (= (file-modes tmp-name) #o777)) - (should (file-executable-p tmp-name)) - (should (file-writable-p tmp-name)) - (set-file-modes tmp-name #o444) - (should (= (file-modes tmp-name) #o444)) - (should-not (file-executable-p tmp-name)) - ;; A file is always writable for user "root". - (unless (zerop (nth 2 (file-attributes tmp-name))) - (should-not (file-writable-p tmp-name)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (set-file-modes tmp-name #o777) + (should (= (file-modes tmp-name) #o777)) + (should (file-executable-p tmp-name)) + (should (file-writable-p tmp-name)) + (set-file-modes tmp-name #o444) + (should (= (file-modes tmp-name) #o444)) + (should-not (file-executable-p tmp-name)) + ;; A file is always writable for user "root". + (unless (zerop (nth 2 (file-attributes tmp-name))) + (should-not (file-writable-p tmp-name)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) (ert-deftest tramp-test21-file-links () "Check `file-symlink-p'. This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name 'local))) - - ;; Check `make-symbolic-link'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (make-symbolic-link tmp-name1 tmp-name2) - (file-error - (skip-unless - (not (string-equal (error-message-string err) - "make-symbolic-link not supported"))))) - (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2)) - (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) - (should (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (make-symbolic-link tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `add-name-to-file'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (add-name-to-file tmp-name1 tmp-name2) - (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2)) - (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) - (should-not (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (add-name-to-file tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `file-truename'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-symlink-p tmp-name2)) - (should-not (string-equal tmp-name2 (file-truename tmp-name2))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name 'local quoted))) + + ;; Check `make-symbolic-link'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + ;; Method "smb" supports `make-symbolic-link' only if the + ;; remote host has CIFS capabilities. tramp-adb.el and + ;; tramp-gvfs.el do not support symbolic links at all. + (condition-case err + (make-symbolic-link tmp-name1 tmp-name2) + (file-error + (skip-unless + (not (string-equal (error-message-string err) + "make-symbolic-link not supported"))))) + (should (file-symlink-p tmp-name2)) + (should-error (make-symbolic-link tmp-name1 tmp-name2)) + (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) + (should (file-symlink-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error (make-symbolic-link tmp-name1 tmp-name3))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; Check `add-name-to-file'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (add-name-to-file tmp-name1 tmp-name2) + (should-not (file-symlink-p tmp-name2)) + (should-error (add-name-to-file tmp-name1 tmp-name2)) + (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) + (should-not (file-symlink-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error (add-name-to-file tmp-name1 tmp-name3))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; Check `file-truename'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-not (string-equal tmp-name2 (file-truename tmp-name2))) + (should + (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) + (should (file-equal-p tmp-name1 tmp-name2))) + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; `file-truename' shall preserve trailing link of directories. + (unless (file-symlink-p tramp-test-temporary-file-directory) + (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) + (dir2 (file-name-as-directory dir1))) + (should (string-equal (file-truename dir1) (expand-file-name dir1))) (should - (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) - (should (file-equal-p tmp-name1 tmp-name2))) - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; `file-truename' shall preserve trailing link of directories. - (unless (file-symlink-p tramp-test-temporary-file-directory) - (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) - (dir2 (file-name-as-directory dir1))) - (should (string-equal (file-truename dir1) (expand-file-name dir1))) - (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) + (string-equal (file-truename dir2) (expand-file-name dir2)))))))) (ert-deftest tramp-test22-file-times () "Check `set-file-times' and `file-newer-than-file-p'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (should (consp (nth 5 (file-attributes tmp-name1)))) - ;; '(0 0) means don't know, and will be replaced by - ;; `current-time'. Therefore, we use '(0 1). - ;; We skip the test, if the remote handler is not able to - ;; set the correct time. - (skip-unless (set-file-times tmp-name1 '(0 1))) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) - (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) - (write-region "bla" nil tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-newer-than-file-p tmp-name2 tmp-name1)) - ;; `tmp-name3' does not exist. - (should (file-newer-than-file-p tmp-name2 tmp-name3)) - (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (should (consp (nth 5 (file-attributes tmp-name1)))) + ;; '(0 0) means don't know, and will be replaced by + ;; `current-time'. Therefore, we use '(0 1). We skip the + ;; test, if the remote handler is not able to set the + ;; correct time. + (skip-unless (set-file-times tmp-name1 '(0 1))) + ;; Dumb remote shells without perl(1) or stat(1) are not + ;; able to return the date correctly. They say "don't know". + (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) + (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) + (write-region "bla" nil tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-newer-than-file-p tmp-name2 tmp-name1)) + ;; `tmp-name3' does not exist. + (should (file-newer-than-file-p tmp-name2 tmp-name3)) + (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2)))))) (ert-deftest tramp-test23-visited-file-modtime () "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (verify-visited-file-modtime)) - (set-visited-file-modtime '(0 1)) - (should (verify-visited-file-modtime)) - (should (equal (visited-file-modtime) '(0 1 0 0))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (verify-visited-file-modtime)) + (set-visited-file-modtime '(0 1)) + (should (verify-visited-file-modtime)) + (should (equal (visited-file-modtime) '(0 1 0 0))))) - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) (ert-deftest tramp-test24-file-name-completion () "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) (dolist (n-e '(nil t)) - (let ((non-essential n-e) - (tmp-name (tramp--test-make-temp-name)) - (method (file-remote-p tramp-test-temporary-file-directory 'method)) - (host (file-remote-p tramp-test-temporary-file-directory 'host))) - - (unwind-protect - (progn - ;; Method and host name in completion mode. This kind of - ;; completion does not work on MS Windows. - (when (and (tramp-completion-mode-p) - (not (memq system-type '(cygwin windows-nt)))) - (unless (zerop (length method)) - (should - (member - (format "%s:" method) - (file-name-all-completions (substring method 0 1) "/")))) - (unless (zerop (length host)) - (let ((tramp-default-method (or method tramp-default-method))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((non-essential n-e) + (tmp-name (tramp--test-make-temp-name nil quoted)) + (method (file-remote-p tramp-test-temporary-file-directory 'method)) + (host (file-remote-p tramp-test-temporary-file-directory 'host))) + + (unwind-protect + (progn + ;; Method and host name in completion mode. This kind + ;; of completion does not work on MS Windows. + (when (and (tramp-completion-mode-p) + (not (memq system-type '(cygwin windows-nt)))) + (unless (zerop (length method)) + (should + (member + (format "%s:" method) + (file-name-all-completions (substring method 0 1) "/")))) + (unless (zerop (length host)) + (let ((tramp-default-method (or method tramp-default-method))) + (should + (member + (format "%s:" host) + (file-name-all-completions (substring host 0 1) "/"))))) + (unless (or (zerop (length method)) (zerop (length host))) (should (member (format "%s:" host) - (file-name-all-completions (substring host 0 1) "/"))))) - (unless (or (zerop (length method)) (zerop (length host))) - (should - (member - (format "%s:" host) - (file-name-all-completions - (substring host 0 1) (format "/%s:" method)))))) - - ;; Local files. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (write-region "foo" nil (expand-file-name "foo" tmp-name)) - (should (file-exists-p (expand-file-name "foo" tmp-name))) - (write-region "bar" nil (expand-file-name "bold" tmp-name)) - (should (file-exists-p (expand-file-name "bold" tmp-name))) - (make-directory (expand-file-name "boz" tmp-name)) - (should (file-directory-p (expand-file-name "boz" tmp-name))) - (should (equal (file-name-completion "fo" tmp-name) "foo")) - (should (equal (file-name-completion "foo" tmp-name) t)) - (should (equal (file-name-completion "b" tmp-name) "bo")) - (should-not (file-name-completion "a" tmp-name)) - (should - (equal - (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) - (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) - (should - (equal - (sort (file-name-all-completions "b" tmp-name) 'string-lessp) - '("bold" "boz/"))) - (should-not (file-name-all-completions "a" tmp-name)) - ;; `completion-regexp-list' restricts the completion to - ;; files which match all expressions in this list. - (let ((completion-regexp-list - `(,directory-files-no-dot-files-regexp "b"))) - (should - (equal (file-name-completion "" tmp-name) "bo")) - (should - (equal - (sort (file-name-all-completions "" tmp-name) 'string-lessp) - '("bold" "boz/")))) - ;; `file-name-completion' ignores file names that end in - ;; any string in `completion-ignored-extensions'. - (let ((completion-ignored-extensions '(".ext"))) - (write-region "foo" nil (expand-file-name "foo.ext" tmp-name)) - (should (file-exists-p (expand-file-name "foo.ext" tmp-name))) + (file-name-all-completions + (substring host 0 1) (format "/%s:" method)))))) + + ;; Local files. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (write-region "foo" nil (expand-file-name "foo" tmp-name)) + (should (file-exists-p (expand-file-name "foo" tmp-name))) + (write-region "bar" nil (expand-file-name "bold" tmp-name)) + (should (file-exists-p (expand-file-name "bold" tmp-name))) + (make-directory (expand-file-name "boz" tmp-name)) + (should (file-directory-p (expand-file-name "boz" tmp-name))) (should (equal (file-name-completion "fo" tmp-name) "foo")) (should (equal (file-name-completion "foo" tmp-name) t)) - (should (equal (file-name-completion "foo." tmp-name) "foo.ext")) - (should (equal (file-name-completion "foo.ext" tmp-name) t)) - ;; `file-name-all-completions' is not affected. + (should (equal (file-name-completion "b" tmp-name) "bo")) + (should-not (file-name-completion "a" tmp-name)) + (should + (equal + (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) + (should + (equal (file-name-all-completions "fo" tmp-name) '("foo"))) (should (equal - (sort (file-name-all-completions "" tmp-name) 'string-lessp) - '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) + (sort (file-name-all-completions "b" tmp-name) 'string-lessp) + '("bold" "boz/"))) + (should-not (file-name-all-completions "a" tmp-name)) + ;; `completion-regexp-list' restricts the completion to + ;; files which match all expressions in this list. + (let ((completion-regexp-list + `(,directory-files-no-dot-files-regexp "b"))) + (should + (equal (file-name-completion "" tmp-name) "bo")) + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("bold" "boz/")))) + ;; `file-name-completion' ignores file names that end in + ;; any string in `completion-ignored-extensions'. + (let ((completion-ignored-extensions '(".ext"))) + (write-region "foo" nil (expand-file-name "foo.ext" tmp-name)) + (should (file-exists-p (expand-file-name "foo.ext" tmp-name))) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "foo" tmp-name) t)) + (should + (equal (file-name-completion "foo." tmp-name) "foo.ext")) + (should (equal (file-name-completion "foo.ext" tmp-name) t)) + ;; `file-name-all-completions' is not affected. + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) - ;; Cleanup. - (ignore-errors (delete-directory tmp-name 'recursive)))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name 'recursive))))))) (ert-deftest tramp-test25-load () "Check `load'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (load tmp-name 'noerror 'nomessage) - (should-not (featurep 'tramp-test-load)) - (write-region "(provide 'tramp-test-load)" nil tmp-name) - ;; `load' in lread.c does not pass `must-suffix'. Why? - ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) - (load tmp-name nil 'nomessage 'nosuffix) - (should (featurep 'tramp-test-load))) - - ;; Cleanup. - (ignore-errors - (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) - (delete-file tmp-name))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (load tmp-name 'noerror 'nomessage) + (should-not (featurep 'tramp-test-load)) + (write-region "(provide 'tramp-test-load)" nil tmp-name) + ;; `load' in lread.c does not pass `must-suffix'. Why? + ;;(should-error + ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) + (load tmp-name nil 'nomessage 'nosuffix) + (should (featurep 'tramp-test-load))) + + ;; Cleanup. + (ignore-errors + (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) + (delete-file tmp-name)))))) (ert-deftest tramp-test26-process-file () "Check `process-file'." @@ -1510,194 +1619,205 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (let* ((tmp-name (tramp--test-make-temp-name)) - (fnnd (file-name-nondirectory tmp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (progn - ;; We cannot use "/bin/true" and "/bin/false"; those paths - ;; do not exist on hydra. - (should (zerop (process-file "true"))) - (should-not (zerop (process-file "false"))) - (should-not (zerop (process-file "binary-does-not-exist"))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (fnnd (file-name-nondirectory tmp-name)) + (default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions) + (unwind-protect + (progn + ;; We cannot use "/bin/true" and "/bin/false"; those paths + ;; do not exist on hydra. + (should (zerop (process-file "true"))) + (should-not (zerop (process-file "false"))) + (should-not (zerop (process-file "binary-does-not-exist"))) + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (should (zerop (process-file "ls" nil t nil fnnd))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should (string-equal (format "%s\n" fnnd) (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + + ;; Second run. The output must be appended. + (goto-char (point-max)) + (should (zerop (process-file "ls" nil t t fnnd))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) + ;; A non-nil DISPLAY must not raise the buffer. + (should-not (get-buffer-window (current-buffer) t)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test27-start-file-process () + "Check `start-file-process'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((default-directory tramp-test-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name nil quoted)) + kill-buffer-query-functions proc) + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test1" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (setq proc + (start-file-process + "test2" (current-buffer) + "cat" (file-name-nondirectory tmp-name))) + (should (processp proc)) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors + (delete-process proc) + (delete-file tmp-name))) + + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test3" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (set-process-filter + proc + (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc)))))) + +(ert-deftest tramp-test28-shell-command () + "Check `shell-command'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted)) + (default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions) + (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) - (should (zerop (process-file "ls" nil t nil fnnd))) + (shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) ;; `ls' could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) (replace-match "" nil nil)) - (should (string-equal (format "%s\n" fnnd) (buffer-string))) - (should-not (get-buffer-window (current-buffer) t)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) - ;; Second run. The output must be appended. - (goto-char (point-max)) - (should (zerop (process-file "ls" nil t t fnnd))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name))) + + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (async-shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + (set-process-sentinel (get-buffer-process (current-buffer)) nil) + ;; Read output. + (with-timeout (10 (ert-fail "`async-shell-command' timed out")) + (while (< (- (point-max) (point-min)) + (1+ (length (file-name-nondirectory tmp-name)))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) (replace-match "" nil nil)) + ;; There might be a nasty "Process *Async Shell* finished" message. + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point-min) (point)) (should - (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) - ;; A non-nil DISPLAY must not raise the buffer. - (should-not (get-buffer-window (current-buffer) t)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test27-start-file-process () - "Check `start-file-process'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) - - (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name (tramp--test-make-temp-name)) - kill-buffer-query-functions proc) - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test1" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (setq proc - (start-file-process - "test2" (current-buffer) - "cat" (file-name-nondirectory tmp-name))) - (should (processp proc)) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors - (delete-process proc) - (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test3" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (set-process-filter - proc - (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))))) + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) -(ert-deftest tramp-test28-shell-command () - "Check `shell-command'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) + ;; Cleanup. + (ignore-errors (delete-file tmp-name))) - (let ((tmp-name (tramp--test-make-temp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output - (get-buffer-process (current-buffer)) 0.1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (process-send-string - (get-buffer-process (current-buffer)) - (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output - (get-buffer-process (current-buffer)) 0.1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (async-shell-command "read line; ls $line" (current-buffer)) + (set-process-sentinel (get-buffer-process (current-buffer)) nil) + (process-send-string + (get-buffer-process (current-buffer)) + (format "%s\n" (file-name-nondirectory tmp-name))) + ;; Read output. + (with-timeout (10 (ert-fail "`async-shell-command' timed out")) + (while (< (- (point-max) (point-min)) + (1+ (length (file-name-nondirectory tmp-name)))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + ;; There might be a nasty "Process *Async Shell* finished" message. + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point-min) (point)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) -(defun tramp-test--shell-command-to-string-asynchronously (command) +(defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer (async-shell-command command (current-buffer)) @@ -1720,7 +1840,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." '(;; Synchronously. shell-command-to-string ;; Asynchronously. - tramp-test--shell-command-to-string-asynchronously)) + tramp--test-shell-command-to-string-asynchronously)) (let ((default-directory tramp-test-temporary-file-directory) (shell-file-name "/bin/sh") @@ -1793,149 +1913,156 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (let* ((default-directory tramp-test-temporary-file-directory) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - (tramp-remote-process-environment tramp-remote-process-environment) - (vc-handled-backends - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (cond - ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) - '(Git)) - ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) - '(Hg)) - ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) - (setq tramp-remote-process-environment - (cons (format "BZR_HOME=%s" - (file-remote-p tmp-name1 'localname)) - tramp-remote-process-environment)) - ;; We must force a reconnect, in order to activate $BZR_HOME. - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - nil 'keep-password) - '(Bzr)) - (t nil))))) - (skip-unless vc-handled-backends) - (message "%s" vc-handled-backends) - - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should-not (vc-registered tmp-name1)) - (should-not (vc-registered tmp-name2)) - - (let ((default-directory tmp-name1)) - ;; Create empty repository, and register the file. - ;; Sometimes, creation of repository fails (bzr!); we skip - ;; the test then. - (condition-case nil - (vc-create-repo (car vc-handled-backends)) - (error (skip-unless nil))) - ;; The structure of VC-FILESET is not documented. Let's - ;; hope it won't change. - (condition-case nil - (vc-register - (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))) - ;; `vc-register' has changed its arguments in Emacs 25.1. - (error - (vc-register - nil (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))))) - ;; vc-git uses an own process sentinel, Tramp's sentinel - ;; for flushing the cache isn't used. - (dired-uncache (concat (file-remote-p default-directory) "/")) - (should (vc-registered (file-name-nondirectory tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((default-directory tramp-test-temporary-file-directory) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + (tramp-remote-process-environment tramp-remote-process-environment) + (vc-handled-backends + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (cond + ((tramp-find-executable + v vc-git-program (tramp-get-remote-path v)) + '(Git)) + ((tramp-find-executable + v vc-hg-program (tramp-get-remote-path v)) + '(Hg)) + ((tramp-find-executable + v vc-bzr-program (tramp-get-remote-path v)) + (setq tramp-remote-process-environment + (cons (format "BZR_HOME=%s" + (file-remote-p tmp-name1 'localname)) + tramp-remote-process-environment)) + ;; We must force a reconnect, in order to activate $BZR_HOME. + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + nil 'keep-password) + '(Bzr)) + (t nil))))) + (skip-unless vc-handled-backends) + (message "%s" vc-handled-backends) + + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (should-not (vc-registered tmp-name1)) + (should-not (vc-registered tmp-name2)) + + (let ((default-directory tmp-name1)) + ;; Create empty repository, and register the file. + ;; Sometimes, creation of repository fails (bzr!); we + ;; skip the test then. + (condition-case nil + (vc-create-repo (car vc-handled-backends)) + (error (skip-unless nil))) + ;; The structure of VC-FILESET is not documented. Let's + ;; hope it won't change. + (condition-case nil + (vc-register + (list (car vc-handled-backends) + (list (file-name-nondirectory tmp-name2)))) + ;; `vc-register' has changed its arguments in Emacs 25.1. + (error + (vc-register + nil (list (car vc-handled-backends) + (list (file-name-nondirectory tmp-name2)))))) + ;; vc-git uses an own process sentinel, Tramp's sentinel + ;; for flushing the cache isn't used. + (dired-uncache (concat (file-remote-p default-directory) "/")) + (should (vc-registered (file-name-nondirectory tmp-name2))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) (ert-deftest tramp-test31-make-auto-save-file-name () "Check `make-auto-save-file-name'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name))) - - (unwind-protect - (progn - ;; Use default `auto-save-file-name-transforms' mechanism. - (let (tramp-auto-save-directory) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from original `make-auto-save-file-name'. - (expand-file-name - (format - "#%s#" - (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) - temporary-file-directory))))) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted))) - ;; No mapping. - (let (tramp-auto-save-directory auto-save-file-name-transforms) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - (expand-file-name - (format "#%s#" (file-name-nondirectory tmp-name1)) - tramp-test-temporary-file-directory))))) + (unwind-protect + (progn + ;; Use default `auto-save-file-name-transforms' mechanism. + (let (tramp-auto-save-directory) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from original `make-auto-save-file-name'. + (expand-file-name + (format + "#%s#" + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + temporary-file-directory))))) + + ;; No mapping. + (let (tramp-auto-save-directory auto-save-file-name-transforms) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + (funcall + (if quoted 'tramp-quote-name 'identity) + (expand-file-name + (format "#%s#" (file-name-nondirectory tmp-name1)) + tramp-test-temporary-file-directory)))))) + + ;; Use default `tramp-auto-save-directory' mechanism. + (let ((tramp-auto-save-directory tmp-name2)) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-unquote-name tmp-name1))) + tmp-name2))) + (should (file-directory-p tmp-name2)))) + + ;; Relative file names shall work, too. + (let ((tramp-auto-save-directory ".")) + (with-temp-buffer + (setq buffer-file-name tmp-name1 + default-directory tmp-name2) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-unquote-name tmp-name1))) + tmp-name2))) + (should (file-directory-p tmp-name2))))) - ;; Use default `tramp-auto-save-directory' mechanism. - (let ((tramp-auto-save-directory tmp-name2)) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2)))) - - ;; Relative file names shall work, too. - (let ((tramp-auto-save-directory ".")) - (with-temp-buffer - (setq buffer-file-name tmp-name1 - default-directory tmp-name2) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test32-make-nearby-temp-file () @@ -2015,138 +2142,146 @@ Several special characters do not work properly there." (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name 'local)) - (files (delq nil files))) - (unwind-protect - (progn - (make-directory tmp-name1) - (make-directory tmp-name2) - (dolist (elt files) - (let* ((file1 (expand-file-name elt tmp-name1)) - (file2 (expand-file-name elt tmp-name2)) - (file3 (expand-file-name (concat elt "foo") tmp-name1))) - (write-region elt nil file1) - (should (file-exists-p file1)) - - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file1) - (should (string-equal (buffer-string) elt))) - - ;; Copy file both directions. - (copy-file file1 tmp-name2) - (should (file-exists-p file2)) - (delete-file file1) - (should-not (file-exists-p file1)) - (copy-file file2 tmp-name1) - (should (file-exists-p file1)) - - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (progn - (make-symbolic-link file1 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (expand-file-name file1) (file-truename file3))) - (should - (string-equal - (car (file-attributes file3)) - (file-remote-p (file-truename file1) 'localname))) - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file3) - (should (string-equal (buffer-string) elt))) - (delete-file file3)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))))) - - ;; Check file names. - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - (should (equal (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - - ;; `substitute-in-file-name' could return different values. - ;; For `adb', there could be strange file permissions - ;; preventing overwriting a file. We don't care in this - ;; testcase. - (dolist (elt files) - (let ((file1 - (substitute-in-file-name (expand-file-name elt tmp-name1))) - (file2 - (substitute-in-file-name (expand-file-name elt tmp-name2)))) - (ignore-errors (write-region elt nil file1)) - (should (file-exists-p file1)) - (ignore-errors (write-region elt nil file2 nil 'nomessage)) - (should (file-exists-p file2)))) - - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp))) - - ;; Check directory creation. We use a subdirectory "foo" - ;; in order to avoid conflicts with previous file name tests. - (dolist (elt files) - (let* ((elt1 (concat elt "foo")) - (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) - (file2 (expand-file-name elt file1)) - (file3 (expand-file-name elt1 file1))) - (make-directory file1 'parents) - (should (file-directory-p file1)) - (write-region elt nil file2) - (should (file-exists-p file2)) - (should - (equal - (directory-files file1 nil directory-files-no-dot-files-regexp) - `(,elt))) - (should - (equal - (caar (directory-files-and-attributes - file1 nil directory-files-no-dot-files-regexp)) - elt)) - - ;; Check symlink in `directory-files-and-attributes'. - (condition-case err - (progn - (make-symbolic-link file2 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) - elt1)) - (should - (string-equal - (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1)))) - (file-remote-p (file-truename file2) 'localname))) - (delete-file file3) - (should-not (file-exists-p file3))) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - (delete-file file2) - (should-not (file-exists-p file2)) - (delete-directory file1) - (should-not (file-exists-p file1))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) + (dolist (quoted '(if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name 'local quoted)) + (files (delq nil files))) + (unwind-protect + (progn + (make-directory tmp-name1) + (make-directory tmp-name2) + (dolist (elt files) + (let* ((file1 (expand-file-name elt tmp-name1)) + (file2 (expand-file-name elt tmp-name2)) + (file3 (expand-file-name (concat elt "foo") tmp-name1))) + (write-region elt nil file1) + (should (file-exists-p file1)) + + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file1) + (should (string-equal (buffer-string) elt))) + + ;; Copy file both directions. + (copy-file file1 tmp-name2) + (should (file-exists-p file2)) + (delete-file file1) + (should-not (file-exists-p file1)) + (copy-file file2 tmp-name1) + (should (file-exists-p file1)) + + ;; Method "smb" supports `make-symbolic-link' only if the + ;; remote host has CIFS capabilities. tramp-adb.el and + ;; tramp-gvfs.el do not support symbolic links at all. + (condition-case err + (progn + (make-symbolic-link file1 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (expand-file-name file1) (file-truename file3))) + (should + (string-equal + (funcall + (if quoted 'tramp-quote-name 'identity) + (car (file-attributes file3))) + (file-remote-p (file-truename file1) 'localname))) + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file3) + (should (string-equal (buffer-string) elt))) + (delete-file file3)) + (file-error + (should + (string-equal (error-message-string err) + "make-symbolic-link not supported")))))) + + ;; Check file names. + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp))) + (should (equal (directory-files + tmp-name2 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp))) + + ;; `substitute-in-file-name' could return different + ;; values. For `adb', there could be strange file + ;; permissions preventing overwriting a file. We don't + ;; care in this testcase. + (dolist (elt files) + (let ((file1 + (substitute-in-file-name (expand-file-name elt tmp-name1))) + (file2 + (substitute-in-file-name + (expand-file-name elt tmp-name2)))) + (ignore-errors (write-region elt nil file1)) + (should (file-exists-p file1)) + (ignore-errors (write-region elt nil file2 nil 'nomessage)) + (should (file-exists-p file2)))) + + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + (directory-files + tmp-name2 nil directory-files-no-dot-files-regexp))) + + ;; Check directory creation. We use a subdirectory "foo" + ;; in order to avoid conflicts with previous file name tests. + (dolist (elt files) + (let* ((elt1 (concat elt "foo")) + (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) + (file2 (expand-file-name elt file1)) + (file3 (expand-file-name elt1 file1))) + (make-directory file1 'parents) + (should (file-directory-p file1)) + (write-region elt nil file2) + (should (file-exists-p file2)) + (should + (equal + (directory-files + file1 nil directory-files-no-dot-files-regexp) + `(,elt))) + (should + (equal + (caar (directory-files-and-attributes + file1 nil directory-files-no-dot-files-regexp)) + elt)) + + ;; Check symlink in `directory-files-and-attributes'. + (condition-case err + (progn + (make-symbolic-link file2 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (caar (directory-files-and-attributes + file1 nil (regexp-quote elt1))) + elt1)) + (should + (string-equal + (funcall + (if quoted 'tramp-quote-name 'identity) + (cadr (car (directory-files-and-attributes + file1 nil (regexp-quote elt1))))) + (file-remote-p (file-truename file2) 'localname))) + (delete-file file3) + (should-not (file-exists-p file3))) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + + (delete-file file2) + (should-not (file-exists-p file2)) + (delete-directory file1) + (should-not (file-exists-p file1))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () "Perform the test in `tramp-test33-special-characters*'." @@ -2338,82 +2473,84 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This - ;; has the side effect, that this test fails instead to abort. Good - ;; for hydra. - (tramp--instrument-test-case 0 - (let* ((tmp-name (tramp--test-make-temp-name)) - (default-directory tmp-name) - (remote-file-name-inhibit-cache t) - timer buffers kill-buffer-query-functions) - - (unwind-protect - (progn - (make-directory tmp-name) - - ;; Setup a timer in order to raise an ordinary command again - ;; and again. `vc-registered' is well suited, because there - ;; are many checks. - (setq - timer - (run-at-time - 0 1 - (lambda () - (when buffers - (vc-registered - (buffer-name (nth (random (length buffers)) buffers))))))) - - ;; Create temporary buffers. The number of buffers - ;; corresponds to the number of processes; it could be - ;; increased in order to make pressure on Tramp. - (dotimes (i 5) - (add-to-list 'buffers (generate-new-buffer "*temp*"))) - - ;; Open asynchronous processes. Set process sentinel. - (dolist (buf buffers) - (async-shell-command "read line; touch $line; echo $line" buf) - (set-process-sentinel - (get-buffer-process buf) - (lambda (proc _state) - (delete-file (buffer-name (process-buffer proc)))))) - - ;; Send a string. Use a random order of the buffers. Mix - ;; with regular operation. - (let ((buffers (copy-sequence buffers)) - buf) - (while buffers - (setq buf (nth (random (length buffers)) buffers)) - (process-send-string - (get-buffer-process buf) (format "'%s'\n" buf)) - (file-attributes (buffer-name buf)) - (setq buffers (delq buf buffers)))) - - ;; Wait until the whole output has been read. - (with-timeout ((* 10 (length buffers)) - (ert-fail "`async-shell-command' timed out")) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. + ;; This has the side effect, that this test fails instead to + ;; abort. Good for hydra. + (tramp--instrument-test-case 0 + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (default-directory tmp-name) + (remote-file-name-inhibit-cache t) + timer buffers kill-buffer-query-functions) + + (unwind-protect + (progn + (make-directory tmp-name) + + ;; Setup a timer in order to raise an ordinary command + ;; again and again. `vc-registered' is well suited, + ;; because there are many checks. + (setq + timer + (run-at-time + 0 1 + (lambda () + (when buffers + (vc-registered + (buffer-name (nth (random (length buffers)) buffers))))))) + + ;; Create temporary buffers. The number of buffers + ;; corresponds to the number of processes; it could be + ;; increased in order to make pressure on Tramp. + (dotimes (i 5) + (add-to-list 'buffers (generate-new-buffer "*temp*"))) + + ;; Open asynchronous processes. Set process sentinel. + (dolist (buf buffers) + (async-shell-command "read line; touch $line; echo $line" buf) + (set-process-sentinel + (get-buffer-process buf) + (lambda (proc _state) + (delete-file (buffer-name (process-buffer proc)))))) + + ;; Send a string. Use a random order of the buffers. Mix + ;; with regular operation. (let ((buffers (copy-sequence buffers)) buf) (while buffers (setq buf (nth (random (length buffers)) buffers)) - (if (ignore-errors - (memq (process-status (get-buffer-process buf)) - '(run open))) - (accept-process-output (get-buffer-process buf) 0.1) - (setq buffers (delq buf buffers)))))) - - ;; Check. - (dolist (buf buffers) - (with-current-buffer buf - (should - (string-equal (format "'%s'\n" buf) (buffer-string))))) - (should-not - (directory-files tmp-name nil directory-files-no-dot-files-regexp))) + (process-send-string + (get-buffer-process buf) (format "'%s'\n" buf)) + (file-attributes (buffer-name buf)) + (setq buffers (delq buf buffers)))) + + ;; Wait until the whole output has been read. + (with-timeout ((* 10 (length buffers)) + (ert-fail "`async-shell-command' timed out")) + (let ((buffers (copy-sequence buffers)) + buf) + (while buffers + (setq buf (nth (random (length buffers)) buffers)) + (if (ignore-errors + (memq (process-status (get-buffer-process buf)) + '(run open))) + (accept-process-output (get-buffer-process buf) 0.1) + (setq buffers (delq buf buffers)))))) + + ;; Check. + (dolist (buf buffers) + (with-current-buffer buf + (should + (string-equal (format "'%s'\n" buf) (buffer-string))))) + (should-not + (directory-files + tmp-name nil directory-files-no-dot-files-regexp))) - ;; Cleanup. - (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)) - (dolist (buf buffers) - (ignore-errors (kill-buffer buf))))))) + ;; Cleanup. + (ignore-errors (cancel-timer timer)) + (ignore-errors (delete-directory tmp-name 'recursive)) + (dolist (buf buffers) + (ignore-errors (kill-buffer buf)))))))) (ert-deftest tramp-test36-recursive-load () "Check that Tramp does not fail due to recursive load." @@ -2421,9 +2558,7 @@ process sentinels. They shall not disturb each other." (dolist (code (list - (format - "(expand-file-name %S)" - tramp-test-temporary-file-directory) + (format "(expand-file-name %S)" tramp-test-temporary-file-directory) (format "(let ((default-directory %S)) (expand-file-name %S))" tramp-test-temporary-file-directory @@ -2476,6 +2611,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * dired-compress-file ;; * dired-uncache ;; * file-acl +;; * file-name-case-insensitive-p ;; * file-selinux-context ;; * find-backup-file-name ;; * set-file-acl