aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/tramp-archive.el24
-rw-r--r--lisp/net/tramp-compat.el8
-rw-r--r--lisp/net/tramp.el6
-rw-r--r--test/lisp/autorevert-tests.el20
-rw-r--r--test/lisp/net/tramp-tests.el3
5 files changed, 37 insertions, 24 deletions
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index e6ae73aae61..d7f99667f45 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -475,17 +475,19 @@ name is kept in slot `hop'"
475 475
476(defun tramp-archive-cleanup-hash () 476(defun tramp-archive-cleanup-hash ()
477 "Remove local copies of archives, used by GVFS." 477 "Remove local copies of archives, used by GVFS."
478 (maphash 478 ;; Don't check for a proper method.
479 (lambda (key value) 479 (let ((non-essential t))
480 ;; Unmount local copy. 480 (maphash
481 (ignore-errors 481 (lambda (key value)
482 (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key)) 482 ;; Unmount local copy.
483 (tramp-gvfs-unmount (car value))) 483 (ignore-errors
484 ;; Delete local copy. 484 (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key))
485 (ignore-errors (delete-file (cdr value))) 485 (tramp-gvfs-unmount (car value)))
486 (remhash key tramp-archive-hash)) 486 ;; Delete local copy.
487 tramp-archive-hash) 487 (ignore-errors (delete-file (cdr value)))
488 (clrhash tramp-archive-hash)) 488 (remhash key tramp-archive-hash))
489 tramp-archive-hash)
490 (clrhash tramp-archive-hash)))
489 491
490(add-hook 'tramp-cleanup-all-connections-hook #'tramp-archive-cleanup-hash) 492(add-hook 'tramp-cleanup-all-connections-hook #'tramp-archive-cleanup-hash)
491(add-hook 'kill-emacs-hook #'tramp-archive-cleanup-hash) 493(add-hook 'kill-emacs-hook #'tramp-archive-cleanup-hash)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 21a819f79fd..d4380f8deb3 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -290,6 +290,14 @@ A nil value for either argument stands for the current time."
290 tree)) 290 tree))
291 (nreverse elems))))) 291 (nreverse elems)))))
292 292
293;; `progress-reporter-update' got argument SUFFIX in Emacs 27.1.
294(defalias 'tramp-compat-progress-reporter-update
295 (if (equal (tramp-compat-funcall 'func-arity #'progress-reporter-update)
296 '(1 . 3))
297 #'progress-reporter-update
298 (lambda (reporter &optional value _suffix)
299 (progress-reporter-update reporter value))))
300
293(add-hook 'tramp-unload-hook 301(add-hook 'tramp-unload-hook
294 (lambda () 302 (lambda ()
295 (unload-feature 'tramp-loaddefs 'force) 303 (unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 76eb03b89e0..37b06cbe422 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1928,12 +1928,12 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
1928(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) 1928(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
1929(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) 1929(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
1930 1930
1931(defun tramp-progress-reporter-update (reporter &optional value) 1931(defun tramp-progress-reporter-update (reporter &optional value suffix)
1932 "Report progress of an operation for Tramp." 1932 "Report progress of an operation for Tramp."
1933 (let* ((parameters (cdr reporter)) 1933 (let* ((parameters (cdr reporter))
1934 (message (aref parameters 3))) 1934 (message (aref parameters 3)))
1935 (when (string-match-p message (or (current-message) "")) 1935 (when (string-match-p message (or (current-message) ""))
1936 (progress-reporter-update reporter value)))) 1936 (tramp-compat-progress-reporter-update reporter value suffix))))
1937 1937
1938(defmacro with-tramp-progress-reporter (vec level message &rest body) 1938(defmacro with-tramp-progress-reporter (vec level message &rest body)
1939 "Executes BODY, spinning a progress reporter with MESSAGE. 1939 "Executes BODY, spinning a progress reporter with MESSAGE.
@@ -3865,6 +3865,8 @@ of."
3865 ;; The descriptor must be a process object. 3865 ;; The descriptor must be a process object.
3866 (unless (processp proc) 3866 (unless (processp proc)
3867 (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc)) 3867 (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
3868 ;; There might be pending output.
3869 (while (tramp-accept-process-output proc 0))
3868 (tramp-message proc 6 "Kill %S" proc) 3870 (tramp-message proc 6 "Kill %S" proc)
3869 (delete-process proc)) 3871 (delete-process proc))
3870 3872
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index f21fb864f27..37301ffe430 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -62,7 +62,7 @@
62 tramp-verbose 0 62 tramp-verbose 0
63 tramp-message-show-message nil) 63 tramp-message-show-message nil)
64 64
65(defconst auto-revert--timeout 10 65(defconst auto-revert--timeout (1+ auto-revert-interval)
66 "Time to wait for a message.") 66 "Time to wait for a message.")
67 67
68(defvar auto-revert--messages nil 68(defvar auto-revert--messages nil
@@ -140,7 +140,7 @@ This expects `auto-revert--messages' to be bound by
140 (declare (indent 1)) 140 (declare (indent 1))
141 `(ert-deftest ,(intern (concat (symbol-name test) "-remote")) () 141 `(ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
142 ,docstring 142 ,docstring
143 :tags '(:expensive-test) 143 :tags '(:expensive-test :unstable)
144 (let ((temporary-file-directory 144 (let ((temporary-file-directory
145 auto-revert-test-remote-temporary-file-directory) 145 auto-revert-test-remote-temporary-file-directory)
146 (auto-revert-remote-files t) 146 (auto-revert-remote-files t)
@@ -471,7 +471,7 @@ This expects `auto-revert--messages' to be bound by
471 (file-2 (make-temp-file "global-auto-revert-test-2")) 471 (file-2 (make-temp-file "global-auto-revert-test-2"))
472 (file-3 (make-temp-file "global-auto-revert-test-3")) 472 (file-3 (make-temp-file "global-auto-revert-test-3"))
473 (file-2b (concat file-2 "-b")) 473 (file-2b (concat file-2 "-b"))
474 buf-1 buf-2 buf-3) 474 require-final-newline buf-1 buf-2 buf-3)
475 (unwind-protect 475 (unwind-protect
476 (progn 476 (progn
477 (setq buf-1 (find-file-noselect file-1)) 477 (setq buf-1 (find-file-noselect file-1))
@@ -503,7 +503,7 @@ This expects `auto-revert--messages' to be bound by
503 (auto-revert-test--wait-for 503 (auto-revert-test--wait-for
504 (lambda () (buffer-local-value 504 (lambda () (buffer-local-value
505 'auto-revert-notify-watch-descriptor buf-3)) 505 'auto-revert-notify-watch-descriptor buf-3))
506 (+ auto-revert-interval 1)) 506 auto-revert--timeout)
507 (should (buffer-local-value 507 (should (buffer-local-value
508 'auto-revert-notify-watch-descriptor buf-3)) 508 'auto-revert-notify-watch-descriptor buf-3))
509 (auto-revert-test--write-file "3-a" file-3) 509 (auto-revert-test--write-file "3-a" file-3)
@@ -515,8 +515,8 @@ This expects `auto-revert--messages' to be bound by
515 (sleep-for 0.5) 515 (sleep-for 0.5)
516 (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) 516 (should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
517 (auto-revert-test--write-file "1-b" file-1) 517 (auto-revert-test--write-file "1-b" file-1)
518 (auto-revert-test--wait-for-buffer-text buf-1 "1-b" 518 (auto-revert-test--wait-for-buffer-text
519 (+ auto-revert-interval 1)) 519 buf-1 "1-b" auto-revert--timeout)
520 (should (buffer-local-value 520 (should (buffer-local-value
521 'auto-revert-notify-watch-descriptor buf-1)) 521 'auto-revert-notify-watch-descriptor buf-1))
522 522
@@ -525,8 +525,8 @@ This expects `auto-revert--messages' to be bound by
525 (write-file file-2b)) 525 (write-file file-2b))
526 (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) 526 (should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
527 (auto-revert-test--write-file "2-b" file-2b) 527 (auto-revert-test--write-file "2-b" file-2b)
528 (auto-revert-test--wait-for-buffer-text buf-2 "2-b" 528 (auto-revert-test--wait-for-buffer-text
529 (+ auto-revert-interval 1)) 529 buf-2 "2-b" auto-revert--timeout)
530 (should (buffer-local-value 530 (should (buffer-local-value
531 'auto-revert-notify-watch-descriptor buf-2))) 531 'auto-revert-notify-watch-descriptor buf-2)))
532 532
@@ -550,7 +550,7 @@ This expects `auto-revert--messages' to be bound by
550 (let* ((auto-revert-use-notify t) 550 (let* ((auto-revert-use-notify t)
551 (file-1 (make-temp-file "auto-revert-test")) 551 (file-1 (make-temp-file "auto-revert-test"))
552 (file-2 (concat file-1 "-2")) 552 (file-2 (concat file-1 "-2"))
553 (buf nil)) 553 require-final-newline buf)
554 (unwind-protect 554 (unwind-protect
555 (progn 555 (progn
556 (setq buf (find-file-noselect file-1)) 556 (setq buf (find-file-noselect file-1))
@@ -565,7 +565,7 @@ This expects `auto-revert--messages' to be bound by
565 565
566 (auto-revert-test--write-file "C" file-2) 566 (auto-revert-test--write-file "C" file-2)
567 (auto-revert-test--wait-for-buffer-text 567 (auto-revert-test--wait-for-buffer-text
568 buf "C" (+ auto-revert-interval 1)) 568 buf "C" auto-revert--timeout)
569 (should (equal (buffer-string) "C")))) 569 (should (equal (buffer-string) "C"))))
570 570
571 ;; Clean up. 571 ;; Clean up.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index b9868ff6a87..c9ae4d8b139 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4173,7 +4173,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4173 (should (numberp (process-get proc 'remote-pid))) 4173 (should (numberp (process-get proc 'remote-pid)))
4174 (should (interrupt-process proc)) 4174 (should (interrupt-process proc))
4175 ;; Let the process accept the interrupt. 4175 ;; Let the process accept the interrupt.
4176 (while (accept-process-output proc nil nil 0)) 4176 (with-timeout (10 (tramp--test-timeout-handler))
4177 (while (accept-process-output proc nil nil 0)))
4177 (should-not (process-live-p proc)) 4178 (should-not (process-live-p proc))
4178 ;; An interrupted process cannot be interrupted, again. 4179 ;; An interrupted process cannot be interrupted, again.
4179 (should-error (interrupt-process proc) :type 'error)) 4180 (should-error (interrupt-process proc) :type 'error))