From 06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 14 Jan 2020 11:46:42 +0100 Subject: [PATCH] Refactor Tramp async process code * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Update stderr buffer when process has finished. Do not call `auto-revert'. * test/lisp/net/tramp-tests.el (tramp-test31-interrupt-process): Tag it :unstable. Change `accept-process-output' arguments. (tramp--test-async-shell-command): New defun. (tramp--test-shell-command-to-string-asynchronously): Use it. (tramp-test32-shell-command): Refactor code. --- lisp/net/tramp-adb.el | 23 +++--- lisp/net/tramp-sh.el | 22 +++--- test/lisp/net/tramp-tests.el | 146 ++++++++++++++--------------------- 3 files changed, 82 insertions(+), 109 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 0e4ac536d3a..efe89344216 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -935,6 +935,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. +;; The complete STDERR buffer is available only when the process has +;; terminated. (defun tramp-adb-handle-make-process (&rest args) "Like `make-process' for Tramp files." (when args @@ -983,6 +985,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and (stringp stderr) (tramp-tramp-file-p stderr)) (tramp-unquote-file-local-name stderr) (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) (args (cdr command)) (command @@ -1049,9 +1053,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (add-function :after (process-sentinel p) (lambda (_proc _msg) - (rename-file - (tramp-make-tramp-file-name v tmpstderr) - stderr)))) + (rename-file remote-tmpstderr stderr)))) ;; Read initial output. Remove the first line, ;; which is the command echo. (while @@ -1062,20 +1064,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (delete-region (point-min) (point)) ;; Provide error buffer. This shows only ;; initial error messages; messages arriving - ;; later on shall be inserted by - ;; `auto-revert'. The temporary file will - ;; exist until the process is deleted. + ;; later on will be inserted when the process + ;; is deleted. The temporary file will exist + ;; until the process is deleted. (when (bufferp stderr) (with-current-buffer stderr - (insert-file-contents - (tramp-make-tramp-file-name v tmpstderr) 'visit) - (auto-revert-mode)) + (insert-file-contents remote-tmpstderr 'visit)) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (delete-file - (tramp-make-tramp-file-name v tmpstderr))))) + (with-current-buffer stderr + (insert-file-contents remote-tmpstderr 'visit)) + (delete-file remote-tmpstderr)))) ;; Return process. p)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6e5b9d243fb..4ca1f651734 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2806,6 +2806,8 @@ the result will be a local, non-Tramp, file name." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. +;; The complete STDERR buffer is available only when the process has +;; terminated. (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. STDERR can also be a file name." @@ -2855,6 +2857,8 @@ STDERR can also be a file name." (if (and (stringp stderr) (tramp-tramp-file-p stderr)) (tramp-unquote-file-local-name stderr) (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) (args (cdr command)) ;; When PROGRAM matches "*sh", and the first arg is @@ -2994,24 +2998,22 @@ STDERR can also be a file name." (add-function :after (process-sentinel p) (lambda (_proc _msg) - (rename-file - (tramp-make-tramp-file-name v tmpstderr) stderr)))) + (rename-file remote-tmpstderr stderr)))) ;; Provide error buffer. This shows only ;; initial error messages; messages arriving - ;; later on shall be inserted by `auto-revert'. - ;; The temporary file will exist until the - ;; process is deleted. + ;; later on will be inserted when the process is + ;; deleted. The temporary file will exist until + ;; the process is deleted. (when (bufferp stderr) (with-current-buffer stderr - (insert-file-contents - (tramp-make-tramp-file-name v tmpstderr) 'visit) - (auto-revert-mode)) + (insert-file-contents remote-tmpstderr 'visit)) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (delete-file - (tramp-make-tramp-file-name v tmpstderr))))) + (with-current-buffer stderr + (insert-file-contents remote-tmpstderr 'visit)) + (delete-file remote-tmpstderr)))) ;; Return process. p))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e2d7e35b52f..549fb70aa92 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4403,7 +4403,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." - :tags '(:expensive-test) + ;; The test fails from time to time, w/o a reproducible pattern. So + ;; we mark it as unstable. + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) ;; Since Emacs 26.1. @@ -4424,7 +4426,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (interrupt-process proc)) ;; Let the process accept the interrupt. (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil 0))) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) (should-not (process-live-p proc)) ;; An interrupted process cannot be interrupted, again. (should-error @@ -4434,14 +4437,27 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))))) +(defun tramp--test-async-shell-command + (command output-buffer &optional error-buffer input) + "Like `async-shell-command', reading the output. +INPUT, if non-nil, is a string sent to the process." + (let ((proc (async-shell-command command output-buffer error-buffer))) + (when (stringp input) + (process-send-string proc input)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while (accept-process-output proc nil nil t)) + (should-not (process-live-p proc))) + ;; `ls' could produce colorized output. + (with-current-buffer output-buffer + (goto-char (point-min)) + (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil))))) + (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer - (async-shell-command command (current-buffer)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) + (tramp--test-async-shell-command command (current-buffer)) (buffer-substring-no-properties (point-min) (point-max)))) (ert-deftest tramp-test32-shell-command () @@ -4460,101 +4476,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (inhibit-message t) kill-buffer-query-functions) - ;; Test ordinary `shell-command'. - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) - (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (dolist (this-shell-command + '(;; Synchronously. + shell-command + ;; Asynchronously. + tramp--test-async-shell-command)) - ;; Test `shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) + ;; Test ordinary `{async-}shell-command'. (unwind-protect (with-temp-buffer - (shell-command "cat /" (current-buffer) stderr) - (should (= (point-min) (point-max))) - (with-current-buffer stderr - (should - (string-match "cat:.* Is a directory" (buffer-string))))) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (funcall + this-shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) ;; Cleanup. - (ignore-errors (kill-buffer stderr)))) - - ;; Test ordinary `async-shell-command'. - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) - (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (ignore-errors (delete-file tmp-name))) - ;; Test `async-shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*")) proc) - (unwind-protect - (with-temp-buffer - (async-shell-command "cat /; sleep 1" (current-buffer) stderr) - (setq proc (get-buffer-process (current-buffer))) - ;; Read stderr. - (when (processp proc) - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil t))) - (delete-process proc)) - (with-current-buffer stderr - (should - (string-match "cat:.* Is a directory" (buffer-string))))) + ;; Test `{async-}shell-command' with error buffer. + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (funcall + this-shell-command "cat /; sleep 1" (current-buffer) stderr) + ;; Check stderr. + (when (eq this-shell-command #'tramp--test-async-shell-command) + (ignore-errors + (delete-process (get-buffer-process (current-buffer))))) + (should (zerop (buffer-size))) + (with-current-buffer stderr + (should + (string-match "cat:.* Is a directory" (buffer-string))))) ;; Cleanup. - (ignore-errors (kill-buffer stderr)))) + (ignore-errors (kill-buffer stderr))))) ;; Test sending string to `async-shell-command'. (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (process-send-string - (get-buffer-process (current-buffer)) + (tramp--test-async-shell-command + "read line; ls $line" (current-buffer) nil (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) (should (string-equal ;; tramp-adb.el echoes, so we must add the string. @@ -6239,7 +6209,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; do not work properly for `nextcloud'. ;; * Fix `tramp-test29-start-file-process' and ;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). -;; * Implement `tramp-test31-interrupt-process' for `adb'. +;; * Implement `tramp-test31-interrupt-process' for `adb'. Fix `:unstable'. ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote ;; file name operation cannot run in the timer. Remove `:unstable' tag? -- 2.39.5