From 088f0ae0836c5352be3587dce189391c5e56aab7 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 28 Aug 2022 11:19:30 -0700 Subject: [PATCH 4/5] Put Eshell's bookkeeping data for external processes on the process object This allows tracking this information for process objects not recorded in 'eshell-process-list', which will be useful for pipe processes for stderr output. * lisp/eshell/esh-proc.el (eshell-process-list): Add docstring. (eshell-record-process-object): Only record the process object and whether it's a subjob. (eshell-remove-process-entry): Adapt to changes in 'eshell-record-process-object'. (eshell-record-process-properties): New function... (eshell-gather-process-output): ... call it. (eshell-insertion-filter, eshell-sentinel): Use new process properties, don't require process to be in 'eshell-process-list'. * test/lisp/eshell/esh-proc-tests.el (esh-proc-test--output-cmd): New variable. (esh-proc-test--detect-pty-cmd): Add docstring. (esh-proc-test/output/to-screen) (esh-proc-test/output/stdout-and-stderr-to-buffer) (esh-proc-test/exit-status/success, esh-proc-test/exit-status/failure) (esh-proc-test/kill-process/foreground-only): New tests. (esh-proc-test/kill-background-process): Rename to... (esh-proc-test/kill-process/background-prompt): ... this, and use 'eshell-wait-for-subprocess' instead of 'sit-for'. --- lisp/eshell/esh-proc.el | 144 +++++++++++++++-------------- test/lisp/eshell/esh-proc-tests.el | 95 ++++++++++++++++--- 2 files changed, 159 insertions(+), 80 deletions(-) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index c367b5cd64..5ca35b71db 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -99,7 +99,13 @@ eshell-kill-hook (defvar eshell-current-subjob-p nil) (defvar eshell-process-list nil - "A list of the current status of subprocesses.") + "A list of the current status of subprocesses. +Each element has the form (PROC . SUBJOB-P), where PROC is the +process object and SUBJOB-P is non-nil if the process is a +subjob. + +To add or remove elements of this list, see +`eshell-record-process-object' and `eshell-remove-process-entry'.") (declare-function eshell-send-eof-to-process "esh-mode") (declare-function eshell-tail-process "esh-cmd") @@ -229,21 +235,26 @@ eshell-record-process-object (declare-function eshell-interactive-print "esh-mode" (string)) (eshell-interactive-print (format "[%s] %d\n" (process-name object) (process-id object)))) - (setq eshell-process-list - (cons (list object eshell-current-handles - eshell-current-subjob-p nil nil) - eshell-process-list))) + (push (cons object eshell-current-subjob-p) eshell-process-list)) (defun eshell-remove-process-entry (entry) "Record the process ENTRY as fully completed." (if (and (eshell-processp (car entry)) - (nth 2 entry) + (cdr entry) eshell-done-messages-in-minibuffer) (message "[%s]+ Done %s" (process-name (car entry)) (process-command (car entry)))) (setq eshell-process-list (delq entry eshell-process-list))) +(defun eshell-record-process-properties (process) + "Record Eshell bookkeeping properties for PROCESS. +`eshell-insertion-filter' and `eshell-sentinel' will use these to +do their jobs." + (process-put process :eshell-handles eshell-current-handles) + (process-put process :eshell-pending nil) + (process-put process :eshell-busy nil)) + (defvar eshell-scratch-buffer " *eshell-scratch*" "Scratch buffer for holding Eshell's input/output.") (defvar eshell-last-sync-output-start nil @@ -283,6 +294,7 @@ eshell-gather-process-output :connection-type conn-type :file-handler t))) (eshell-record-process-object proc) + (eshell-record-process-properties proc) (run-hook-with-args 'eshell-exec-hook proc) (when (fboundp 'process-coding-system) (let ((coding-systems (process-coding-system proc))) @@ -363,36 +375,35 @@ eshell-insertion-filter output." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) - (let ((entry (assq proc eshell-process-list))) - (when entry - (setcar (nthcdr 3 entry) - (concat (nth 3 entry) string)) - (unless (nth 4 entry) ; already being handled? - (while (nth 3 entry) - (let ((data (nth 3 entry))) - (setcar (nthcdr 3 entry) nil) - (setcar (nthcdr 4 entry) t) - (unwind-protect - (condition-case nil - (eshell-output-object data nil (cadr entry)) - ;; FIXME: We want to send SIGPIPE to the process - ;; here. However, remote processes don't - ;; currently support that, and not all systems - ;; have SIGPIPE in the first place (e.g. MS - ;; Windows). In these cases, just delete the - ;; process; this is reasonably close to the - ;; right behavior, since the default action for - ;; SIGPIPE is to terminate the process. For use - ;; cases where SIGPIPE is truly needed, using an - ;; external pipe operator (`*|') may work - ;; instead (e.g. when working with remote - ;; processes). - (eshell-pipe-broken - (if (or (process-get proc 'remote-pid) - (eq system-type 'windows-nt)) - (delete-process proc) - (signal-process proc 'SIGPIPE)))) - (setcar (nthcdr 4 entry) nil)))))))))) + (process-put proc :eshell-pending + (concat (process-get proc :eshell-pending) + string)) + (unless (process-get proc :eshell-busy) ; Already being handled? + (while (process-get proc :eshell-pending) + (let ((handles (process-get proc :eshell-handles)) + (data (process-get proc :eshell-pending))) + (process-put proc :eshell-pending nil) + (process-put proc :eshell-busy t) + (unwind-protect + (condition-case nil + (eshell-output-object data nil handles) + ;; FIXME: We want to send SIGPIPE to the process + ;; here. However, remote processes don't currently + ;; support that, and not all systems have SIGPIPE in + ;; the first place (e.g. MS Windows). In these + ;; cases, just delete the process; this is + ;; reasonably close to the right behavior, since the + ;; default action for SIGPIPE is to terminate the + ;; process. For use cases where SIGPIPE is truly + ;; needed, using an external pipe operator (`*|') + ;; may work instead (e.g. when working with remote + ;; processes). + (eshell-pipe-broken + (if (or (process-get proc 'remote-pid) + (eq system-type 'windows-nt)) + (delete-process proc) + (signal-process proc 'SIGPIPE)))) + (process-put proc :eshell-busy nil)))))))) (defun eshell-sentinel (proc string) "Generic sentinel for command processes. Reports only signals. @@ -400,37 +411,34 @@ eshell-sentinel (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (unwind-protect - (when-let ((entry (assq proc eshell-process-list))) - (unwind-protect - (unless (string= string "run") - ;; Write the exit message if the status is - ;; abnormal and the process is already writing - ;; to the terminal. - (when (and (eq proc (eshell-tail-process)) - (not (string-match "^\\(finished\\|exited\\)" - string))) - (funcall (process-filter proc) proc string)) - (let ((handles (nth 1 entry)) - (str (prog1 (nth 3 entry) - (setf (nth 3 entry) nil))) - (status (process-exit-status proc))) - ;; If we're in the middle of handling output - ;; from this process then schedule the EOF for - ;; later. - (letrec ((finish-io - (lambda () - (if (nth 4 entry) - (run-at-time 0 nil finish-io) - (when str - (ignore-error 'eshell-pipe-broken - (eshell-output-object - str nil handles))) - (eshell-close-handles - status (list 'quote (= status 0)) - handles))))) - (funcall finish-io)))) - (eshell-remove-process-entry entry))) - (eshell-kill-process-function proc string))))) + (unless (string= string "run") + ;; Write the exit message if the status is abnormal and + ;; the process is already writing to the terminal. + (when (and (eq proc (eshell-tail-process)) + (not (string-match "^\\(finished\\|exited\\)" + string))) + (funcall (process-filter proc) proc string)) + (let ((handles (process-get proc :eshell-handles)) + (data (process-get proc :eshell-pending)) + (status (process-exit-status proc))) + (process-put proc :eshell-pending nil) + ;; If we're in the middle of handling output from this + ;; process then schedule the EOF for later. + (letrec ((finish-io + (lambda () + (if (process-get proc :eshell-busy) + (run-at-time 0 nil finish-io) + (when data + (ignore-error 'eshell-pipe-broken + (eshell-output-object + data nil handles))) + (eshell-close-handles + status (list 'quote (= status 0)) + handles))))) + (funcall finish-io)))) + (when-let ((entry (assq proc eshell-process-list))) + (eshell-remove-process-entry entry)) + (eshell-kill-process-function proc string))))) (defun eshell-process-interact (func &optional all query) "Interact with a process, using PROMPT if more than one, via FUNC. @@ -441,7 +449,7 @@ eshell-process-interact (if (and (memq (process-status (car entry)) '(run stop open closed)) (or all - (not (nth 2 entry))) + (not (cdr entry))) (or (not query) (y-or-n-p (format-message query (process-name (car entry)))))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index 2369bb5cc0..3995d0b310 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -28,15 +28,67 @@ (file-name-directory (or load-file-name default-directory)))) +(defvar esh-proc-test--output-cmd + (concat "sh -c '" + "echo stdout; " + "echo stderr >&2" + "'") + "A shell command that prints to both stdout and stderr.") + (defvar esh-proc-test--detect-pty-cmd (concat "sh -c '" "if [ -t 0 ]; then echo stdin; fi; " "if [ -t 1 ]; then echo stdout; fi; " "if [ -t 2 ]; then echo stderr; fi" - "'")) + "'") + "A shell command that prints the standard streams connected as TTYs.") ;;; Tests: + +;; Output and redirection + +(ert-deftest esh-proc-test/output/to-screen () + "Check that outputting stdout and stderr to the screen works." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-match-command-output esh-proc-test--output-cmd + "stdout\nstderr\n"))) + +(ert-deftest esh-proc-test/output/stdout-and-stderr-to-buffer () + "Check that redirecting stdout and stderr works." + (skip-unless (executable-find "sh")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "%s &> #<%s>" esh-proc-test--output-cmd bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\n")))) + + +;; Exit status + +(ert-deftest esh-proc-test/exit-status/success () + "Check that successful execution is properly recorded." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-insert-command "sh -c 'exit 0'") + (eshell-wait-for-subprocess) + (should (= eshell-last-command-status 0)) + (should (eq eshell-last-command-result t)))) + +(ert-deftest esh-proc-test/exit-status/failure () + "Check that failed execution is properly recorded." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-insert-command "sh -c 'exit 1'") + (eshell-wait-for-subprocess) + (should (= eshell-last-command-status 1)) + (should (eq eshell-last-command-result nil)))) + + +;; Pipelines + (ert-deftest esh-proc-test/sigpipe-exits-process () "Test that a SIGPIPE is properly sent to a process if a pipe closes" (skip-unless (and (executable-find "sh") @@ -88,6 +140,35 @@ esh-proc-test/pipeline-connection-type/last (unless (eq system-type 'windows-nt) "stdout\nstderr\n"))) + +;; Killing processes + +(ert-deftest esh-proc-test/kill-process/foreground-only () + "Test that `eshell-kill-process' only kills foreground processes." + (with-temp-eshell + (eshell-insert-command "sleep 100 &") + (eshell-insert-command "sleep 100") + (should (equal (length eshell-process-list) 2)) + ;; This should kill only the foreground process. + (eshell-kill-process) + (eshell-wait-for-subprocess) + (should (equal (length eshell-process-list) 1)) + ;; Now kill everything, including the background process. + (eshell-process-interact 'kill-process t) + (eshell-wait-for-subprocess t) + (should (equal (length eshell-process-list) 0)))) + +(ert-deftest esh-proc-test/kill-process/background-prompt () + "Test that killing a background process doesn't emit a new +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") + (kill-process (caar eshell-process-list)) + (eshell-wait-for-subprocess) + (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n")))) + (ert-deftest esh-proc-test/kill-pipeline () "Test that killing a pipeline of processes only emits a single prompt. See bug#54136." @@ -127,14 +208,4 @@ esh-proc-test/kill-pipeline-head output-start (eshell-end-of-output)) ""))))) -(ert-deftest esh-proc-test/kill-background-process () - "Test that killing a background process doesn't emit a new -prompt. See bug#54136." - (skip-unless (and (executable-find "sh") - (executable-find "sleep"))) - (with-temp-eshell - (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") - (kill-process (caar eshell-process-list)) - ;; Give `eshell-sentinel' a chance to run. - (sit-for 0.1) - (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n")))) +;;; esh-proc-tests.el ends here -- 2.25.1