diff options
| -rw-r--r-- | lisp/net/tramp-archive.el | 24 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 6 | ||||
| -rw-r--r-- | test/lisp/autorevert-tests.el | 20 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 3 |
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)) |