[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 4ab7800: Make ange-ftp fit for tramp-tests
|
From: |
Michael Albinus |
|
Subject: |
master 4ab7800: Make ange-ftp fit for tramp-tests |
|
Date: |
Thu, 7 Nov 2019 06:03:27 -0500 (EST) |
branch: master
commit 4ab780012649bbab60238148efd9d3b4a819fd61
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Make ange-ftp fit for tramp-tests
* lisp/net/ange-ftp.el (ange-ftp-repaint-minibuffer): Use empty message.
(ange-ftp-quote-string): Unquote the string.
(ange-ftp-substitute-in-file-name, ange-ftp-access-file)
(ange-ftp-copy-directory, ange-ftp-make-symbolic-link)
(ange-ftp-add-name-to-file): New defuns. Set 'ange-ftp property.
(ange-ftp-real-substitute-in-file-name)
(ange-ftp-real-copy-directory): New defuns.
(ange-ftp-file-name-as-directory): Care about `non-essential'.
(ange-ftp-file-attributes): Handle ID-STRING.
(ange-ftp-copy-file-internal, ange-ftp-rename-file)
(ange-ftp-make-directory): Improve error handling.
(ange-ftp-insert-directory): Initialize SWITCHES if they are nil.
* test/lisp/net/tramp-tests.el (ange-ftp-make-backup-files): Declare.
(tramp-test39-make-nearby-temp-file, tramp--test-ange-ftp-p): New defun.
(tramp-test05-expand-file-name-relative)
(tramp-test06-directory-file-name, tramp-test10-write-region)
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test17-insert-directory)
(tramp-test26-file-name-completion)
(tramp-test37-make-auto-save-file-name)
(tramp-test38-find-backup-file-name)
(tramp--test-special-characters): Use it.
---
lisp/net/ange-ftp.el | 92 ++++++++++++--
test/lisp/net/tramp-tests.el | 283 ++++++++++++++++++++++++-------------------
2 files changed, 242 insertions(+), 133 deletions(-)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index a5fc963..16e8e75 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1463,7 +1463,7 @@ only return the directory part of FILE."
(defun ange-ftp-repaint-minibuffer ()
"Clear any existing minibuffer message; let the minibuffer contents show."
- (message nil))
+ (message ""))
;; Return the name of the buffer that collects output from the ftp process
;; connected to the given HOST and USER pair.
@@ -1512,8 +1512,10 @@ then kill the related FTP process."
;; and that by doubling it. But experiment says UNIX-style kind of
;; quoting is correct when talking to ftp on GNU/Linux systems, and
;; W32-style kind of quoting on, yes, W32 systems.
+ ;; STRING could be a quoted file name, we unquote it. It is
+ ;; unlikely, that other strings but file names look alike.
(if (stringp string)
- (shell-quote-argument string)
+ (shell-quote-argument (file-name-unquote string))
""))
(defun ange-ftp-barf-if-not-directory (directory)
@@ -3144,6 +3146,12 @@ logged in as user USER and cd'd to directory DIR."
(ange-ftp-real-expand-file-name name "/"))
((ange-ftp-canonize-filename
(concat (file-name-as-directory default) name))))))
+
+(defun ange-ftp-substitute-in-file-name (filename)
+ "Documented as `substitute-in-file-name'."
+ (if (file-name-quoted-p filename)
+ filename
+ (ange-ftp-real-substitute-in-file-name filename)))
;;; These are problems--they are currently not enabled.
@@ -3156,7 +3164,7 @@ system TYPE.")
"Documented as `file-name-as-directory'."
(let ((parsed (ange-ftp-ftp-name name)))
(if parsed
- (if (string-equal (nth 2 parsed) "")
+ (if (and non-essential (string-equal (nth 2 parsed) ""))
name
(funcall (or (cdr (assq
(ange-ftp-host-type (car parsed))
@@ -3392,6 +3400,11 @@ system TYPE.")
t)))
(ange-ftp-real-file-exists-p name)))
+(defun ange-ftp-access-file (filename string)
+ (unless (file-readable-p (file-truename filename))
+ (signal
+ 'file-missing (list "%s: No such file or directory %s" string filename))))
+
(defun ange-ftp-file-directory-p (name)
(setq name (expand-file-name name))
(if (ange-ftp-ftp-name name)
@@ -3465,8 +3478,10 @@ system TYPE.")
(file-name-directory file))
dirp) ;0 file type
-1 ;1 link count
- -1 ;2 uid
- -1 ;3 gid
+ (if (eq id-format 'string)
+ "nobody" -1) ;2 uid
+ (if (eq id-format 'string)
+ "nobody" -1) ;3 gid
'(0 0) ;4 atime
(ange-ftp-file-modtime file) ;5 mtime
'(0 0) ;6 ctime
@@ -3613,6 +3628,16 @@ so return the size on the remote host exactly. See RFC
3659."
absname querystring)))
(signal 'file-already-exists (list absname))))))
+(defun ange-ftp-copy-directory
+ (directory newname &optional keep-date parents copy-contents)
+ ;; `copy-directory' creates `newname' before running this check. So
+ ;; we do it ourselves.
+ (unless (file-exists-p directory)
+ (signal 'file-missing (list "No such file or directory" directory)))
+ ;; We must do it file-wise.
+ (ange-ftp-real-copy-directory
+ directory newname keep-date parents copy-contents))
+
;; async local copy commented out for now since I don't seem to get
;; the process sentinel called for some processes.
;;
@@ -3662,6 +3687,12 @@ so return the size on the remote host exactly. See RFC
3659."
(signal 'file-missing
(list "Copy file" "No such file or directory" filename)))
+ (and (not ok-if-already-exists) (file-exists-p newname)
+ (signal 'file-already-exists (list newname)))
+
+ (and (file-directory-p newname) (not (directory-name-p newname))
+ (signal 'file-error (list "File is a directory %s" newname)))
+
;; canonicalize newname if a directory.
(if (file-directory-p newname)
(setq newname (expand-file-name (file-name-nondirectory filename)
newname)))
@@ -3929,6 +3960,11 @@ E.g.,
(defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
(interactive "fRename file: \nFRename %s to file: \np")
+
+ (or (file-exists-p filename)
+ (signal 'file-missing
+ (list "Copy file" "No such file or directory" filename)))
+
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
(let* ((f-parsed (ange-ftp-ftp-name filename))
@@ -4093,7 +4129,9 @@ directory, so that Emacs will know its current contents."
(ange-ftp-make-directory parent parents))))
(if (file-exists-p dir)
(unless parents
- (error "Cannot make directory %s: file already exists" dir))
+ (signal
+ 'file-already-exists
+ (list "Cannot make directory: file already exists" dir)))
(let ((parsed (ange-ftp-ftp-name dir)))
(if parsed
(let* ((host (nth 0 parsed))
@@ -4206,7 +4244,7 @@ directory, so that Emacs will know its current contents."
(while (and tryfiles (not copy))
(catch 'ftp-error
(let ((ange-ftp-waiting-flag t))
- (condition-case _error
+ (condition-case nil
(setq copy (ange-ftp-file-local-copy (car tryfiles)))
(ftp-error nil))))
(setq tryfiles (cdr tryfiles)))
@@ -4389,6 +4427,7 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory)
(put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name)
(put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name)
+(put 'substitute-in-file-name 'ange-ftp 'ange-ftp-substitute-in-file-name)
(put 'make-directory 'ange-ftp 'ange-ftp-make-directory)
(put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
(put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
@@ -4403,11 +4442,13 @@ NEWNAME should be the name to give the new compressed
or uncompressed file.")
(put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
(put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
(put 'file-regular-p 'ange-ftp 'ange-ftp-file-regular-p)
+(put 'access-file 'ange-ftp 'ange-ftp-access-file)
(put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
(put 'verify-visited-file-modtime 'ange-ftp
'ange-ftp-verify-visited-file-modtime)
(put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p)
(put 'write-region 'ange-ftp 'ange-ftp-write-region)
+(put 'copy-directory 'ange-ftp 'ange-ftp-copy-directory)
(put 'copy-file 'ange-ftp 'ange-ftp-copy-file)
(put 'rename-file 'ange-ftp 'ange-ftp-rename-file)
(put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
@@ -4425,6 +4466,8 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(put 'load 'ange-ftp 'ange-ftp-load)
(put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
(put 'set-file-modes 'ange-ftp 'ange-ftp-set-file-modes)
+(put 'make-symbolic-link 'ange-ftp 'ange-ftp-make-symbolic-link)
+(put 'add-name-to-file 'ange-ftp 'ange-ftp-add-name-to-file)
;; Turn off truename processing to save time.
;; Treat each name as its own truename.
@@ -4439,7 +4482,7 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
;; This returns nil for any file name as argument.
(put 'vc-registered 'ange-ftp 'null)
-;; We can handle process-file in a restricted way (just for chown).
+;; We can handle `process-file' in a restricted way (just for chown).
;; Nothing possible for `start-file-process'.
(put 'exec-path 'ange-ftp 'ignore)
(put 'make-process 'ange-ftp 'ignore)
@@ -4473,6 +4516,8 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(ange-ftp-run-real-handler 'directory-file-name args))
(defun ange-ftp-real-expand-file-name (&rest args)
(ange-ftp-run-real-handler 'expand-file-name args))
+(defun ange-ftp-real-substitute-in-file-name (&rest args)
+ (ange-ftp-run-real-handler 'substitute-in-file-name args))
(defun ange-ftp-real-make-directory (&rest args)
(ange-ftp-run-real-handler 'make-directory args))
(defun ange-ftp-real-delete-directory (&rest args)
@@ -4507,6 +4552,8 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(ange-ftp-run-real-handler 'write-region args))
(defun ange-ftp-real-backup-buffer (&rest args)
(ange-ftp-run-real-handler 'backup-buffer args))
+(defun ange-ftp-real-copy-directory (&rest args)
+ (ange-ftp-run-real-handler 'copy-directory args))
(defun ange-ftp-real-copy-file (&rest args)
(ange-ftp-run-real-handler 'copy-file args))
(defun ange-ftp-real-rename-file (&rest args)
@@ -4552,6 +4599,8 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
;; because some FTP servers react to "ls foo" by listing the symlink foo
;; rather than the directory it points to. Now that ange-ftp-ls uses
;; "cd foo; ls" instead, this is not necessary any more.
+ ;; SWITCHES cannot be nil or the empty string.
+ (unless switches (setq switches "--"))
(let ((beg (point))
(end (point-marker)))
(set-marker-insertion-type end t)
@@ -4693,6 +4742,33 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(defun ange-ftp-set-file-modes (filename mode)
(ange-ftp-call-chmod (list (format "%o" mode) filename)))
+
+(defun ange-ftp-make-symbolic-link (&rest _arguments)
+ (signal 'file-error (list "make-symbolic-link not supported")))
+
+(defun ange-ftp-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ (let ((f-parsed (ange-ftp-ftp-name filename))
+ (n-parsed (ange-ftp-ftp-name newname)))
+ (unless (and (string-equal (nth 0 f-parsed) (nth 0 n-parsed))
+ (string-equal (nth 1 f-parsed) (nth 1 n-parsed)))
+ (signal
+ 'file-error
+ (list "add-name-to-file: only implemented for same user, same host")))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ (nth 2 n-parsed))))))
+ (signal 'file-already-exists (list newname))
+ (delete-file newname)))
+ (copy-file
+ filename newname 'ok-if-already-exists 'keep-time
+ 'preserve-uid-gid 'preserve-permissions)))
;; This is turned off because it has nothing properly to do
;; with dired. It could be reasonable to adapt this to
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9b73f7c..271ac72 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -57,6 +57,7 @@
(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(declare-function tramp-time-diff "tramp")
+(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
@@ -264,7 +265,7 @@ properly. BODY shall not contain a timeout."
;; No newline or linefeed.
(should-not (tramp-tramp-file-p "/method::file\nname"))
(should-not (tramp-tramp-file-p "/method::file\rname"))
- ;; Ange-ftp syntax.
+ ;; Ange-FTP syntax.
(should-not (tramp-tramp-file-p "/host:"))
(should-not (tramp-tramp-file-p "/user@host:"))
(should-not (tramp-tramp-file-p "/1.2.3.4:"))
@@ -398,7 +399,7 @@ properly. BODY shall not contain a timeout."
;; No strings.
(should-not (tramp-tramp-file-p nil))
(should-not (tramp-tramp-file-p 'symbol))
- ;; Ange-ftp syntax.
+ ;; Ange-FTP syntax.
(should-not (tramp-tramp-file-p "/host:"))
(should-not (tramp-tramp-file-p "/user@host:"))
(should-not (tramp-tramp-file-p "/1.2.3.4:"))
@@ -2065,7 +2066,8 @@ properly. BODY shall not contain a timeout."
(skip-unless (tramp--test-enabled))
;; These are the methods the test doesn't fail.
- (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) (tramp--test-rclone-p)
+ (when (or (tramp--test-adb-p) (tramp--test-ange-ftp-p) (tramp--test-gvfs-p)
+ (tramp--test-rclone-p)
(tramp-smb-file-name-p tramp-test-temporary-file-directory))
(setf (ert-test-expected-result-type
(ert-get-test 'tramp-test05-expand-file-name-relative))
@@ -2150,7 +2152,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(string-equal
(file-name-as-directory file)
(if (tramp-completion-mode-p)
- file (concat file "./"))))
+ file (concat file (if (tramp--test-ange-ftp-p) "/" "./")))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
@@ -2255,18 +2257,19 @@ This checks also `file-name-as-directory',
`file-name-directory',
(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")))
- (with-temp-buffer
- (insert "baz")
- (write-region nil nil tmp-name 3))
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foobaz")))
+ (unless (tramp--test-ange-ftp-p)
+ (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")))
+ (with-temp-buffer
+ (insert "baz")
+ (write-region nil nil tmp-name 3))
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "foobaz"))))
;; Write string.
(write-region "foo" nil tmp-name)
@@ -2286,7 +2289,8 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
(with-no-warnings (when (symbol-plist 'ert-with-message-capture)
(let ((tramp-message-show-message t))
- (dolist (noninteractive '(nil t))
+ (dolist
+ (noninteractive (unless (tramp--test-ange-ftp-p) '(nil t)))
(dolist (visit '(nil t "string" no-message))
(ert-with-message-capture tramp--test-messages
(write-region "foo" nil tmp-name nil visit)
@@ -2300,12 +2304,16 @@ This checks also `file-name-as-directory',
`file-name-directory',
tramp--test-messages))))))))
;; Do not overwrite if excluded.
- (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)))
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))
+ ;; Ange-FTP.
+ ((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
;; `mustbenew' is passed to Tramp since Emacs 26.1.
(when (tramp--test-emacs26-p)
(should-error
- (cl-letf (((symbol-function 'y-or-n-p) 'ignore))
+ (cl-letf (((symbol-function 'y-or-n-p) 'ignore)
+ ;; Ange-FTP.
+ ((symbol-function 'yes-or-no-p) 'ignore))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
:type 'file-already-exists)
(should-error
@@ -2394,7 +2402,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (tramp--test-nextcloud-p)
+ (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
(write-region "foo" nil source)
(should (file-exists-p source))
(make-directory target)
@@ -2420,7 +2428,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (tramp--test-nextcloud-p)
+ (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2443,7 +2451,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (tramp--test-nextcloud-p)
+ (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2538,7 +2546,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (tramp--test-nextcloud-p)
+ (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2562,7 +2570,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
;; FIXME: This fails on my QNAP server, see
;; /share/Web/owncloud/data/owncloud.log
- (unless (tramp--test-nextcloud-p)
+ (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2810,6 +2818,10 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test17-insert-directory ()
"Check `insert-directory'."
(skip-unless (tramp--test-enabled))
+ ;; Ange-FTP is very special. It does not include the header line
+ ;; (this is performed by `dired'). If FULL is nil, it shows just
+ ;; one file. So we refrain from testing.
+ (skip-unless (not (tramp--test-ange-ftp-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -3928,9 +3940,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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/"))
+ ;; Ange-FTP does not support predicates.
+ (unless (tramp--test-ange-ftp-p)
+ (should
+ (equal
+ (file-name-completion "b" tmp-name #'file-directory-p)
+ "boz/")))
(should
(equal (file-name-all-completions "fo" tmp-name) '("foo")))
(should
@@ -3940,14 +3955,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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/"))))
+ ;; Ange-FTP does not complete "".
+ (unless (tramp--test-ange-ftp-p)
+ (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")))
@@ -4881,49 +4899,52 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
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-compat-file-name-unquote 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-compat-file-name-unquote tmp-name1)))
- tmp-name2)))
- (should (file-directory-p tmp-name2)))))
+ ;; Ange-FTP doesn't care.
+ (unless (tramp--test-ange-ftp-p)
+ (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-compat-file-name-unquote tmp-name1)))
+ tmp-name2)))
+ (should (file-directory-p tmp-name2)))))
+
+ ;; Relative file names shall work, too. Ange-FTP doesn't care.
+ (unless (tramp--test-ange-ftp-p)
+ (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-compat-file-name-unquote tmp-name1)))
+ tmp-name2)))
+ (should (file-directory-p tmp-name2))))))
;; Cleanup.
(ignore-errors (delete-file tmp-name1))
@@ -4936,6 +4957,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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))
+ (ange-ftp-make-backup-files t)
;; These settings are not used by Tramp, so we ignore them.
version-control delete-old-versions
(kept-old-versions (default-toplevel-value 'kept-old-versions))
@@ -4983,58 +5005,61 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
- ;; Map `tramp-backup-directory-alist'.
- (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
- backup-directory-alist)
- (should
- (equal
- (find-backup-file-name tmp-name1)
- (list
- (funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
- (expand-file-name
- (format
- "%s~"
- ;; This is taken from `make-backup-file-name-1'. We
- ;; call `convert-standard-filename', because on MS
- ;; Windows the (local) colons must be replaced by
- ;; exclamation marks.
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string
- "!" "!!" (convert-standard-filename tmp-name1))))
- tmp-name2)))))
- ;; The backup directory is created.
- (should (file-directory-p tmp-name2)))
+ ;; Map `tramp-backup-directory-alist'. Ange-FTP doesn't care.
+ (unless (tramp--test-ange-ftp-p)
+ (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
+ backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted #'tramp-compat-file-name-quote #'identity)
+ (expand-file-name
+ (format
+ "%s~"
+ ;; This is taken from `make-backup-file-name-1'.
+ ;; We call `convert-standard-filename', because on
+ ;; MS Windows the (local) colons must be replaced
+ ;; by exclamation marks.
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string
+ "!" "!!" (convert-standard-filename tmp-name1))))
+ tmp-name2)))))
+ ;; The backup directory is created.
+ (should (file-directory-p tmp-name2))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
;; Map `tramp-backup-directory-alist' with local file name.
- (let ((tramp-backup-directory-alist
- `(("." . ,(file-remote-p tmp-name2 'localname))))
- backup-directory-alist)
- (should
- (equal
- (find-backup-file-name tmp-name1)
- (list
- (funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
- (expand-file-name
- (format
- "%s~"
- ;; This is taken from `make-backup-file-name-1'. We
- ;; call `convert-standard-filename', because on MS
- ;; Windows the (local) colons must be replaced by
- ;; exclamation marks.
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string
- "!" "!!" (convert-standard-filename tmp-name1))))
- tmp-name2)))))
- ;; The backup directory is created.
- (should (file-directory-p tmp-name2)))
+ ;; Ange-FTP doesn't care.
+ (unless (tramp--test-ange-ftp-p)
+ (let ((tramp-backup-directory-alist
+ `(("." . ,(file-remote-p tmp-name2 'localname))))
+ backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted #'tramp-compat-file-name-quote #'identity)
+ (expand-file-name
+ (format
+ "%s~"
+ ;; This is taken from `make-backup-file-name-1'.
+ ;; We call `convert-standard-filename', because on
+ ;; MS Windows the (local) colons must be replaced
+ ;; by exclamation marks.
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string
+ "!" "!!" (convert-standard-filename tmp-name1))))
+ tmp-name2)))))
+ ;; The backup directory is created.
+ (should (file-directory-p tmp-name2))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name2 'recursive))))))
@@ -5043,6 +5068,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(ert-deftest tramp-test39-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
;; Since Emacs 26.1.
(skip-unless
(and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
@@ -5099,6 +5125,12 @@ variables, so we check the Emacs version directly."
This requires restrictions of file name syntax."
(tramp-adb-file-name-p tramp-test-temporary-file-directory))
+(defun tramp--test-ange-ftp-p ()
+ "Check, whether Ange-FTP is used."
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-ftp-file-name-handler))
+
(defun tramp--test-docker-p ()
"Check, whether the docker method is used.
This does not support some special file names."
@@ -5373,7 +5405,8 @@ This requires restrictions of file name syntax."
;; expanded to <TAB>.
(let ((files
(list
- (if (or (tramp--test-gvfs-p)
+ (if (or (tramp--test-ange-ftp-p)
+ (tramp--test-gvfs-p)
(tramp--test-rclone-p)
(tramp--test-sudoedit-p)
(tramp--test-windows-nt-or-smb-p))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 4ab7800: Make ange-ftp fit for tramp-tests,
Michael Albinus <=