diff options
| -rw-r--r-- | lisp/net/tramp-adb.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 49 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 45 |
5 files changed, 61 insertions, 47 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 194dd2d308f..aa7fe147c20 100644 --- 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 6ce86b4b65d..92c98486f46 100644 --- 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 23ce048720d..b8f3c0d8c82 100644 --- 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 61f6f2ed3a7..e5bb094bbd5 100644 --- 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 129652839c4..7ffd22e77be 100644 --- 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 |