summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lispref/files.texi46
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/files.el47
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-sh.el2
-rw-r--r--lisp/net/tramp-smb.el2
-rw-r--r--lisp/net/tramp.el22
-rw-r--r--lisp/org/ob-core.el13
-rw-r--r--lisp/progmodes/gud.el6
-rw-r--r--lisp/vc/vc-git.el7
-rw-r--r--lisp/vc/vc-hooks.el2
-rw-r--r--test/lisp/net/tramp-tests.el241
13 files changed, 249 insertions, 149 deletions
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index ea9d53b0ea..0aea1dfd9a 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2440,6 +2440,50 @@ condition, between the @code{make-temp-name} call and the creation of
the file, which in some cases may cause a security hole.
@end defun
+Sometimes, it is necessary to create a temporary file on a remote host
+or a mounted directory. The following two functions support this.
+
+@defun make-nearby-temp-file prefix &optional dir-flag suffix
+This function is similar to @code{make-temp-file}, but it creates a
+temporary file as close as possible to @code{default-directory}. If
+@var{prefix} is a relative file name, and @code{default-directory} is
+a remote file name or located on a mounted file systems, the temporary
+file is created in the directory returned by the function
+@code{temporary-file-directory}. Otherwise, the function
+@code{make-temp-file} is used. @var{prefix}, @var{dir-flag} and
+@var{suffix} have the same meaning as in @code{make-temp-file}.
+
+@example
+@group
+(let ((default-directory "/ssh:remotehost:"))
+ (make-nearby-temp-file "foo"))
+ @result{} "/ssh:remotehost:/tmp/foo232J6v"
+@end group
+@end example
+@end defun
+
+@defun temporary-file-directory
+The directory for writing temporary files via
+@code{make-nearby-temp-file}. In case of a remote
+@code{default-directory}, this is a directory for temporary files on
+that remote host. If such a directory does not exist, or
+@code{default-directory} ought to be located on a mounted file system
+(see @code{mounted-file-systems}), the function returns
+@code{default-directory}. For a non-remote and non-mounted
+@code{default-directory}, the value of the variable
+@code{temporary-file-directory} is returned.
+@end defun
+
+In order to extract the local part of the path name from a temporary
+file, the following code could be used:
+
+@example
+@group
+(let ((tmpfile (make-nearby-temp-file "foo")))
+ (or (file-remote-p tmpfile 'localname) tmpfile))
+@end group
+@end example
+
@node File Name Completion
@subsection File Name Completion
@cindex file name completion subroutines
@@ -2903,6 +2947,7 @@ first, before handlers for jobs such as remote file access.
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
+@code{make-nearby-temp-file},
@code{make-symbolic-link},@*
@code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
@@ -2910,6 +2955,7 @@ first, before handlers for jobs such as remote file access.
@code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process},
@code{substitute-in-file-name},@*
+@code{temporary-file-directory},
@code{unhandled-file-name-directory},
@code{vc-registered},
@code{verify-visited-file-modtime},@*
diff --git a/etc/NEWS b/etc/NEWS
index 04c293dfc7..0a202ccade 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -563,7 +563,11 @@ ABBR is a time zone abbreviation. The affected functions are
The Info-quoted and tex-verbatim faces now default to inheriting from it.
** New built-in function `mapcan' which avoids unnecessary consing (and garbage
- collection).
+collection).
+
++++
+** The new functions `make-nearby-temp-file' and `temporary-file-directory'
+can be used for creation of temporary files of remote or mounted directories.
* Changes in Emacs 25.2 on Non-Free Operating Systems
diff --git a/lisp/files.el b/lisp/files.el
index 4d27ef16f7..1d7870be48 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1314,6 +1314,36 @@ Optional second argument FLAVOR controls the units and the display format:
(car post-fixes))
(if (eq flavor 'iec) "iB" ""))))
+(defcustom mounted-file-systems
+ (if (memq system-type '(windows-nt cygwin))
+ "^//[^/]+/"
+ ;; regexp-opt.el is not dumped into emacs binary.
+ ;;(concat
+ ;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
+ "^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
+ "File systems which ought to be mounted."
+ :group 'files
+ :version "25.2"
+ :require 'regexp-opt
+ :type 'regexp)
+
+(defun temporary-file-directory ()
+ "The directory for writing temporary files.
+In case of a remote `default-directory', this is a directory for
+temporary files on that remote host. If such a directory does
+not exist, or `default-directory' ought to be located on a
+mounted file system (see `mounted-file-systems'), the function
+returns `default-directory'.
+For a non-remote and non-mounted `default-directory', the value of
+the variable `temporary-file-directory' is returned."
+ (let ((handler (find-file-name-handler
+ default-directory 'temporary-file-directory)))
+ (if handler
+ (funcall handler 'temporary-file-directory)
+ (if (string-match mounted-file-systems default-directory)
+ default-directory
+ temporary-file-directory))))
+
(defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
@@ -1350,6 +1380,21 @@ If SUFFIX is non-nil, add that at the end of the file name."
nil)
file)))
+(defun make-nearby-temp-file (prefix &optional dir-flag suffix)
+ "Create a temporary file as close as possible to `default-directory'.
+If PREFIX is a relative file name, and `default-directory' is a
+remote file name or located on a mounted file systems, the
+temporary file is created in the directory returned by the
+function `temporary-file-directory'. Otherwise, the function
+`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
+same meaning as in `make-temp-file'."
+ (let ((handler (find-file-name-handler
+ default-directory 'make-nearby-temp-file)))
+ (if (and handler (not (file-name-absolute-p default-directory)))
+ (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
+ (let ((temporary-file-directory (temporary-file-directory)))
+ (make-temp-file prefix dir-flag suffix)))))
+
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
The value is a new name of FILE.
@@ -4404,7 +4449,7 @@ ignored."
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
-`small-temporary-file-directory', and /tmp."
+`small-temporary-file-directory', and \"/tmp\"."
(let ((temporary-file-directory temporary-file-directory)
caseless)
;; On MS-Windows, file-truename will convert short 8+3 aliases to
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 002a7fe52c..07fc3e2bf5 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -148,6 +148,7 @@ It is used for TCP/IP devices."
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
@@ -159,6 +160,7 @@ It is used for TCP/IP devices."
(shell-command . tramp-adb-handle-shell-command)
(start-file-process . tramp-adb-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 62129172d9..d12bab954a 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -502,6 +502,7 @@ Every entry is a list (NAME ADDRESS).")
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
@@ -513,6 +514,7 @@ Every entry is a list (NAME ADDRESS).")
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b41eeac5bb..f1044730ff 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1043,6 +1043,7 @@ of command line.")
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file)
@@ -1054,6 +1055,7 @@ of command line.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-sh-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 60e2aa44c2..bbf88fbf4f 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -265,6 +265,7 @@ See `tramp-actions-before-shell' for more info.")
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
@@ -276,6 +277,7 @@ See `tramp-actions-before-shell' for more info.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 35b049c4f6..29dd7038c0 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1917,7 +1917,9 @@ ARGS are the arguments OPERATION has been called with."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((member operation
- '(process-file shell-command start-file-process))
+ '(process-file shell-command start-file-process
+ ;; Emacs 25.2+ only.
+ make-nearby-temp-file temporary-file-directory))
default-directory)
;; PROC.
((member operation
@@ -3893,9 +3895,6 @@ be granted."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
- (when (file-remote-p (tramp-get-connection-property vec "tmpdir" ""))
- ;; Compatibility code: Cached value shall be the local path only.
- (tramp-set-connection-property vec "tmpdir" 'undef))
(let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
@@ -3985,6 +3984,21 @@ ALIST is of the form ((FROM . TO) ...)."
(setq alist (cdr alist))))
string))
+(defun tramp-handle-temporary-file-directory ()
+ "Like `temporary-file-directory' for Tramp files."
+ (catch 'result
+ (dolist (dir `(,(ignore-errors
+ (tramp-get-remote-tmpdir
+ (tramp-dissect-file-name default-directory)))
+ ,default-directory))
+ (when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
+ (throw 'result (expand-file-name dir))))))
+
+(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
+ "Like `make-nearby-temp-file' for Tramp files."
+ (let ((temporary-file-directory (temporary-file-directory)))
+ (make-temp-file prefix dir-flag suffix)))
+
;;; Compatibility functions section:
(defun tramp-call-process
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index b7e8c23725..e3d778f73b 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -43,11 +43,6 @@
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
(filename &optional dir-flag))
-(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
-(declare-function tramp-file-name-user "tramp" (vec))
-(declare-function tramp-file-name-host "tramp" (vec))
-(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)
- t)
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-edit-src-code "org-src"
(&optional context code edit-buffer-name))
@@ -2670,7 +2665,7 @@ of the string."
(start end program &optional delete buffer display &rest args)
"Use Tramp to handle `call-process-region'.
Fixes a bug in `tramp-handle-call-process-region'."
- (if (and (featurep 'tramp) (file-remote-p default-directory))
+ (if (file-remote-p default-directory)
(let ((tmpfile (tramp-compat-make-temp-file "")))
(write-region start end tmpfile)
(when delete (delete-region start end))
@@ -2687,11 +2682,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
- (if (file-remote-p file)
- (let (localname)
- (with-parsed-tramp-file-name file nil
- localname))
- file))
+ (or (file-remote-p file 'localname) file))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 504ad546cf..9052aa4035 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -2567,9 +2567,6 @@ comint mode, which see."
:group 'gud
:type 'boolean)
-(declare-function tramp-file-name-localname "tramp" (vec))
-(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
-
;; Perform initializations common to all debuggers.
;; The first arg is the specified command line,
;; which starts with the program to debug.
@@ -2628,8 +2625,7 @@ comint mode, which see."
(setcar w
(if (file-remote-p file)
;; Tramp has already been loaded if we are here.
- (setq file (tramp-file-name-localname
- (tramp-dissect-file-name file)))
+ (setq file (file-remote-p file 'localname))
file))))
(apply 'make-comint (concat "gud" filepart) program nil
(if massage-args (funcall massage-args file args) args))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e6fe0196d8..43a831f159 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -705,7 +705,12 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; arguments must be in the system codepage, and therefore
;; might not support the non-ASCII characters in the log
;; message.
- (if (eq system-type 'windows-nt) (make-temp-file "git-msg"))))
+ (if (eq system-type 'windows-nt)
+ (if (file-remote-p file1)
+ (let ((default-directory (file-name-directory file1)))
+ (file-remote-p
+ (make-nearby-temp-file "git-msg") 'localname))
+ (make-temp-file "git-msg")))))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 6b4cd6acd0..f59b4632e7 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -394,7 +394,7 @@ For registered files, the possible values are:
(defun vc-user-login-name (file)
"Return the name under which the user accesses the given FILE."
- (or (and (eq (string-match tramp-file-name-regexp file) 0)
+ (or (and (file-remote-p file)
;; tramp case: execute "whoami" via tramp
(let ((default-directory (file-name-directory file))
process-file-side-effects)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e05786fa07..af705f6ce6 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -639,23 +639,24 @@ This checks also `file-name-as-directory', `file-name-directory',
(unhandled-file-name-directory "/method:host:/path/to/file"))
;; Bug#10085.
- (dolist (n-e '(nil t))
- ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
- ;; which ruins the tests.
- (let ((non-essential n-e)
- tramp-default-method)
- (dolist (file
- `(,(file-remote-p tramp-test-temporary-file-directory 'method)
- ,(file-remote-p tramp-test-temporary-file-directory 'host)))
- (unless (zerop (length file))
- (setq file (format "/%s:" file))
- (should (string-equal (directory-file-name file) file))
- (should
- (string-equal
- (file-name-as-directory file)
- (if (tramp-completion-mode-p) file (concat file "./"))))
- (should (string-equal (file-name-directory file) file))
- (should (string-equal (file-name-nondirectory file) "")))))))
+ (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
+ (dolist (n-e '(nil t))
+ ;; We must clear `tramp-default-method'. On hydra, it is "ftp",
+ ;; which ruins the tests.
+ (let ((non-essential n-e)
+ tramp-default-method)
+ (dolist (file
+ `(,(file-remote-p tramp-test-temporary-file-directory 'method)
+ ,(file-remote-p tramp-test-temporary-file-directory 'host)))
+ (unless (zerop (length file))
+ (setq file (format "/%s:" file))
+ (should (string-equal (directory-file-name file) file))
+ (should
+ (string-equal
+ (file-name-as-directory file)
+ (if (tramp-completion-mode-p) file (concat file "./"))))
+ (should (string-equal (file-name-directory file) file))
+ (should (string-equal (file-name-nondirectory file) ""))))))))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
@@ -1091,7 +1092,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
-This tests also `file-readable-p' and `file-regular-p'."
+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
@@ -1111,10 +1113,16 @@ This tests also `file-readable-p' and `file-regular-p'."
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))
@@ -1138,9 +1146,13 @@ This tests also `file-readable-p' and `file-regular-p'."
(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)
@@ -1167,11 +1179,15 @@ This tests also `file-readable-p' and `file-regular-p'."
(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)))
@@ -1227,13 +1243,7 @@ This tests also `file-readable-p' and `file-regular-p'."
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-adb-file-name-handler
- tramp-gvfs-file-name-handler
- tramp-smb-file-name-handler))))
+ (skip-unless (tramp--test-sh-p))
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
@@ -1337,11 +1347,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
(skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
+ (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))
@@ -1499,11 +1505,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
+ (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))
@@ -1548,13 +1550,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-adb-file-name-handler
- tramp-gvfs-file-name-handler
- tramp-smb-file-name-handler))))
+ (skip-unless (tramp--test-sh-p))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name))
@@ -1569,7 +1565,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
- (accept-process-output proc 1)))
+ (accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@@ -1587,7 +1583,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
- (accept-process-output proc 1)))
+ (accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@@ -1608,7 +1604,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
- (accept-process-output proc 1)))
+ (accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@@ -1618,13 +1614,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `shell-command'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-adb-file-name-handler
- tramp-gvfs-file-name-handler
- tramp-smb-file-name-handler))))
+ (skip-unless (tramp--test-sh-p))
(let ((tmp-name (tramp--test-make-temp-name))
(default-directory tramp-test-temporary-file-directory)
@@ -1657,7 +1647,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(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)) 1)))
+ (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)
@@ -1686,7 +1677,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(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)) 1)))
+ (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)
@@ -1708,9 +1700,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(async-shell-command command (current-buffer))
;; Suppress nasty messages.
(set-process-sentinel (get-buffer-process (current-buffer)) nil)
- (while (get-buffer-process (current-buffer))
- (accept-process-output (get-buffer-process (current-buffer)) 0.1))
- (accept-process-output)
+ (with-timeout (10)
+ (while (get-buffer-process (current-buffer))
+ (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
+ (accept-process-output nil 0.1)
(buffer-substring-no-properties (point-min) (point-max))))
;; This test is inspired by Bug#23952.
@@ -1718,10 +1711,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check that remote processes set / unset environment variables properly."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (tramp--test-sh-p))
(dolist (this-shell-command-to-string
'(;; Synchronously.
@@ -1798,10 +1788,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `vc-registered'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (tramp--test-sh-p))
(let* ((default-directory tramp-test-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name))
@@ -1947,6 +1934,36 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-directory tmp-name2 'recursive)))))
+(ert-deftest tramp-test32-make-nearby-temp-file ()
+ "Check `make-nearby-temp-file' and `temporary-file-directory'."
+ (skip-unless (tramp--test-enabled))
+
+ (let ((default-directory tramp-test-temporary-file-directory)
+ tmp-file)
+ ;; The remote host shall know a tempory file directory.
+ (should (stringp (temporary-file-directory)))
+ (should
+ (string-equal
+ (file-remote-p default-directory)
+ (file-remote-p (temporary-file-directory))))
+
+ ;; The temporary file shall be located on the remote host.
+ (setq tmp-file (make-nearby-temp-file "tramp-test"))
+ (should (file-exists-p tmp-file))
+ (should (file-regular-p tmp-file))
+ (should
+ (string-equal
+ (file-remote-p default-directory)
+ (file-remote-p tmp-file)))
+ (delete-file tmp-file)
+ (should-not (file-exists-p tmp-file))
+
+ (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
+ (should (file-exists-p tmp-file))
+ (should (file-directory-p tmp-file))
+ (delete-directory tmp-file)
+ (should-not (file-exists-p tmp-file))))
+
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."
@@ -1956,11 +1973,13 @@ This requires restrictions of file name syntax."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (and (eq (tramp-find-foreign-file-name-handler
- tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler)
- (string-match
- "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))))
+ (string-match
+ "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
+
+(defun tramp--test-gvfs-p ()
+ "Check, whether the remote host runs a GVFS based method.
+This requires restrictions of file name syntax."
+ (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
@@ -1968,10 +1987,11 @@ This does not support special file names."
(string-equal
"rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
-(defun tramp--test-gvfs-p ()
- "Check, whether the remote host runs a GVFS based method.
-This requires restrictions of file name syntax."
- (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
+(defun tramp--test-sh-p ()
+ "Check, whether the remote host runs a based method from tramp-sh.el."
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
(defun tramp--test-smb-or-windows-nt-p ()
"Check, whether the locale or remote host runs MS Windows.
@@ -2123,7 +2143,7 @@ Several special characters do not work properly there."
(ignore-errors (delete-directory tmp-name2 'recursive)))))
(defun tramp--test-special-characters ()
- "Perform the test in `tramp-test32-special-characters*'."
+ "Perform the test in `tramp-test33-special-characters*'."
;; Newlines, slashes and backslashes in file names are not
;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is
@@ -2164,23 +2184,19 @@ Several special characters do not work properly there."
"{foo}bar{baz}"))
;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test32-special-characters ()
+(ert-deftest tramp-test33-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(tramp--test-special-characters))
-(ert-deftest tramp-test32-special-characters-with-stat ()
+(ert-deftest tramp-test33-special-characters-with-stat ()
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -2191,16 +2207,12 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test32-special-characters-with-perl ()
+(ert-deftest tramp-test33-special-characters-with-perl ()
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -2214,16 +2226,12 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test32-special-characters-with-ls ()
+(ert-deftest tramp-test33-special-characters-with-ls ()
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(let ((tramp-connection-properties
(append
@@ -2238,7 +2246,7 @@ Use the `ls' command."
(tramp--test-special-characters)))
(defun tramp--test-utf8 ()
- "Perform the test in `tramp-test33-utf8*'."
+ "Perform the test in `tramp-test34-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
@@ -2252,23 +2260,19 @@ Use the `ls' command."
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
-(ert-deftest tramp-test33-utf8 ()
+(ert-deftest tramp-test34-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(tramp--test-utf8))
-(ert-deftest tramp-test33-utf8-with-stat ()
+(ert-deftest tramp-test34-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -2279,16 +2283,12 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test33-utf8-with-perl ()
+(ert-deftest tramp-test34-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -2302,16 +2302,12 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test33-utf8-with-ls ()
+(ert-deftest tramp-test34-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(let ((tramp-connection-properties
(append
@@ -2326,7 +2322,7 @@ Use the `ls' command."
(tramp--test-utf8)))
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test34-asynchronous-requests ()
+(ert-deftest tramp-test35-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@@ -2334,10 +2330,7 @@ process sentinels. They shall not disturb each other."
:expected-result :failed
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (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
@@ -2416,7 +2409,7 @@ process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(ignore-errors (kill-buffer buf)))))))
-(ert-deftest tramp-test35-recursive-load ()
+(ert-deftest tramp-test36-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -2439,7 +2432,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test36-unload ()
+(ert-deftest tramp-test37-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
;; Mark as failed until all symbols are unbound.
@@ -2477,7 +2470,6 @@ Since it unloads Tramp, it shall be the last test to run."
;; * dired-compress-file
;; * dired-uncache
;; * file-acl
-;; * file-ownership-preserved-p
;; * file-selinux-context
;; * find-backup-file-name
;; * set-file-acl
@@ -2485,10 +2477,9 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
-;; * Fix `tramp-test15-copy-directory' for `rsync'.
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
-;; * Fix Bug#16928. Set expected error of `tramp-test34-asynchronous-requests'.
-;; * Fix `tramp-test36-unload' (Not all symbols are unbound). Set
+;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'.
+;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set
;; expected error.
(defun tramp-test-all (&optional interactive)
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-21 19:50:46 +0000