master 06caa3b: Refactor Tramp async process code

[Michael Albinus]

branch: master
commit 06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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 0e4ac53..efe8934 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 6e5b9d2..4ca1f65 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 e2d7e35..549fb70 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?