From: Michael Albinus Date: Fri, 13 Nov 2020 15:55:08 +0000 (+0100) Subject: Some minor Tramp fixes, resulting from test campaign X-Git-Tag: emacs-28.0.90~5169 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=297f89f7e4becd64c1732af6db8ba925186d1d45;p=emacs.git Some minor Tramp fixes, resulting from test campaign * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Use `current-time' if needed. * lisp/net/tramp-gvfs.el (tramp-gvfs-gio-mapping): (tramp-gvfs-do-copy-or-rename-file): Remove "gvfs-rename", it is not trustworthy. * test/lisp/net/tramp-tests.el (tramp-test07-file-exists-p): Check also for symlinked files in trash. (tramp-test20-file-modes): Revert last change, it was a thinko. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index be83f670f72..7cdb7ebf536 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -575,8 +575,9 @@ But handle the case, if the \"test\" command is not available." ;; Set file modification time. (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime - (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) + (or (tramp-compat-file-attribute-modification-time + (file-attributes filename)) + (current-time)))) ;; The end. (when (and (null noninteractive) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 86fb45a43b7..098fba56b5b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -689,7 +689,6 @@ It has been changed in GVFS 1.14.") ("gvfs-monitor-file" . "monitor") ("gvfs-mount" . "mount") ("gvfs-move" . "move") - ("gvfs-rename" . "rename") ("gvfs-rm" . "remove") ("gvfs-set-attribute" . "set")) "List of cons cells, mapping \"gvfs-\" to \"gio \".") @@ -985,15 +984,12 @@ file names." (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) - (let* ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (equal-remote (tramp-equal-remote filename newname)) - (gvfs-operation - (cond - ((eq op 'copy) "gvfs-copy") - (equal-remote "gvfs-rename") - (t "gvfs-move"))) - (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) + ;; "gvfs-rename" is not trustworthy. + (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move")) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) @@ -2439,7 +2435,10 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (when tramp-gvfs-enabled ;; Suppress D-Bus error messages and Tramp traces. - (let ((tramp-verbose 0) + (let (;; Sometimes, it fails with "Variable binding depth exceeds + ;; max-specpdl-size". Shall be fixed in Emacs 27. + (max-specpdl-size (* 2 max-specpdl-size)) + (tramp-verbose 0) tramp-gvfs-dbus-event-vector fun) ;; Add completion functions for services announced by DNS-SD. ;; See for valid service types. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 51e15af2ef9..ccf0c0d0e28 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3530,7 +3530,8 @@ implementation will be used." ;; We must pass modtime explicitly, because FILENAME can ;; be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. - (tramp-compat-file-attribute-modification-time file-attr)) + (or (tramp-compat-file-attribute-modification-time file-attr) + (current-time))) (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid) (= (tramp-compat-file-attribute-group-id file-attr) gid)) (setq need-chown nil)))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0dd233aff09..8a48ffc09b8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1630,8 +1630,9 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; Set file modification time. (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime - (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) + (or (tramp-compat-file-attribute-modification-time + (file-attributes filename)) + (current-time)))) ;; The end. (when (and (null noninteractive) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 55f652fa9a6..a98d478bc1a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4181,8 +4181,9 @@ of." ;; Set file modification time. (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime - (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) + (or (tramp-compat-file-attribute-modification-time + (file-attributes filename)) + (current-time)))) ;; Set the ownership. (tramp-set-file-uid-gid filename uid gid)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7b83a8deebd..00d08ea6f67 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2281,9 +2281,13 @@ This checks also `file-name-as-directory', `file-name-directory', (delete-file tmp-name 'trash) (should-not (file-exists-p tmp-name)) (should - (file-exists-p - (expand-file-name - (file-name-nondirectory tmp-name) trash-directory))) + (or (file-exists-p + (expand-file-name + (file-name-nondirectory tmp-name) trash-directory)) + ;; Gdrive. + (file-symlink-p + (expand-file-name + (file-name-nondirectory tmp-name) trash-directory)))) (delete-directory trash-directory 'recursive) (should-not (file-exists-p trash-directory))))))) @@ -3473,7 +3477,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (skip-unless (or (tramp--test-sh-p) (tramp--test-sudoedit-p) ;; Not all tramp-gvfs.el methods support changing the file mode. - (tramp--test-gvfs-p "afp") (tramp--test-gvfs-p "ftp"))) + (and + (tramp--test-gvfs-p) + (string-match-p + "ftp" (file-remote-p tramp-test-temporary-file-directory 'method))))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))