From 1ba6f2c7bbacfda2bb014d30cfb3999146943de8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 5 Jul 2016 21:16:25 +0200 Subject: [PATCH] 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 0e9fcb501a..c84fb5ac42 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 8e7ef0f407..a22bd89fe9 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 a526fd93ab..1c43ce2f09 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 fe927bb25f..f1f722b272 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)))) -- 2.39.2