...
 
Commits (2)
  • Michael Albinus's avatar
    ; Tramp cleanup · 492b31d9
    Michael Albinus authored
    * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
    Handle `non-essential'.
    
    * lisp/net/tramp-archive.el: Increase `max-specpdl-size' when
    loading tramp-gvfs.
    
    * lisp/net/tramp-rclone.el (tramp-rclone-mounted-p): Reorder for
    better traces.
    (tramp-rclone-maybe-open-connection): Handle `non-essential'.
    
    * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory)
    (tramp-find-inline-encoding): Simplify check.
    
    * lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory)
    (tramp-smb-handle-insert-directory): Simplify check.
    
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo):
    Simplify check.
    (tramp-sudoedit-maybe-open-connection): Handle `non-essential'.
    
    * lisp/net/tramp.el (tramp-handle-load, tramp-wait-for-regexp):
    Simplify check.
    (tramp-action-login, tramp-action-password, tramp-action-yesno)
    (tramp-action-yn, tramp-action-terminal): Return explicitly t.
    (tramp-process-one-action, tramp-process-actions): Adapt docstring.
    492b31d9
  • Michael Albinus's avatar
    Adapt `accept-process-output' arguments in tramp-tests · b092a9af
    Michael Albinus authored
    * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
    (tramp-test30-make-process, tramp-test31-interrupt-process)
    (tramp-test32-shell-command)
    (tramp--test-shell-command-to-string-asynchronously)
    (tramp-test43-asynchronous-requests):
    Adapt `accept-process-output' arguments.
    b092a9af
