[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master a87c7aff55 4/5: Put Eshell's bookkeeping data for external proces
|
From: |
Jim Porter |
|
Subject: |
master a87c7aff55 4/5: Put Eshell's bookkeeping data for external processes on the process object |
|
Date: |
Sun, 4 Sep 2022 19:04:13 -0400 (EDT) |
branch: master
commit a87c7aff554213651678e9390dd7500b11419012
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>
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 @@ information, for example."
(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 @@ The prompt will be set to PROMPT."
(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 @@ Used only on systems which do not support async
subprocesses.")
: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 @@ PROC is the process for which we're inserting output.
STRING is the
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 @@ PROC is the process that's exiting. STRING is the exit
message."
(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 @@ If QUERY is non-nil, query the user with QUERY before
calling FUNC."
(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 b9f4470be6..4cb0b796a8 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")
@@ -94,6 +146,35 @@ pipeline."
(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."
@@ -133,14 +214,4 @@ write the exit status to the pipe. See bug#54136."
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