[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 1ba6f2c: Make all Tramp tests pass for "gdrive" met
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master 1ba6f2c: Make all Tramp tests pass for "gdrive" method |
Date: |
Tue, 5 Jul 2016 19:16:37 +0000 (UTC) |
branch: master
commit 1ba6f2c7bbacfda2bb014d30cfb3999146943de8
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Make all Tramp tests pass for "gdrive" method
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory)
* lisp/net/tramp-compat.el (tramp-compat-copy-directory)
(tramp-compat-delete-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory):
Use `directory-files-no-dot-files-regexp'.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handler-mounted-unmounted)
(tramp-gvfs-send-command): Call `tramp-flush-file-property' in
case of problems.
* test/lisp/net/tramp-tests.el (tramp--instrument-test-case):
Adapt docstring.
(tramp-test14-delete-directory): Make further tests.
---
lisp/net/tramp-compat.el | 17 ++++++++---------
lisp/net/tramp-gvfs.el | 24 +++++++++++++++---------
lisp/net/tramp-smb.el | 17 ++++++++---------
test/lisp/net/tramp-tests.el | 6 ++++--
4 files changed, 35 insertions(+), 29 deletions(-)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 0e9fcb5..c84fb5a 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -174,8 +174,7 @@ Add the extension of F, if existing."
(tramp-compat-copy-directory file newname keep-time parents)
(copy-file file newname t keep-time)))
;; We do not want to delete "." and "..".
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+ (directory-files directory 'full directory-files-no-dot-files-regexp))
;; Set directory attributes.
(set-file-modes newname (file-modes directory))
@@ -209,13 +208,13 @@ Add the extension of F, if existing."
;; implementation from Emacs 23.2.
(wrong-number-of-arguments
(setq directory (directory-file-name (expand-file-name directory)))
- (if (not (file-symlink-p directory))
- (mapc (lambda (file)
- (if (eq t (car (file-attributes file)))
- (tramp-compat-delete-directory file recursive trash)
- (tramp-compat-delete-file file trash)))
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+ (when (not (file-symlink-p directory))
+ (mapc (lambda (file)
+ (if (eq t (car (file-attributes file)))
+ (tramp-compat-delete-directory file recursive trash)
+ (tramp-compat-delete-file file trash)))
+ (directory-files
+ directory 'full directory-files-no-dot-files-regexp)))
(delete-directory directory))))
(defun tramp-compat-process-running-p (process-name)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 8e7ef0f..a22bd89 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -746,14 +746,18 @@ file names."
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (when (and recursive (not (file-symlink-p directory)))
- (mapc (lambda (file)
- (if (eq t (car (file-attributes file)))
- (tramp-compat-delete-directory file recursive trash)
- (tramp-compat-delete-file file trash)))
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(with-parsed-tramp-file-name directory nil
+ (if (and recursive (not (file-symlink-p directory)))
+ (mapc (lambda (file)
+ (if (eq t (car (file-attributes file)))
+ (tramp-compat-delete-directory file recursive trash)
+ (tramp-compat-delete-file file trash)))
+ (directory-files
+ directory 'full directory-files-no-dot-files-regexp))
+ (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (tramp-error
+ v 'file-error "Couldn't delete non-empty %s" directory)))
+
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(unless
@@ -1409,7 +1413,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or
\"[xx:xx:xx:xx:xx:xx]\"."
signal-name (tramp-gvfs-stringify-dbus-message mount-info))
(tramp-set-file-property v "/" "list-mounts" 'undef)
(if (string-equal (downcase signal-name) "unmounted")
- (tramp-set-file-property v "/" "fuse-mountpoint" nil)
+ (tramp-flush-file-property v "/")
;; Set prefix, mountpoint and location.
(unless (string-equal prefix "/")
(tramp-set-file-property v "/" "prefix" prefix))
@@ -1701,7 +1705,9 @@ COMMAND is usually a command from the gvfs-* utilities.
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
- (zerop (apply 'tramp-call-process vec command nil t nil args)))))
+ (or (zerop (apply 'tramp-call-process vec command nil t nil args))
+ ;; Remove information about mounted connection.
+ (and (tramp-flush-file-property vec "/") nil)))))
;; D-Bus BLUEZ functions.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index a526fd9..1c43ce2 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -597,15 +597,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Like `delete-directory' for Tramp files."
(setq directory (directory-file-name (expand-file-name directory)))
(when (file-exists-p directory)
- (if recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (delete-directory file recursive)
- (delete-file file)))
- ;; We do not want to delete "." and "..".
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+ (when recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (delete-directory file recursive)
+ (delete-file file)))
+ ;; We do not want to delete "." and "..".
+ (directory-files directory 'full directory-files-no-dot-files-regexp)))
(with-parsed-tramp-file-name directory nil
;; We must also flush the cache of the directory, because
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index fe927bb..f1f722b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -115,8 +115,8 @@ being the result.")
(defmacro tramp--instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
Print the the content of the Tramp debug buffer, if BODY does not
-eval properly in `should', `should-not' or `should-error'. BODY
-shall not contain a timeout."
+eval properly in `should' or `should-not'. `should-error' is not
+handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
`(let ((tramp-verbose ,verbose)
(tramp-debug-on-error t)
@@ -951,7 +951,9 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(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))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 1ba6f2c: Make all Tramp tests pass for "gdrive" method,
Michael Albinus <=