master dd85664: Implement stderr in tramp-adb-handle-make-process

[Michael Albinus]

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

    Implement stderr in tramp-adb-handle-make-process
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
    Implement `stderr'.
    
    * lisp/net/tramp-sh.el (tramp-sh-handle-make-process):
    Flush connection properties in time.
    
    * test/lisp/net/tramp-tests.el (tramp-test30-make-process)
    (tramp-test32-shell-command): Test asynchronous stderr for tramp-adb.
---
 lisp/net/tramp-adb.el        |  42 ++++++++++++++-
 lisp/net/tramp-sh.el         |   9 ++--
 test/lisp/net/tramp-tests.el | 124 ++++++++++++++++++++-----------------------
 3 files changed, 105 insertions(+), 70 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 1be2d16..0e4ac53 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -968,17 +968,27 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
          (signal 'wrong-type-argument (list #'functionp sentinel)))
        (unless (or (null stderr) (bufferp stderr) (stringp stderr))
          (signal 'wrong-type-argument (list #'stringp stderr)))
+       (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+                  (not (tramp-equal-remote default-directory stderr)))
+         (signal 'file-error (list "Wrong stderr" stderr)))
 
        (let* ((buffer
                (if buffer
                    (get-buffer-create buffer)
                  ;; BUFFER can be nil.  We use a temporary buffer.
                  (generate-new-buffer tramp-temp-buffer-name)))
+              ;; STDERR can also be a file name.
+              (tmpstderr
+               (and stderr
+                    (if (and (stringp stderr) (tramp-tramp-file-p stderr))
+                        (tramp-unquote-file-local-name stderr)
+                      (tramp-make-tramp-temp-file v))))
               (program (car command))
               (args (cdr command))
               (command
-               (format "cd %s && exec %s"
+               (format "cd %s && exec %s %s"
                        (tramp-shell-quote-argument localname)
+                       (if tmpstderr (format "2>'%s'" tmpstderr) "")
                        (mapconcat #'tramp-shell-quote-argument
                                   (cons program args) " ")))
               (tramp-process-connection-type
@@ -1028,6 +1038,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                        (ignore-errors
                          (set-process-query-on-exit-flag p (null noquery))
                          (set-marker (process-mark p) (point)))
+                       ;; We must flush them here already; otherwise
+                       ;; `rename-file', `delete-file' or
+                       ;; `insert-file-contents' will fail.
+                       (tramp-flush-connection-property v "process-name")
+                       (tramp-flush-connection-property v "process-buffer")
+                       ;; Copy tmpstderr file.
+                       (when (and (stringp stderr)
+                                  (not (tramp-tramp-file-p stderr)))
+                         (add-function
+                          :after (process-sentinel p)
+                          (lambda (_proc _msg)
+                            (rename-file
+                             (tramp-make-tramp-file-name v tmpstderr)
+                             stderr))))
                        ;; Read initial output.  Remove the first line,
                        ;; which is the command echo.
                        (while
@@ -1036,6 +1060,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                              (not (re-search-forward "[\n]" nil t)))
                          (tramp-accept-process-output p 0))
                        (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.
+                       (when (bufferp stderr)
+                         (with-current-buffer stderr
+                           (insert-file-contents
+                            (tramp-make-tramp-file-name v tmpstderr) 'visit)
+                           (auto-revert-mode))
+                         ;; Delete tmpstderr file.
+                         (add-function
+                          :after (process-sentinel p)
+                          (lambda (_proc _msg)
+                            (delete-file
+                             (tramp-make-tramp-file-name v tmpstderr)))))
                        ;; Return process.
                        p))))
 
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6a83cfe..6cd299a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2971,6 +2971,11 @@ STDERR can also be a file name."
                      (ignore-errors
                        (set-process-query-on-exit-flag p (null noquery))
                        (set-marker (process-mark p) (point)))
+                     ;; We must flush them here already; otherwise
+                     ;; `rename-file', `delete-file' or
+                     ;; `insert-file-contents' will fail.
+                     (tramp-flush-connection-property v "process-name")
+                     (tramp-flush-connection-property v "process-buffer")
                      ;; Copy tmpstderr file.
                      (when (and (stringp stderr)
                                 (not (tramp-tramp-file-p stderr)))
@@ -2985,10 +2990,6 @@ STDERR can also be a file name."
                      ;; The temporary file will exist until the
                      ;; process is deleted.
                      (when (bufferp stderr)
-                       ;; We must flush them here already; otherwise
-                       ;; `insert-file-contents' will fail.
-                       (tramp-flush-connection-property v "process-name")
-                       (tramp-flush-connection-property v "process-buffer")
                        (with-current-buffer stderr
                          (insert-file-contents
                           (tramp-make-tramp-file-name v tmpstderr) 'visit)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2e4188a..e2d7e35 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4352,56 +4352,54 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
 
-      ;; Process with stderr buffer.  tramp-adb.el doesn't support it (yet).
-      (unless (tramp--test-adb-p)
-       (let ((stderr (generate-new-buffer "*stderr*")))
-         (unwind-protect
-             (with-temp-buffer
-               (setq proc
-                     (with-no-warnings
-                       (make-process
-                        :name "test5" :buffer (current-buffer)
-                        :command '("cat" "/")
-                        :stderr stderr
-                        :file-handler t)))
-               (should (processp proc))
-               ;; Read stderr.
-               (with-timeout (10 (tramp--test-timeout-handler))
-                 (while (accept-process-output proc 0 nil t)))
-               (delete-process proc)
-               (with-current-buffer stderr
-                 (should
-                  (string-match "cat:.* Is a directory" (buffer-string)))))
+      ;; Process with stderr buffer.
+      (let ((stderr (generate-new-buffer "*stderr*")))
+       (unwind-protect
+           (with-temp-buffer
+             (setq proc
+                   (with-no-warnings
+                     (make-process
+                      :name "test5" :buffer (current-buffer)
+                      :command '("cat" "/")
+                      :stderr stderr
+                      :file-handler t)))
+             (should (processp proc))
+             ;; Read stderr.
+             (with-timeout (10 (tramp--test-timeout-handler))
+               (while (accept-process-output proc 0 nil t)))
+             (delete-process proc)
+             (with-current-buffer stderr
+               (should
+                (string-match "cat:.* Is a directory" (buffer-string)))))
 
-           ;; Cleanup.
-           (ignore-errors (delete-process proc)))
-           (ignore-errors (kill-buffer stderr))))
+         ;; Cleanup.
+         (ignore-errors (delete-process proc))
+         (ignore-errors (kill-buffer stderr))))
 
-      ;; Process with stderr file.  tramp-adb.el doesn't support it (yet).
-      (unless (tramp--test-adb-p)
-       (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
-         (unwind-protect
+      ;; Process with stderr file.
+      (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
+       (unwind-protect
+           (with-temp-buffer
+             (setq proc
+                   (with-no-warnings
+                     (make-process
+                      :name "test6" :buffer (current-buffer)
+                      :command '("cat" "/")
+                      :stderr tmpfile
+                      :file-handler t)))
+             (should (processp proc))
+             ;; Read stderr.
+             (with-timeout (10 (tramp--test-timeout-handler))
+               (while (accept-process-output proc nil nil t)))
+             (delete-process proc)
              (with-temp-buffer
-               (setq proc
-                     (with-no-warnings
-                       (make-process
-                        :name "test6" :buffer (current-buffer)
-                        :command '("cat" "/")
-                        :stderr tmpfile
-                        :file-handler t)))
-               (should (processp proc))
-               ;; Read stderr.
-               (with-timeout (10 (tramp--test-timeout-handler))
-                 (while (accept-process-output proc nil nil t)))
-               (delete-process proc)
-               (with-temp-buffer
-                 (insert-file-contents tmpfile)
-                 (should
-                  (string-match "cat:.* Is a directory" (buffer-string)))))
+               (insert-file-contents tmpfile)
+               (should
+                (string-match "cat:.* Is a directory" (buffer-string)))))
 
-           ;; Cleanup.
-           (ignore-errors (delete-process proc))
-           (ignore-errors (delete-file tmpfile))))))))
+         ;; Cleanup.
+         (ignore-errors (delete-process proc))
+         (ignore-errors (delete-file tmpfile)))))))
 
 (ert-deftest tramp-test31-interrupt-process ()
   "Check `interrupt-process'."
@@ -4521,25 +4519,23 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name)))
 
-      ;; Test `async-shell-command' with error buffer.  tramp-adb.el
-      ;; doesn't support it (yet).
-      (unless (tramp--test-adb-p)
-       (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*")) 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)))))
 
            ;; Cleanup.
-           (ignore-errors (kill-buffer stderr)))))
+           (ignore-errors (kill-buffer stderr))))
 
       ;; Test sending string to `async-shell-command'.
       (unwind-protect
@@ -6243,8 +6239,6 @@ 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 stderr for `adb' in `tramp-test30-make-process' and
-;;   `tramp-test32-shell-command'.
 ;; * Implement `tramp-test31-interrupt-process' for `adb'.
 ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.  A remote
 ;;   file name operation cannot run in the timer.  Remove `:unstable' tag?