Fix problems in Tramp's async-shell-command

* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
* lisp/net/tramp-cache.el (top):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process):
Use `insert-file-contents-literally'.

* lisp/net/tramp.el (tramp-parse-file):
Use `insert-file-contents-literally'.
(tramp-handle-shell-command): Reorganize error-buffer handling.
(tramp-handle-start-file-process): Use `consp' instead of `listp'.

* test/lisp/net/tramp-tests.el (tramp-test31-interrupt-process):
Bind `delete-exited-processes'.
(tramp--test-async-shell-command): Bind `delete-exited-processes'.
Add additional `accept-process-output'.  Move cleanup of output
buffer ...
(tramp-test32-shell-command): ... here.  Test error buffer also
for `async-shell-command'.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 194dd2d308f298baeb8e6129c4bf29f449e4b74e..aa7fe147c2031fed067077cb68b3b1e3b01b4c16 100644 (file)
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1065,13 +1065,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
                        ;; until the process is deleted.
                        (when (bufferp stderr)
                          (with-current-buffer stderr
-                           (insert-file-contents remote-tmpstderr 'visit))
+                           (insert-file-contents-literally
+                            remote-tmpstderr 'visit))
                          ;; Delete tmpstderr file.
                          (add-function
                           :after (process-sentinel p)
                           (lambda (_proc _msg)
                             (with-current-buffer stderr
-                              (insert-file-contents remote-tmpstderr 'visit))
+                              (insert-file-contents-literally
+                               remote-tmpstderr 'visit nil nil 'replace))
                             (delete-file remote-tmpstderr))))
                        ;; Return process.
                        p))))

diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 6ce86b4b65d9a3d280398e47fe329076056b3843..92c98486f46a0c729155091ad818ffe5367ff5eb 100644 (file)
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -504,7 +504,7 @@ for all methods.  Resulting data are derived from connection history."
           tramp-cache-read-persistent-data)
   (condition-case err
       (with-temp-buffer
-       (insert-file-contents tramp-persistency-file-name)
+       (insert-file-contents-literally tramp-persistency-file-name)
        (let ((list (read (current-buffer)))
              (tramp-verbose 0)
              element key item)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 23ce048720d43569088a12682f20fbb21dfbc0e6..b8f3c0d8c826cb13a110b6971bc4397bfd09bfb9 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3004,13 +3004,15 @@ STDERR can also be a file name."
                      ;; the process is deleted.
                      (when (bufferp stderr)
                        (with-current-buffer stderr
-                         (insert-file-contents remote-tmpstderr 'visit))
+                         (insert-file-contents-literally
+                          remote-tmpstderr 'visit))
                        ;; Delete tmpstderr file.
                        (add-function
                         :after (process-sentinel p)
                         (lambda (_proc _msg)
                           (with-current-buffer stderr
-                            (insert-file-contents remote-tmpstderr 'visit))
+                            (insert-file-contents-literally
+                             remote-tmpstderr 'visit nil nil 'replace))
                           (delete-file remote-tmpstderr))))
                      ;; Return process.
                      p)))

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 61f6f2ed3a7cc11dc8deda06b98b1449f64363d1..e5bb094bbd509e56371bba6453c9ac5fa7efdeab 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2844,7 +2844,7 @@ User is always nil."
   (let ((default-directory (tramp-compat-temporary-file-directory)))
     (when (file-readable-p filename)
       (with-temp-buffer
-       (insert-file-contents filename)
+       (insert-file-contents-literally filename)
        (goto-char (point-min))
         (cl-loop while (not (eobp)) collect (funcall function))))))
 
@@ -3699,32 +3699,37 @@ support symbolic links."
              ;; Run the process.
              (setq p (start-file-process-shell-command
                       (buffer-name output-buffer) buffer command))
-           (if (process-live-p p)
-               ;; Display output.
-               (with-current-buffer output-buffer
-                 (display-buffer output-buffer '(nil (allow-no-window . t)))
-                 (setq mode-line-process '(":%s"))
-                 (shell-mode)
-                 (set-process-filter p #'comint-output-filter)
-                 (set-process-sentinel
-                  p (if (listp buffer)
-                        (lambda (_proc _string)
-                          (with-current-buffer error-buffer
-                            (insert-file-contents (cadr buffer)))
-                          (delete-file (cadr buffer)))
-                      #'shell-command-sentinel)))
-             ;; Show stderr.
+           ;; Insert error messages if they were separated.
+           (when (consp buffer)
              (with-current-buffer error-buffer
-               (insert-file-contents (cadr buffer)))
-             (delete-file (cadr buffer)))))
+               (insert-file-contents-literally (cadr buffer))))
+           (if (process-live-p p)
+             ;; Display output.
+             (with-current-buffer output-buffer
+               (display-buffer output-buffer '(nil (allow-no-window . t)))
+               (setq mode-line-process '(":%s"))
+               (shell-mode)
+               (set-process-filter p #'comint-output-filter)
+               (set-process-sentinel p #'shell-command-sentinel)
+               (when (consp buffer)
+                 (add-function
+                  :after (process-sentinel p)
+                  (lambda (_proc _string)
+                    (with-current-buffer error-buffer
+                      (insert-file-contents-literally
+                       (cadr buffer) nil nil nil 'replace))
+                    (delete-file (cadr buffer))))))
+
+             (when (consp buffer)
+               (delete-file (cadr buffer))))))
 
       (prog1
          ;; Run the process.
          (process-file-shell-command command nil buffer nil)
        ;; Insert error messages if they were separated.
-       (when (listp buffer)
+       (when (consp buffer)
          (with-current-buffer error-buffer
-           (insert-file-contents (cadr buffer)))
+           (insert-file-contents-literally (cadr buffer)))
          (delete-file (cadr buffer)))
        (if current-buffer-p
            ;; This is like exchange-point-and-mark, but doesn't
@@ -3745,10 +3750,10 @@ BUFFER might be a list, in this case STDERR is separated."
   (tramp-file-name-handler
    'make-process
    :name name
-   :buffer (if (listp buffer) (car buffer) buffer)
+   :buffer (if (consp buffer) (car buffer) buffer)
    :command (and program (cons program args))
    ;; `shell-command' adds an errfile to `buffer'.
-   :stderr (when (listp buffer) (cadr buffer))
+   :stderr (when (consp buffer) (cadr buffer))
    :noquery nil
    :file-handler t))
 

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 129652839c4e4541168f9d8a5a781b7e6fce8cbf..7ffd22e77be3fcac4720c35f6452334744d89b85 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4410,6 +4410,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   ;; order to establish the connection prior running an asynchronous
   ;; process.
   (let ((default-directory (file-truename tramp-test-temporary-file-directory))
+       (delete-exited-processes t)
        kill-buffer-query-functions proc)
     (unwind-protect
        (with-temp-buffer
@@ -4436,18 +4437,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
     (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)))
+  (let ((proc (async-shell-command command output-buffer error-buffer))
+       (delete-exited-processes t))
     (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)))))
+      (while (or (accept-process-output proc nil nil t) (process-live-p proc))))
+    (accept-process-output proc nil nil t)))
 
 (defun tramp--test-shell-command-to-string-asynchronously (command)
   "Like `shell-command-to-string', but for asynchronous processes."
@@ -4486,26 +4483,33 @@ INPUT, if non-nil, is a string sent to the process."
               this-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))))
+         (ignore-errors (delete-file tmp-name)))
 
-      ;; Test `shell-command' with error buffer.
-      (let ((stderr (generate-new-buffer "*stderr*")))
-       (unwind-protect
-           (with-temp-buffer
-             (shell-command "echo foo; echo bar >&2" (current-buffer) stderr)
-             (should (string-equal "foo\n" (buffer-string)))
-             ;; Check stderr.
-             (with-current-buffer stderr
-               (should (string-equal "bar\n" (buffer-string)))))
+       ;; Test `{async-}shell-command' with error buffer.
+       (let ((stderr (generate-new-buffer "*stderr*")))
+         (unwind-protect
+             (with-temp-buffer
+               (funcall
+                this-shell-command
+                "echo foo >&2; echo bar" (current-buffer) stderr)
+               (should (string-equal "bar\n" (buffer-string)))
+               ;; Check stderr.
+               (with-current-buffer stderr
+                 (should (string-equal "foo\n" (buffer-string)))))
 
-         ;; Cleanup.
-         (ignore-errors (kill-buffer stderr))))
+           ;; Cleanup.
+           (ignore-errors (kill-buffer stderr)))))
 
       ;; Test sending string to `async-shell-command'.
       (unwind-protect
@@ -4514,6 +4518,7 @@ INPUT, if non-nil, is a string sent to the process."
            (should (file-exists-p tmp-name))
            (tramp--test-async-shell-command
             "read line; ls $line" (current-buffer) nil
+            ;; String to be sent.
             (format "%s\n" (file-name-nondirectory tmp-name)))
            (should
             (string-equal