]> code.delx.au - gnu-emacs/commitdiff
Make all Tramp tests pass for "gdrive" method
authorMichael Albinus <michael.albinus@gmx.de>
Tue, 5 Jul 2016 19:16:25 +0000 (21:16 +0200)
committerMichael Albinus <michael.albinus@gmx.de>
Tue, 5 Jul 2016 19:16:25 +0000 (21:16 +0200)
* 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
lisp/net/tramp-gvfs.el
lisp/net/tramp-smb.el
test/lisp/net/tramp-tests.el

index 0e9fcb501a79e2cb0481d140f3f0cb8268e398a8..c84fb5ac42823675d6ef3344f08e21869b935863 100644 (file)
@@ -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 "..".
                (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))
 
         ;; 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)))
     ;; 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)
      (delete-directory directory))))
 
 (defun tramp-compat-process-running-p (process-name)
index 8e7ef0f4079aef557af60ff338de9687245ad2c9..a22bd89fe90246418dd4a71dcb4185951bf7a80e 100644 (file)
@@ -746,14 +746,18 @@ file names."
 
 (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
   "Like `delete-directory' for Tramp files."
 
 (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
   (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
     (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")
           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))
            ;; 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)
     (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)))))
 
 \f
 ;; D-Bus BLUEZ functions.
 
 \f
 ;; D-Bus BLUEZ functions.
index a526fd93ab42a652274229b33b2749cc36b401e1..1c43ce2f09708da52724ff033c95da7705e7281b 100644 (file)
@@ -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)
   "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
 
     (with-parsed-tramp-file-name directory nil
       ;; We must also flush the cache of the directory, because
index fe927bb25fd188ccdf43511997bba08b70129db0..f1f722b272bc1922fbc5c3f5396f1bc393521e70 100644 (file)
@@ -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
 (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)
   (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-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))
     (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))))
     (should-error (delete-directory tmp-name))
     (delete-directory tmp-name 'recursive)
     (should-not (file-directory-p tmp-name))))