[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 35a86f0: Implement quoting the local part of a remo
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 35a86f0: Implement quoting the local part of a remote file name |
|
Date: |
Sun, 4 Dec 2016 11:12:22 +0000 (UTC) |
branch: master
commit 35a86f0b6fe5634e94212964657c538739743d72
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
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.
---
doc/emacs/files.texi | 5 +
etc/NEWS | 6 +
lisp/net/tramp-sh.el | 5 +-
lisp/net/tramp.el | 60 +-
test/lisp/net/tramp-tests.el | 2638 ++++++++++++++++++++++--------------------
5 files changed, 1444 insertions(+), 1270 deletions(-)
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 7bf4690..ef362e9 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.
address@hidden/baz:/:/foo:/bar} refers to the file @file{bar} of directory
address@hidden/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 f7565b0..a62668a 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 f44a4d3..c87b406 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 956cf15..a92b602 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 '("\\<with-tramp-connection-property\\>"))
+(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 d88dbce..c2984df 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:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file")
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file"))
(format "/%s:address@hidden|%s:address@hidden|%s:address@hidden:"
"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:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file"
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file")
'method)
"method3"))
(should
(string-equal
(file-remote-p
-
"/method1:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file"
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file")
'user)
"user3"))
(should
(string-equal
(file-remote-p
-
"/method1:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file"
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file")
'host)
"host3"))
(should
(string-equal
(file-remote-p
-
"/method1:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file"
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file")
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
-
"/method1:address@hidden|method2:address@hidden|method3:address@hidden:/path/to/file"
+ (concat
+ "/method1:address@hidden"
+ "|method2:address@hidden"
+ "|method3:address@hidden:/path/to/file")
'hop)
(format "%s:address@hidden|%s:address@hidden|"
"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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 35a86f0: Implement quoting the local part of a remote file name,
Michael Albinus <=