...@@ -1300,6 +1300,14 @@ connection if a previous connection has died for some reason." ...@@ -1300,6 +1300,14 @@ connection if a previous connection has died for some reason."
(tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
(unless (process-live-p p) (unless (process-live-p p)
;; During completion, don't reopen a new connection. We check
;; this for the process related to `tramp-buffer-name';
;; otherwise `start-file-process' wouldn't run ever when
;; `non-essential' is non-nil.
(when (and (tramp-completion-mode-p)
(null (get-process (tramp-buffer-name vec))))
(throw 'non-essential 'non-essential))
(save-match-data (save-match-data
(when (and p (processp p)) (delete-process p)) (when (and p (processp p)) (delete-process p))
(if (zerop (length device)) (if (zerop (length device))
......
...@@ -108,7 +108,10 @@ ...@@ -108,7 +108,10 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-lib))
(require 'tramp-gvfs) ;; Sometimes, compilation fails with "Variable binding depth exceeds
;; max-specpdl-size".
(eval-and-compile
(let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
(autoload 'dired-uncache "dired") (autoload 'dired-uncache "dired")
(autoload 'url-tramp-convert-url-to-tramp "url-tramp") (autoload 'url-tramp-convert-url-to-tramp "url-tramp")
......
...@@ -467,14 +467,14 @@ file names." ...@@ -467,14 +467,14 @@ file names."
(when (tramp-get-connection-process vec) (when (tramp-get-connection-process vec)
;; We cannot use `with-connection-property', because we don't want ;; We cannot use `with-connection-property', because we don't want
;; to cache a nil result. ;; to cache a nil result.
(or (tramp-get-connection-property (unless (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil) (tramp-get-connection-process vec) "mounted" nil)
(tramp-set-connection-property
(tramp-get-connection-process vec) "mounted"
(let* ((default-directory temporary-file-directory) (let* ((default-directory temporary-file-directory)
(mount (shell-command-to-string "mount -t fuse.rclone"))) (mount (shell-command-to-string "mount -t fuse.rclone")))
(tramp-message vec 6 "%s" "mount -t fuse.rclone") (tramp-message vec 6 "%s" "mount -t fuse.rclone")
(tramp-message vec 6 "\n%s" mount) (tramp-message vec 6 "\n%s" mount)
(tramp-set-connection-property
(tramp-get-connection-process vec) "mounted"
(when (string-match (when (string-match
(format (format
"^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec))) "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
...@@ -544,6 +544,14 @@ connection if a previous connection has died for some reason." ...@@ -544,6 +544,14 @@ connection if a previous connection has died for some reason."
(if (zerop (length host)) (if (zerop (length host))
(tramp-error vec 'file-error "Storage %s not connected" host)) (tramp-error vec 'file-error "Storage %s not connected" host))
;; During completion, don't reopen a new connection. We check
;; this for the process related to `tramp-buffer-name';
;; otherwise `start-file-process' wouldn't run ever when
;; `non-essential' is non-nil.
(when (and (tramp-completion-mode-p)
(null (get-process (tramp-buffer-name vec))))
(throw 'non-essential 'non-essential))
;; We need a process bound to the connection buffer. Therefore, ;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution? ;; we create a dummy process. Maybe there is a better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec)) (unless (get-buffer-process (tramp-get-connection-buffer vec))
......
...@@ -1931,7 +1931,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" ...@@ -1931,7 +1931,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(setq newname (setq newname
(expand-file-name (expand-file-name
(file-name-nondirectory dirname) newname))) (file-name-nondirectory dirname) newname)))
(when (not (file-directory-p (file-name-directory newname))) (unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents)) (make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band (tramp-do-copy-or-rename-file-out-of-band
'copy dirname newname keep-date)) 'copy dirname newname keep-date))
...@@ -4458,7 +4458,7 @@ Goes through the list `tramp-local-coding-commands' and ...@@ -4458,7 +4458,7 @@ Goes through the list `tramp-local-coding-commands' and
;; actually check the output it gives. And also, when ;; actually check the output it gives. And also, when
;; redirecting "mimencode" output to /dev/null, then as root ;; redirecting "mimencode" output to /dev/null, then as root
;; it might change the permissions of /dev/null! ;; it might change the permissions of /dev/null!
(when (not (stringp rem-enc)) (unless (stringp rem-enc)
(let ((name (symbol-name rem-enc))) (let ((name (symbol-name rem-enc)))
(while (string-match "-" name) (while (string-match "-" name)
(setq name (replace-match "_" nil t name))) (setq name (replace-match "_" nil t name)))
...@@ -4471,7 +4471,7 @@ Goes through the list `tramp-local-coding-commands' and ...@@ -4471,7 +4471,7 @@ Goes through the list `tramp-local-coding-commands' and
vec (format "%s </dev/null" rem-enc) t) vec (format "%s </dev/null" rem-enc) t)
(throw 'wont-work-remote nil)) (throw 'wont-work-remote nil))
(when (not (stringp rem-dec)) (unless (stringp rem-dec)
(let ((name (symbol-name rem-dec)) (let ((name (symbol-name rem-dec))
(value (symbol-value rem-dec)) (value (symbol-value rem-dec))
tmpfile) tmpfile)
......
...@@ -1048,7 +1048,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ...@@ -1048,7 +1048,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (string-match-p "F" switches) (when (string-match-p "F" switches)
(mapc (mapc
(lambda (x) (lambda (x)
(when (not (zerop (length (car x)))) (unless (zerop (length (car x)))
(cond (cond
((char-equal ?d (string-to-char (nth 1 x))) ((char-equal ?d (string-to-char (nth 1 x)))
(setcar x (concat (car x) "/"))) (setcar x (concat (car x) "/")))
...@@ -1066,7 +1066,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ...@@ -1066,7 +1066,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Print entries. ;; Print entries.
(mapc (mapc
(lambda (x) (lambda (x)
(when (not (zerop (length (nth 0 x)))) (unless (zerop (length (nth 0 x)))
(let ((attr (let ((attr
(when (tramp-smb-get-stat-capability v) (when (tramp-smb-get-stat-capability v)
(ignore-errors (ignore-errors
......
...@@ -747,7 +747,7 @@ ID-FORMAT valid values are `string' and `integer'." ...@@ -747,7 +747,7 @@ ID-FORMAT valid values are `string' and `integer'."
"Check, whether a sudo process has finished. "Check, whether a sudo process has finished.
Remove unneeded output." Remove unneeded output."
;; There might be pending output for the exit status. ;; There might be pending output for the exit status.
(when (not (process-live-p proc)) (unless (process-live-p proc)
(while (tramp-accept-process-output proc 0)) (while (tramp-accept-process-output proc 0))
;; Delete narrowed region, it would be in the way reading a Lisp form. ;; Delete narrowed region, it would be in the way reading a Lisp form.
(goto-char (point-min)) (goto-char (point-min))
...@@ -768,6 +768,15 @@ connection if a previous connection has died for some reason." ...@@ -768,6 +768,15 @@ connection if a previous connection has died for some reason."
;; We need a process bound to the connection buffer. Therefore, we ;; We need a process bound to the connection buffer. Therefore, we
;; create a dummy process. Maybe there is a better solution? ;; create a dummy process. Maybe there is a better solution?
(unless (tramp-get-connection-process vec) (unless (tramp-get-connection-process vec)
;; During completion, don't reopen a new connection. We check
;; this for the process related to `tramp-buffer-name'; otherwise
;; `start-file-process' wouldn't run ever when `non-essential' is
;; non-nil.
(when (and (tramp-completion-mode-p)
(null (get-process (tramp-buffer-name vec))))
(throw 'non-essential 'non-essential))
(let ((p (make-network-process (let ((p (make-network-process
:name (tramp-buffer-name vec) :name (tramp-buffer-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
......
...@@ -3595,10 +3595,9 @@ User is always nil." ...@@ -3595,10 +3595,9 @@ User is always nil."
(tramp-error (tramp-error
v 'file-error v 'file-error
"File `%s' does not include a `.el' or `.elc' suffix" file))) "File `%s' does not include a `.el' or `.elc' suffix" file)))
(unless noerror (unless (or noerror (file-exists-p file))
(when (not (file-exists-p file))
(tramp-error (tramp-error
v tramp-file-missing "Cannot load nonexistent file `%s'" file))) v tramp-file-missing "Cannot load nonexistent file `%s'" file))
(if (not (file-exists-p file)) (if (not (file-exists-p file))
nil nil
(let ((tramp-message-show-message (not nomessage))) (let ((tramp-message-show-message (not nomessage)))
...@@ -3902,7 +3901,8 @@ of." ...@@ -3902,7 +3901,8 @@ of."
(with-current-buffer (tramp-get-connection-buffer vec) (with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string))) (tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-message vec 3 "Sending login name `%s'" user) (tramp-message vec 3 "Sending login name `%s'" user)
(tramp-send-string vec (concat user tramp-local-end-of-line)))) (tramp-send-string vec (concat user tramp-local-end-of-line)))
t)
(defun tramp-action-password (proc vec) (defun tramp-action-password (proc vec)
"Query the user for a password." "Query the user for a password."
...@@ -3922,7 +3922,8 @@ of." ...@@ -3922,7 +3922,8 @@ of."
(process-send-string (process-send-string
proc (concat (tramp-read-passwd proc) tramp-local-end-of-line)) proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
;; Hide password prompt. ;; Hide password prompt.
(narrow-to-region (point-max) (point-max))))) (narrow-to-region (point-max) (point-max))))
t)
(defun tramp-action-succeed (_proc _vec) (defun tramp-action-succeed (_proc _vec)
"Signal success in finding shell prompt." "Signal success in finding shell prompt."
...@@ -3945,7 +3946,8 @@ See also `tramp-action-yn'." ...@@ -3945,7 +3946,8 @@ See also `tramp-action-yn'."
(throw 'tramp-action 'permission-denied)) (throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec) (with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string))) (tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "yes" tramp-local-end-of-line))))) (tramp-send-string vec (concat "yes" tramp-local-end-of-line))))
t)
(defun tramp-action-yn (proc vec) (defun tramp-action-yn (proc vec)
"Ask the user for confirmation using `y-or-n-p'. "Ask the user for confirmation using `y-or-n-p'.
...@@ -3959,7 +3961,8 @@ See also `tramp-action-yesno'." ...@@ -3959,7 +3961,8 @@ See also `tramp-action-yesno'."
(throw 'tramp-action 'permission-denied)) (throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec) (with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string))) (tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "y" tramp-local-end-of-line))))) (tramp-send-string vec (concat "y" tramp-local-end-of-line))))
t)
(defun tramp-action-terminal (_proc vec) (defun tramp-action-terminal (_proc vec)
"Tell the remote host which terminal type to use. "Tell the remote host which terminal type to use.
...@@ -3967,7 +3970,8 @@ The terminal type can be configured with `tramp-terminal-type'." ...@@ -3967,7 +3970,8 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type) (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
(with-current-buffer (tramp-get-connection-buffer vec) (with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string))) (tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))) (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
t)
(defun tramp-action-process-alive (proc _vec) (defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished." "Check, whether a process has finished."
...@@ -4001,7 +4005,8 @@ The terminal type can be configured with `tramp-terminal-type'." ...@@ -4001,7 +4005,8 @@ The terminal type can be configured with `tramp-terminal-type'."
;;; Functions for processing the actions: ;;; Functions for processing the actions:
(defun tramp-process-one-action (proc vec actions) (defun tramp-process-one-action (proc vec actions)
"Wait for output from the shell and perform one action." "Wait for output from the shell and perform one action.
See `tramp-process-actions' for the format of ACTIONS."
(let ((case-fold-search t) (let ((case-fold-search t)
found todo item pattern action) found todo item pattern action)
(while (not found) (while (not found)
...@@ -4024,7 +4029,27 @@ The terminal type can be configured with `tramp-terminal-type'." ...@@ -4024,7 +4029,27 @@ The terminal type can be configured with `tramp-terminal-type'."
"Perform ACTIONS until success or TIMEOUT. "Perform ACTIONS until success or TIMEOUT.
PROC and VEC indicate the remote connection to be used. POS, if PROC and VEC indicate the remote connection to be used. POS, if
set, is the starting point of the region to be deleted in the set, is the starting point of the region to be deleted in the
connection buffer." connection buffer.
ACTIONS is a list of (PATTERN ACTION). The PATTERN should be a
symbol, a variable. The value of this variable gives the regular
expression to search for. Note that the regexp must match at the
end of the buffer, \"\\'\" is implicitly appended to it.
The ACTION should also be a symbol, but a function. When the
corresponding PATTERN matches, the ACTION function is called.
An ACTION function has two arguments (PROC VEC). If it returns
nil, nothing has been done, and the next action shall be called.
A non-nil return value indicates that the process output has been
consumed, and new output shall be retrieved, before starting to
process all ACTIONs, again. The same happens after calling the
last ACTION.
If an action determines, that all processing has been done (e.g.,
because the shell prompt has been detected), it shall throw a
result. The symbol `ok' means that all ACTIONs have been
performed successfully. Any other value means an error."
;; Enable `auth-source', unless "emacs -Q" has been called. We must ;; Enable `auth-source', unless "emacs -Q" has been called. We must
;; use the "password-vector" property in case we have several hops. ;; use the "password-vector" property in case we have several hops.
(tramp-set-connection-property (tramp-set-connection-property
...@@ -4156,7 +4181,7 @@ nil." ...@@ -4156,7 +4181,7 @@ nil."
nil proc 'file-error "Process has died")) nil proc 'file-error "Process has died"))
(setq found (tramp-check-for-regexp proc regexp))))) (setq found (tramp-check-for-regexp proc regexp)))))
(tramp-message proc 6 "\n%s" (buffer-string)) (tramp-message proc 6 "\n%s" (buffer-string))
(when (not found) (unless found
(if timeout (if timeout
(tramp-error (tramp-error
proc 'file-error "[[Regexp `%s' not found in %d secs]]" proc 'file-error "[[Regexp `%s' not found in %d secs]]"
......
...@@ -3818,7 +3818,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3818,7 +3818,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out")) (with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3836,7 +3836,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3836,7 +3836,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out")) (with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3857,7 +3857,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3857,7 +3857,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out")) (with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3890,7 +3890,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3890,7 +3890,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`make-process' timed out")) (with-timeout (10 (ert-fail "`make-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3910,7 +3910,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3910,7 +3910,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`make-process' timed out")) (with-timeout (10 (ert-fail "`make-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3935,7 +3935,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3935,7 +3935,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`make-process' timed out")) (with-timeout (10 (ert-fail "`make-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo")) (while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (string-equal (buffer-string) "foo"))) (should (string-equal (buffer-string) "foo")))
;; Cleanup. ;; Cleanup.
...@@ -3958,8 +3958,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3958,8 +3958,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(delete-process proc) (delete-process proc)
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`make-process' timed out")) (with-timeout (10 (ert-fail "`make-process' timed out"))
(while (process-live-p proc) (while (accept-process-output proc 0 nil t)))
(accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "killed\n"))) (should (string-equal (buffer-string) "killed\n")))
;; Cleanup. ;; Cleanup.
...@@ -3980,7 +3979,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -3980,7 +3979,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-current-buffer stderr (with-current-buffer stderr
(with-timeout (10 (ert-fail "`make-process' timed out")) (with-timeout (10 (ert-fail "`make-process' timed out"))
(while (= (point-min) (point-max)) (while (= (point-min) (point-max))
(accept-process-output proc 0.1))) (while (accept-process-output proc 0 nil t))))
(should (should
(string-equal (buffer-string) "cat: /: Is a directory\n")))) (string-equal (buffer-string) "cat: /: Is a directory\n"))))
...@@ -4007,7 +4006,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4007,7 +4006,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (numberp (process-get proc 'remote-pid))) (should (numberp (process-get proc 'remote-pid)))
(should (interrupt-process proc)) (should (interrupt-process proc))
;; Let the process accept the interrupt. ;; Let the process accept the interrupt.
(accept-process-output proc 1 nil 0) (while (accept-process-output proc nil nil 0))
(should-not (process-live-p proc)) (should-not (process-live-p proc))
;; An interrupted process cannot be interrupted, again. ;; An interrupted process cannot be interrupted, again.
(should-error (interrupt-process proc) :type 'error)) (should-error (interrupt-process proc) :type 'error))
...@@ -4056,10 +4055,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4056,10 +4055,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(current-buffer)) (current-buffer))
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`async-shell-command' timed out")) (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min)) (while (accept-process-output
(1+ (length (file-name-nondirectory tmp-name)))) (get-buffer-process (current-buffer)) nil nil t)))
(accept-process-output
(get-buffer-process (current-buffer)) 0.1)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (while
...@@ -4087,10 +4084,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4087,10 +4084,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(format "%s\n" (file-name-nondirectory tmp-name))) (format "%s\n" (file-name-nondirectory tmp-name)))
;; Read output. ;; Read output.
(with-timeout (10 (ert-fail "`async-shell-command' timed out")) (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min)) (while (accept-process-output
(1+ (length (file-name-nondirectory tmp-name)))) (get-buffer-process (current-buffer)) nil nil t)))
(accept-process-output
(get-buffer-process (current-buffer)) 0.1)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (while
...@@ -4112,10 +4107,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ...@@ -4112,10 +4107,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Like `shell-command-to-string', but for asynchronous processes." "Like `shell-command-to-string', but for asynchronous processes."
(with-temp-buffer (with-temp-buffer
(async-shell-command command (current-buffer)) (async-shell-command command (current-buffer))
(with-timeout (10) (with-timeout (10 (ert-fail "`async-shell-command-to-string' timed out"))
(while (get-buffer-process (current-buffer)) (while (accept-process-output
(accept-process-output (get-buffer-process (current-buffer)) 0.1))) (get-buffer-process (current-buffer)) nil nil t)))
(accept-process-output nil 0.1)
(buffer-substring-no-properties (point-min) (point-max)))) (buffer-substring-no-properties (point-min) (point-max))))
;; This test is inspired by Bug#23952. ;; This test is inspired by Bug#23952.
...@@ -5359,7 +5353,7 @@ process sentinels. They shall not disturb each other." ...@@ -5359,7 +5353,7 @@ process sentinels. They shall not disturb each other."
(should (file-attributes file))) (should (file-attributes file)))
;; Send string to process. ;; Send string to process.
(process-send-string proc (format "%s\n" (buffer-name buf))) (process-send-string proc (format "%s\n" (buffer-name buf)))
(accept-process-output proc 0.1 nil 0) (while (accept-process-output proc 0 nil 0))
;; Give the watchdog a chance. ;; Give the watchdog a chance.
(read-event nil nil 0.01) (read-event nil nil 0.01)
(tramp--test-message (tramp--test-message
......