unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Jim Porter <jporterbugs@gmail.com>
To: Ken Brown <kbrown@cornell.edu>,
	Sean Whitton <spwhitton@email.arizona.edu>,
	Eli Zaretskii <eliz@gnu.org>
Cc: larsi@gnus.org, 56025@debbugs.gnu.org
Subject: bug#56025: [PATCH v4] 29.0.50; em-extpipe-test-2 times out on EMBA and Cygwin
Date: Sat, 23 Jul 2022 22:29:28 -0700	[thread overview]
Message-ID: <7056ea9f-a55d-28b7-52cf-caca7a9053a5@gmail.com> (raw)
In-Reply-To: <f5fd8126-e51a-222c-65e3-4a91d906bd87@gmail.com>

[-- Attachment #1: Type: text/plain, Size: 383 bytes --]

On 7/23/2022 10:19 PM, Jim Porter wrote:
> I thought about it some more, and just to be sure the Eshell bits don't 
> regress at some point in the future, I added some new unit tests in 
> test/lisp/eshell/esh-proc-tests.el...

Oops. I forgot to add some `(skip-unless ...)' forms for these tests, 
so... here they are. Hopefully this will be the last message from me for 
a bit. :C

[-- Attachment #2: 0001-Allow-creating-processes-where-only-one-of-stdin-or-.patch --]
[-- Type: text/plain, Size: 38705 bytes --]

From ba745998d7f26262a721413b7dc49549e673387c Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 17 Jul 2022 20:25:00 -0700
Subject: [PATCH 1/2] Allow creating processes where only one of stdin or
 stdout is a PTY

* src/lisp.h (emacs_spawn):
* src/callproc.c (emacs_spawn): Add PTY_IN and PTY_OUT arguments to
specify which streams should be set up as a PTY.
(call_process): Adjust call to 'emacs_spawn'.

* src/process.h (Lisp_Process): Replace 'pty_flag' with 'pty_in' and
'pty_out'.

* src/process.c (is_pty_from_symbol): New function.
(make-process): Allow :connection-type to be a cons cell, and allow
using a stderr process with a PTY for stdin/stdout.
(create_process): Handle creating a process where only one of stdin or
stdout is a PTY.

* lisp/eshell/esh-proc.el (eshell-needs-pipe, eshell-needs-pipe-p):
Remove.
(eshell-gather-process-output): Use 'make-process' and set
':connection-type' as needed by the value of 'eshell-in-pipeline-p'.

* lisp/net/tramp.el (tramp-handle-make-process):
* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't signal an
error when ':connection-type' is a cons cell.

* test/src/process-tests.el
(process-test-sentinel-wait-function-working-p): Allow passing PROC
in, and rework into...
(process-test-wait-for-sentinel): ... this.
(process-test-sentinel-accept-process-output)
(process-test-sentinel-sit-for, process-test-quoted-batfile)
(process-test-stderr-filter): Use 'process-test-wait-for-sentinel'.
(make/process/test-connection-type): New function.
(make-process/connection-type/pty, make-process/connection-type/pty-2)
(make-process/connection-type/pipe)
(make-process/connection-type/pipe-2)
(make-process/connection-type/in-pty)
(make-process/connection-type/out-pty)
(make-process/connection-type/pty-with-stderr-buffer)
(make-process/connection-type/out-pty-with-stderr-buffer): New tests.

* test/lisp/eshell/esh-proc-tests.el (esh-proc-test--detect-pty-cmd):
New variable.
(esh-proc-test/pipeline-connection-type/no-pipeline)
(esh-proc-test/pipeline-connection-type/first)
(esh-proc-test/pipeline-connection-type/middle)
(esh-proc-test/pipeline-connection-type/last): New tests.

* doc/lispref/processes.texi (Asynchronous Processes): Document new
':connection-type' behavior.
(Output from Processes): Remove caveat about ':stderr' forcing
'make-process' to use pipes.

* etc/NEWS: Announce this change.
---
 doc/lispref/processes.texi         |  28 +++----
 etc/NEWS                           |  12 +++
 lisp/eshell/esh-proc.el            |  55 ++++--------
 lisp/net/tramp-adb.el              |   5 +-
 lisp/net/tramp-sh.el               |   5 +-
 lisp/net/tramp.el                  |   5 +-
 src/callproc.c                     |  37 +++++----
 src/lisp.h                         |   3 +-
 src/process.c                      | 129 ++++++++++++++++++-----------
 src/process.h                      |   5 +-
 test/lisp/eshell/esh-proc-tests.el |  43 ++++++++++
 test/src/process-tests.el          | 121 +++++++++++++++++++--------
 12 files changed, 288 insertions(+), 160 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 80c371e1c6..a7e08054c7 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -705,12 +705,13 @@ Asynchronous Processes
 Initialize the type of device used to communicate with the subprocess.
 Possible values are @code{pty} to use a pty, @code{pipe} to use a
 pipe, or @code{nil} to use the default derived from the value of the
-@code{process-connection-type} variable.  This parameter and the value
-of @code{process-connection-type} are ignored if a non-@code{nil}
-value is specified for the @code{:stderr} parameter; in that case, the
-type will always be @code{pipe}.  On systems where ptys are not
-available (MS-Windows), this parameter is likewise ignored, and pipes
-are used unconditionally.
+@code{process-connection-type} variable.  If @var{type} is a cons cell
+@w{@code{(@var{input} . @var{output})}}, then @var{input} will be used
+for standard input and @var{output} for standard output (and standard
+error if @code{:stderr} is @code{nil}).
+
+On systems where ptys are not available (MS-Windows), this parameter
+is ignored, and pipes are used unconditionally.
 
 @item :noquery @var{query-flag}
 Initialize the process query flag to @var{query-flag}.
@@ -1530,20 +1531,11 @@ Output from Processes
 default filter discards the output.
 
   If the subprocess writes to its standard error stream, by default
-the error output is also passed to the process filter function.  If
-Emacs uses a pseudo-TTY (pty) for communication with the subprocess,
-then it is impossible to separate the standard output and standard
-error streams of the subprocess, because a pseudo-TTY has only one
-output channel.  In that case, if you want to keep the output to those
-streams separate, you should redirect one of them to a file---for
-example, by using an appropriate shell command via
-@code{start-process-shell-command} or a similar function.
-
-  Alternatively, you could use the @code{:stderr} parameter with a
+the error output is also passed to the process filter function.
+Alternatively, you could use the @code{:stderr} parameter with a
 non-@code{nil} value in a call to @code{make-process}
 (@pxref{Asynchronous Processes, make-process}) to make the destination
-of the error output separate from the standard output; in that case,
-Emacs will use pipes for communicating with the subprocess.
+of the error output separate from the standard output.
 
   When a subprocess terminates, Emacs reads any pending output,
 then stops reading output from that subprocess.  Therefore, if the
diff --git a/etc/NEWS b/etc/NEWS
index 6d4fce1237..dc79f0826a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2229,6 +2229,12 @@ they will still be escaped, so the '.foo' symbol is still printed as
 and remapping parent of basic faces does not work reliably.
 Instead of remapping 'mode-line', you have to remap 'mode-line-active'.
 
++++
+** 'make-process' has been extended to support ptys when ':stderr' is set.
+Previously, setting ':stderr' to a non-nil value would force the
+process's connection to use pipes.  Now, Emacs will use a pty for
+stdin and stdout if requested no matter the value of ':stderr'.
+
 ---
 ** User option 'mail-source-ignore-errors' is now obsolete.
 The whole mechanism for prompting users to continue in case of
@@ -3188,6 +3194,12 @@ translation.
 This is useful when quoting shell arguments for a remote shell
 invocation.  Such shells are POSIX conformant by default.
 
++++
+** 'make-process' can set connection type independently for input and output.
+When calling 'make-process', communication via pty can be enabled
+selectively for just input or output by passing a cons cell for
+':connection-type', e.g. '(pipe . pty)'.
+
 +++
 ** 'signal-process' now consults the list 'signal-process-functions'.
 This is to determine which function has to be called in order to
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 70426ccaf2..99b43661f2 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -250,30 +250,6 @@ eshell-last-sync-output-start
   "A marker that tracks the beginning of output of the last subprocess.
 Used only on systems which do not support async subprocesses.")
 
-(defvar eshell-needs-pipe
-  '("bc"
-    ;; xclip.el (in GNU ELPA) calls all of these with
-    ;; `process-connection-type' set to nil.
-    "pbpaste" "putclip" "xclip" "xsel" "wl-copy")
-  "List of commands which need `process-connection-type' to be nil.
-Currently only affects commands in pipelines, and not those at
-the front.  If an element contains a directory part it must match
-the full name of a command, otherwise just the nondirectory part must match.")
-
-(defun eshell-needs-pipe-p (command)
-  "Return non-nil if COMMAND needs `process-connection-type' to be nil.
-See `eshell-needs-pipe'."
-  (and (bound-and-true-p eshell-in-pipeline-p)
-       (not (eq eshell-in-pipeline-p 'first))
-       ;; FIXME should this return non-nil for anything that is
-       ;; neither 'first nor 'last?  See bug#1388 discussion.
-       (catch 'found
-	 (dolist (exe eshell-needs-pipe)
-	   (if (string-equal exe (if (string-search "/" exe)
-				     command
-				   (file-name-nondirectory command)))
-	       (throw 'found t))))))
-
 (defun eshell-gather-process-output (command args)
   "Gather the output from COMMAND + ARGS."
   (require 'esh-var)
@@ -290,31 +266,36 @@ eshell-gather-process-output
     (cond
      ((fboundp 'make-process)
       (setq proc
-	    (let ((process-connection-type
-		   (unless (eshell-needs-pipe-p command)
-		     process-connection-type))
-		  (command (file-local-name (expand-file-name command))))
-	      (apply #'start-file-process
-		     (file-name-nondirectory command) nil command args)))
+            (let ((command (file-local-name (expand-file-name command)))
+                  (conn-type (pcase (bound-and-true-p eshell-in-pipeline-p)
+                               ('first '(nil . pipe))
+                               ('last  '(pipe . nil))
+                               ('t     'pipe)
+                               ('nil   nil))))
+              (make-process
+               :name (file-name-nondirectory command)
+               :buffer (current-buffer)
+               :command (cons command args)
+               :filter (if (eshell-interactive-output-p)
+                           #'eshell-output-filter
+                         #'eshell-insertion-filter)
+               :sentinel #'eshell-sentinel
+               :connection-type conn-type
+               :file-handler t)))
       (eshell-record-process-object proc)
-      (set-process-buffer proc (current-buffer))
-      (set-process-filter proc (if (eshell-interactive-output-p)
-	                           #'eshell-output-filter
-                                 #'eshell-insertion-filter))
-      (set-process-sentinel proc #'eshell-sentinel)
       (run-hook-with-args 'eshell-exec-hook proc)
       (when (fboundp 'process-coding-system)
 	(let ((coding-systems (process-coding-system proc)))
 	  (setq decoding (car coding-systems)
 		encoding (cdr coding-systems)))
-	;; If start-process decided to use some coding system for
+	;; If `make-process' decided to use some coding system for
 	;; decoding data sent from the process and the coding system
 	;; doesn't specify EOL conversion, we had better convert CRLF
 	;; to LF.
 	(if (vectorp (coding-system-eol-type decoding))
 	    (setq decoding (coding-system-change-eol-conversion decoding 'dos)
 		  changed t))
-	;; Even if start-process left the coding system for encoding
+	;; Even if `make-process' left the coding system for encoding
 	;; data sent from the process undecided, we had better use the
 	;; same one as what we use for decoding.  But, we should
 	;; suppress EOL conversion.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index de55856830..451128ab20 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -904,7 +904,10 @@ tramp-adb-handle-make-process
 	    (signal 'wrong-type-argument (list #'symbolp coding)))
 	  (when (eq connection-type t)
 	    (setq connection-type 'pty))
-	  (unless (memq connection-type '(nil pipe pty))
+	  (unless (or (and (consp connection-type)
+			   (memq (car connection-type) '(nil pipe pty))
+			   (memq (cdr connection-type) '(nil pipe pty)))
+		      (memq connection-type '(nil pipe pty)))
 	    (signal 'wrong-type-argument (list #'symbolp connection-type)))
 	  (unless (or (null filter) (eq filter t) (functionp filter))
 	    (signal 'wrong-type-argument (list #'functionp filter)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e772af9e0a..8c48c3fc1e 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2851,7 +2851,10 @@ tramp-sh-handle-make-process
 	    (signal 'wrong-type-argument (list #'symbolp coding)))
 	  (when (eq connection-type t)
 	    (setq connection-type 'pty))
-	  (unless (memq connection-type '(nil pipe pty))
+	  (unless (or (and (consp connection-type)
+			   (memq (car connection-type) '(nil pipe pty))
+			   (memq (cdr connection-type) '(nil pipe pty)))
+		      (memq connection-type '(nil pipe pty)))
 	    (signal 'wrong-type-argument (list #'symbolp connection-type)))
 	  (unless (or (null filter) (eq filter t) (functionp filter))
 	    (signal 'wrong-type-argument (list #'functionp filter)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b11fd293cc..8b654944fe 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4605,7 +4605,10 @@ tramp-handle-make-process
 	  (signal 'wrong-type-argument (list #'symbolp coding)))
 	(when (eq connection-type t)
 	  (setq connection-type 'pty))
-	(unless (memq connection-type '(nil pipe pty))
+	(unless (or (and (consp connection-type)
+			 (memq (car connection-type) '(nil pipe pty))
+			 (memq (cdr connection-type) '(nil pipe pty)))
+		    (memq connection-type '(nil pipe pty)))
 	  (signal 'wrong-type-argument (list #'symbolp connection-type)))
 	(unless (or (null filter) (eq filter t) (functionp filter))
 	  (signal 'wrong-type-argument (list #'functionp filter)))
diff --git a/src/callproc.c b/src/callproc.c
index dd162f36a6..aec0a2f5a5 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -650,7 +650,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 
   child_errno
     = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
-                   SSDATA (current_dir), NULL, &oldset);
+                   SSDATA (current_dir), NULL, false, false, &oldset);
   eassert ((child_errno == 0) == (0 < pid));
 
   if (pid > 0)
@@ -1412,14 +1412,15 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
 int
 emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
              char **argv, char **envp, const char *cwd,
-             const char *pty, const sigset_t *oldset)
+             const char *pty_name, bool pty_in, bool pty_out,
+             const sigset_t *oldset)
 {
 #if USABLE_POSIX_SPAWN
   /* Prefer the simpler `posix_spawn' if available.  `posix_spawn'
      doesn't yet support setting up pseudoterminals, so we fall back
      to `vfork' if we're supposed to use a pseudoterminal.  */
 
-  bool use_posix_spawn = pty == NULL;
+  bool use_posix_spawn = pty_name == NULL;
 
   posix_spawn_file_actions_t actions;
   posix_spawnattr_t attributes;
@@ -1473,7 +1474,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
   /* vfork, and prevent local vars from being clobbered by the vfork.  */
   pid_t *volatile newpid_volatile = newpid;
   const char *volatile cwd_volatile = cwd;
-  const char *volatile pty_volatile = pty;
+  const char *volatile ptyname_volatile = pty_name;
+  bool volatile ptyin_volatile = pty_in;
+  bool volatile ptyout_volatile = pty_out;
   char **volatile argv_volatile = argv;
   int volatile stdin_volatile = std_in;
   int volatile stdout_volatile = std_out;
@@ -1495,7 +1498,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 
   newpid = newpid_volatile;
   cwd = cwd_volatile;
-  pty = pty_volatile;
+  pty_name = ptyname_volatile;
+  pty_in = ptyin_volatile;
+  pty_out = ptyout_volatile;
   argv = argv_volatile;
   std_in = stdin_volatile;
   std_out = stdout_volatile;
@@ -1506,13 +1511,12 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
   if (pid == 0)
 #endif /* not WINDOWSNT */
     {
-      bool pty_flag = pty != NULL;
       /* Make the pty be the controlling terminal of the process.  */
 #ifdef HAVE_PTYS
       dissociate_controlling_tty ();
 
       /* Make the pty's terminal the controlling terminal.  */
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 #ifdef TIOCSCTTY
 	  /* We ignore the return value
@@ -1521,7 +1525,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 #endif
 	}
 #if defined (LDISC1)
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 	  struct termios t;
 	  tcgetattr (std_in, &t);
@@ -1531,7 +1535,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 	}
 #else
 #if defined (NTTYDISC) && defined (TIOCSETD)
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 	  /* Use new line discipline.  */
 	  int ldisc = NTTYDISC;
@@ -1548,18 +1552,21 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
      both TIOCSCTTY is defined.  */
 	/* Now close the pty (if we had it open) and reopen it.
 	   This makes the pty the controlling terminal of the subprocess.  */
-      if (pty_flag)
+      if (pty_name)
 	{
 
 	  /* I wonder if emacs_close (emacs_open (pty, ...))
 	     would work?  */
-	  if (std_in >= 0)
+	  if (pty_in && std_in >= 0)
 	    emacs_close (std_in);
-          std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
-
+	  int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
+	  if (pty_in)
+	    std_in = ptyfd;
+	  if (pty_out)
+	    std_out = ptyfd;
 	  if (std_in < 0)
 	    {
-	      emacs_perror (pty);
+	      emacs_perror (pty_name);
 	      _exit (EXIT_CANCELED);
 	    }
 
@@ -1599,7 +1606,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
       /* Stop blocking SIGCHLD in the child.  */
       unblock_child_signal (oldset);
 
-      if (pty_flag)
+      if (pty_out)
 	child_setup_tty (std_out);
 #endif
 
diff --git a/src/lisp.h b/src/lisp.h
index 2afe135674..264228618d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4941,7 +4941,8 @@ #define DAEMON_RUNNING (w32_daemon_event != INVALID_HANDLE_VALUE)
 #endif
 
 extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
-                        const char *, const char *, const sigset_t *);
+                        const char *, const char *, bool, bool,
+                        const sigset_t *);
 extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL;
 extern void init_callproc_1 (void);
 extern void init_callproc (void);
diff --git a/src/process.c b/src/process.c
index d6d51b26e1..da5e9cb182 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1316,6 +1316,19 @@ set_process_filter_masks (struct Lisp_Process *p)
     add_process_read_fd (p->infd);
 }
 
+static bool
+is_pty_from_symbol (Lisp_Object symbol)
+{
+  if (EQ (symbol, Qpty))
+    return true;
+  else if (EQ (symbol, Qpipe))
+    return false;
+  else if (NILP (symbol))
+    return !NILP (Vprocess_connection_type);
+  else
+    report_file_error ("Unknown connection type", symbol);
+}
+
 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
        2, 2, 0,
        doc: /* Give PROCESS the filter function FILTER; nil means default.
@@ -1741,15 +1754,18 @@ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
 :connection-type TYPE -- TYPE is control type of device used to
 communicate with subprocesses.  Values are `pipe' to use a pipe, `pty'
 to use a pty, or nil to use the default specified through
-`process-connection-type'.
+`process-connection-type'.  If TYPE is a cons (INPUT . OUTPUT), then
+INPUT will be used for standard input and OUTPUT for standard output
+(and standard error if `:stderr' is nil).
 
 :filter FILTER -- Install FILTER as the process filter.
 
 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
 
 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
-to the standard error of subprocess.  Specifying this implies
-`:connection-type' is set to `pipe'.  If STDERR is nil, standard error
+to the standard error of subprocess.  When specifying this, the
+subprocess's standard error will always communicate via a pipe, no
+matter the value of `:connection-type'.  If STDERR is nil, standard error
 is mixed with standard output and sent to BUFFER or FILTER.  (Note
 that specifying :stderr will create a new, separate (but associated)
 process, with its own filter and sentinel.  See
@@ -1845,22 +1861,20 @@ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
   CHECK_TYPE (NILP (tem), Qnull, tem);
 
   tem = plist_get (contact, QCconnection_type);
-  if (EQ (tem, Qpty))
-    XPROCESS (proc)->pty_flag = true;
-  else if (EQ (tem, Qpipe))
-    XPROCESS (proc)->pty_flag = false;
-  else if (NILP (tem))
-    XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+  if (CONSP (tem))
+    {
+      XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem));
+      XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem));
+    }
   else
-    report_file_error ("Unknown connection type", tem);
-
-  if (!NILP (stderrproc))
     {
-      pset_stderrproc (XPROCESS (proc), stderrproc);
-
-      XPROCESS (proc)->pty_flag = false;
+      XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
+	is_pty_from_symbol (tem);
     }
 
+  if (!NILP (stderrproc))
+    pset_stderrproc (XPROCESS (proc), stderrproc);
+
 #ifdef HAVE_GNUTLS
   /* AKA GNUTLS_INITSTAGE(proc).  */
   verify (GNUTLS_STAGE_EMPTY == 0);
@@ -2099,66 +2113,80 @@ verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
 {
   struct Lisp_Process *p = XPROCESS (process);
-  int inchannel, outchannel;
+  int inchannel = -1, outchannel = -1;
   pid_t pid = -1;
   int vfork_errno;
   int forkin, forkout, forkerr = -1;
-  bool pty_flag = 0;
+  bool pty_in = false, pty_out = false;
   char pty_name[PTY_NAME_SIZE];
   Lisp_Object lisp_pty_name = Qnil;
+  int ptychannel = -1, pty_tty = -1;
   sigset_t oldset;
 
   /* Ensure that the SIGCHLD handler can notify
      `wait_reading_process_output'.  */
   child_signal_init ();
 
-  inchannel = outchannel = -1;
-
-  if (p->pty_flag)
-    outchannel = inchannel = allocate_pty (pty_name);
+  if (p->pty_in || p->pty_out)
+    ptychannel = allocate_pty (pty_name);
 
-  if (inchannel >= 0)
+  if (ptychannel >= 0)
     {
-      p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
       /* On most USG systems it does not work to open the pty's tty here,
 	 then close it and reopen it in the child.  */
       /* Don't let this terminal become our controlling terminal
 	 (in case we don't have one).  */
-      forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-      if (forkin < 0)
+      pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
+      if (pty_tty < 0)
 	report_file_error ("Opening pty", Qnil);
-      p->open_fd[SUBPROCESS_STDIN] = forkin;
-#else
-      forkin = forkout = -1;
 #endif /* not USG, or USG_SUBTTY_WORKS */
-      pty_flag = 1;
+      pty_in = p->pty_in;
+      pty_out = p->pty_out;
       lisp_pty_name = build_string (pty_name);
     }
+
+  /* Set up stdin for the child process.  */
+  if (ptychannel >= 0 && p->pty_in)
+    {
+      p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
+      outchannel = ptychannel;
+    }
   else
     {
-      if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
-	  || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+      if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
 	report_file_error ("Creating pipe", Qnil);
       forkin = p->open_fd[SUBPROCESS_STDIN];
       outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+    }
+
+  /* Set up stdout for the child process.  */
+  if (ptychannel >= 0 && p->pty_out)
+    {
+      forkout = pty_tty;
+      p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
+    }
+  else
+    {
+      if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+	report_file_error ("Creating pipe", Qnil);
       inchannel = p->open_fd[READ_FROM_SUBPROCESS];
       forkout = p->open_fd[SUBPROCESS_STDOUT];
 
 #if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
       fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
 #endif
+    }
 
-      if (!NILP (p->stderrproc))
-	{
-	  struct Lisp_Process *pp = XPROCESS (p->stderrproc);
+  if (!NILP (p->stderrproc))
+    {
+      struct Lisp_Process *pp = XPROCESS (p->stderrproc);
 
-	  forkerr = pp->open_fd[SUBPROCESS_STDOUT];
+      forkerr = pp->open_fd[SUBPROCESS_STDOUT];
 
-	  /* Close unnecessary file descriptors.  */
-	  close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
-	  close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
-	}
+      /* Close unnecessary file descriptors.  */
+      close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
+      close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
     }
 
   if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
@@ -2183,7 +2211,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
      we just reopen the device (see emacs_get_tty_pgrp) as this is
      more portable (see USG_SUBTTY_WORKS above).  */
 
-  p->pty_flag = pty_flag;
+  p->pty_in = pty_in;
+  p->pty_out = pty_out;
   pset_status (p, Qrun);
 
   if (!EQ (p->command, Qt)
@@ -2199,13 +2228,15 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
   block_input ();
   block_child_signal (&oldset);
 
-  pty_flag = p->pty_flag;
-  eassert (pty_flag == ! NILP (lisp_pty_name));
+  pty_in = p->pty_in;
+  pty_out = p->pty_out;
+  eassert ((pty_in || pty_out) == ! NILP (lisp_pty_name));
 
   vfork_errno
     = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
                    SSDATA (current_dir),
-                   pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
+                   pty_in || pty_out ? SSDATA (lisp_pty_name) : NULL,
+                   pty_in, pty_out, &oldset);
 
   eassert ((vfork_errno == 0) == (0 < pid));
 
@@ -2263,7 +2294,7 @@ create_pty (Lisp_Object process)
 {
   struct Lisp_Process *p = XPROCESS (process);
   char pty_name[PTY_NAME_SIZE];
-  int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
+  int pty_fd = !(p->pty_in || p->pty_out) ? -1 : allocate_pty (pty_name);
 
   if (pty_fd >= 0)
     {
@@ -2301,7 +2332,7 @@ create_pty (Lisp_Object process)
 	 we just reopen the device (see emacs_get_tty_pgrp) as this is
 	 more portable (see USG_SUBTTY_WORKS above).  */
 
-      p->pty_flag = 1;
+      p->pty_in = p->pty_out = true;
       pset_status (p, Qrun);
       setup_process_coding_systems (process);
 
@@ -2412,7 +2443,7 @@ DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
     p->kill_without_query = 1;
   if (tem = plist_get (contact, QCstop), !NILP (tem))
     pset_command (p, Qt);
-  eassert (! p->pty_flag);
+  eassert (! p->pty_in && ! p->pty_out);
 
   if (!EQ (p->command, Qt)
       && !EQ (p->filter, Qt))
@@ -3147,7 +3178,7 @@ DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
     p->kill_without_query = 1;
   if (tem = plist_get (contact, QCstop), !NILP (tem))
     pset_command (p, Qt);
-  eassert (! p->pty_flag);
+  eassert (! p->pty_in && ! p->pty_out);
 
   if (!EQ (p->command, Qt)
       && !EQ (p->filter, Qt))
@@ -6798,7 +6829,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
     error ("Process %s is not active",
 	   SDATA (p->name));
 
-  if (!p->pty_flag)
+  if (! p->pty_in)
     current_group = Qnil;
 
   /* If we are using pgrps, get a pgrp number and make it negative.  */
@@ -7167,7 +7198,7 @@ DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
       send_process (proc, "", 0, Qnil);
     }
 
-  if (XPROCESS (proc)->pty_flag)
+  if (XPROCESS (proc)->pty_in)
     send_process (proc, "\004", 1, Qnil);
   else if (EQ (XPROCESS (proc)->type, Qserial))
     {
diff --git a/src/process.h b/src/process.h
index 392b661ce6..92baf0c4cb 100644
--- a/src/process.h
+++ b/src/process.h
@@ -156,8 +156,9 @@ #define EMACS_PROCESS_H
     /* True means kill silently if Emacs is exited.
        This is the inverse of the `query-on-exit' flag.  */
     bool_bf kill_without_query : 1;
-    /* True if communicating through a pty.  */
-    bool_bf pty_flag : 1;
+    /* True if communicating through a pty for input or output.  */
+    bool_bf pty_in : 1;
+    bool_bf pty_out : 1;
     /* Flag to set coding-system of the process buffer from the
        coding_system used to decode process output.  */
     bool_bf inherit_coding_system_flag : 1;
diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el
index 7f461d1813..734bb91a6a 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -28,6 +28,15 @@
                            (file-name-directory (or load-file-name
                                                     default-directory))))
 
+(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"
+          "'"))
+
+;;; Tests:
+
 (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")
@@ -44,6 +53,40 @@ esh-proc-test/sigpipe-exits-process
    (eshell-wait-for-subprocess t)
    (should (eq (process-list) nil))))
 
+(ert-deftest esh-proc-test/pipeline-connection-type/no-pipeline ()
+  "Test that all streams are PTYs when a command is not in a pipeline."
+  (skip-unless (executable-find "sh"))
+  (should (equal (eshell-test-command-result esh-proc-test--detect-pty-cmd)
+                 ;; PTYs aren't supported on MS-Windows.
+                 (unless (eq system-type 'windows-nt)
+                   "stdin\nstdout\nstderr\n"))))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/first ()
+  "Test that only stdin is a PTY when a command starts a pipeline."
+  (skip-unless (and (executable-find "sh")
+                    (executable-find "cat")))
+  (should (equal (eshell-test-command-result
+                  (concat esh-proc-test--detect-pty-cmd " | cat"))
+                 (unless (eq system-type 'windows-nt)
+                   "stdin\n"))))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/middle ()
+  "Test that all streams are pipes when a command is in the middle of a
+pipeline."
+  (skip-unless (and (executable-find "sh")
+                    (executable-find "cat")))
+  (should (equal (eshell-test-command-result
+                  (concat "echo | " esh-proc-test--detect-pty-cmd " | cat"))
+                 nil)))
+
+(ert-deftest esh-proc-test/pipeline-connection-type/last ()
+  "Test that only output streams are PTYs when a command ends a pipeline."
+  (skip-unless (executable-find "sh"))
+  (should (equal (eshell-test-command-result
+                  (concat "echo | " esh-proc-test--detect-pty-cmd))
+                 (unless (eq system-type 'windows-nt)
+                   "stdout\nstderr\n"))))
+
 (ert-deftest esh-proc-test/kill-pipeline ()
   "Test that killing a pipeline of processes only emits a single
 prompt.  See bug#54136."
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index f1ed7e18d5..41320672a0 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -38,10 +38,11 @@
 ;; Timeout in seconds; the test fails if the timeout is reached.
 (defvar process-test-sentinel-wait-timeout 2.0)
 
-;; Start a process that exits immediately.  Call WAIT-FUNCTION,
-;; possibly multiple times, to wait for the process to complete.
-(defun process-test-sentinel-wait-function-working-p (wait-function)
-  (let ((proc (start-process "test" nil "bash" "-c" "exit 20"))
+(defun process-test-wait-for-sentinel (proc exit-status &optional wait-function)
+  "Set a sentinel on PROC and wait for it to be called with EXIT-STATUS.
+Call WAIT-FUNCTION, possibly multiple times, to wait for the
+process to complete."
+  (let ((wait-function (or wait-function #'accept-process-output))
 	(sentinel-called nil)
 	(start-time (float-time)))
     (set-process-sentinel proc (lambda (_proc _msg)
@@ -50,21 +51,22 @@ process-test-sentinel-wait-function-working-p
 		    (> (- (float-time) start-time)
 		       process-test-sentinel-wait-timeout)))
       (funcall wait-function))
-    (cl-assert (eq (process-status proc) 'exit))
-    (cl-assert (= (process-exit-status proc) 20))
-    sentinel-called))
+    (should sentinel-called)
+    (should (eq (process-status proc) 'exit))
+    (should (= (process-exit-status proc) exit-status))))
 
 (ert-deftest process-test-sentinel-accept-process-output ()
   (skip-unless (executable-find "bash"))
   (with-timeout (60 (ert-fail "Test timed out"))
-  (should (process-test-sentinel-wait-function-working-p
-           #'accept-process-output))))
+    (let ((proc (start-process "test" nil "bash" "-c" "exit 20")))
+      (should (process-test-wait-for-sentinel proc 20)))))
 
 (ert-deftest process-test-sentinel-sit-for ()
   (skip-unless (executable-find "bash"))
   (with-timeout (60 (ert-fail "Test timed out"))
-  (should
-   (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t))))))
+    (let ((proc (start-process "test" nil "bash" "-c" "exit 20")))
+      (should (process-test-wait-for-sentinel
+               proc 20 (lambda () (sit-for 0.01 t)))))))
 
 (when (eq system-type 'windows-nt)
   (ert-deftest process-test-quoted-batfile ()
@@ -97,17 +99,8 @@ process-test-stderr-buffer
 						    "echo hello stderr! >&2; "
 						    "exit 20"))
 			     :buffer stdout-buffer
-			     :stderr stderr-buffer))
-	 (sentinel-called nil)
-	 (start-time (float-time)))
-    (set-process-sentinel proc (lambda (_proc _msg)
-				 (setq sentinel-called t)))
-    (while (not (or sentinel-called
-		    (> (- (float-time) start-time)
-		       process-test-sentinel-wait-timeout)))
-      (accept-process-output))
-    (cl-assert (eq (process-status proc) 'exit))
-    (cl-assert (= (process-exit-status proc) 20))
+			     :stderr stderr-buffer)))
+    (process-test-wait-for-sentinel proc 20)
     (should (with-current-buffer stdout-buffer
 	      (goto-char (point-min))
 	      (looking-at "hello stdout!")))
@@ -118,8 +111,7 @@ process-test-stderr-buffer
 (ert-deftest process-test-stderr-filter ()
   (skip-unless (executable-find "bash"))
   (with-timeout (60 (ert-fail "Test timed out"))
-  (let* ((sentinel-called nil)
-	 (stderr-sentinel-called nil)
+  (let* ((stderr-sentinel-called nil)
 	 (stdout-output nil)
 	 (stderr-output nil)
 	 (stdout-buffer (generate-new-buffer "*stdout*"))
@@ -131,23 +123,14 @@ process-test-stderr-filter
 					    (concat "echo hello stdout!; "
 						    "echo hello stderr! >&2; "
 						    "exit 20"))
-			     :stderr stderr-proc))
-	 (start-time (float-time)))
+			     :stderr stderr-proc)))
     (set-process-filter proc (lambda (_proc input)
 			       (push input stdout-output)))
-    (set-process-sentinel proc (lambda (_proc _msg)
-				 (setq sentinel-called t)))
     (set-process-filter stderr-proc (lambda (_proc input)
 				      (push input stderr-output)))
     (set-process-sentinel stderr-proc (lambda (_proc _input)
 					(setq stderr-sentinel-called t)))
-    (while (not (or sentinel-called
-		    (> (- (float-time) start-time)
-		       process-test-sentinel-wait-timeout)))
-      (accept-process-output))
-    (cl-assert (eq (process-status proc) 'exit))
-    (cl-assert (= (process-exit-status proc) 20))
-    (should sentinel-called)
+    (process-test-wait-for-sentinel proc 20)
     (should (equal 1 (with-current-buffer stdout-buffer
 		       (point-max))))
     (should (equal "hello stdout!\n"
@@ -289,6 +272,74 @@ make-process-w32-debug-spawn-error
                   (error :got-error))))
     (should have-called-debugger))))
 
+(defun make-process/test-connection-type (ttys &rest args)
+  "Make a process and check whether its standard streams match TTYS.
+This calls `make-process', passing ARGS to adjust how the process
+is created.  TTYS should be a list of 3 boolean values,
+indicating whether the subprocess's stdin, stdout, and stderr
+should be a TTY, respectively."
+  (declare (indent 1))
+  (let* (;; MS-Windows doesn't support communicating via pty.
+         (ttys (if (eq system-type 'windows-nt) '(nil nil nil) ttys))
+         (expected-output (concat (and (nth 0 ttys) "stdin\n")
+                                  (and (nth 1 ttys) "stdout\n")
+                                  (and (nth 2 ttys) "stderr\n")))
+         (stdout-buffer (generate-new-buffer "*stdout*"))
+         (proc (apply
+                #'make-process
+                :name "test"
+                :command (list "sh" "-c"
+                               (concat "if [ -t 0 ]; then echo stdin; fi; "
+                                       "if [ -t 1 ]; then echo stdout; fi; "
+                                       "if [ -t 2 ]; then echo stderr; fi"))
+                :buffer stdout-buffer
+                args)))
+    (process-test-wait-for-sentinel proc 0)
+    (should (equal (with-current-buffer stdout-buffer (buffer-string))
+                   expected-output))))
+
+(ert-deftest make-process/connection-type/pty ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(t t t)
+    :connection-type 'pty))
+
+(ert-deftest make-process/connection-type/pty-2 ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(t t t)
+    :connection-type '(pty . pty)))
+
+(ert-deftest make-process/connection-type/pipe ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(nil nil nil)
+    :connection-type 'pipe))
+
+(ert-deftest make-process/connection-type/pipe-2 ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(nil nil nil)
+    :connection-type '(pipe . pipe)))
+
+(ert-deftest make-process/connection-type/in-pty ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(t nil nil)
+    :connection-type '(pty . pipe)))
+
+(ert-deftest make-process/connection-type/out-pty ()
+  (skip-unless (executable-find "sh"))
+  (make-process/test-connection-type '(nil t t)
+    :connection-type '(pipe . pty)))
+
+(ert-deftest make-process/connection-type/pty-with-stderr-buffer ()
+  (skip-unless (executable-find "sh"))
+  (let ((stderr-buffer (generate-new-buffer "*stderr*")))
+    (make-process/test-connection-type '(t t nil)
+      :connection-type 'pty :stderr stderr-buffer)))
+
+(ert-deftest make-process/connection-type/out-pty-with-stderr-buffer ()
+  (skip-unless (executable-find "sh"))
+  (let ((stderr-buffer (generate-new-buffer "*stderr*")))
+    (make-process/test-connection-type '(nil t nil)
+      :connection-type '(pipe . pty) :stderr stderr-buffer)))
+
 (ert-deftest make-process/file-handler/found ()
   "Check that the `:file-handler’ argument of `make-process’
 works as expected if a file name handler is found."
-- 
2.25.1


[-- Attachment #3: 0002-Add-STREAM-argument-to-process-tty-name.patch --]
[-- Type: text/plain, Size: 7521 bytes --]

From 186be9c581e052f365dc219a5e2e0245f5434348 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Tue, 19 Jul 2022 21:36:54 -0700
Subject: [PATCH 2/2] Add STREAM argument to 'process-tty-name'

* src/process.c (process-tty-name): Add STREAM argument.

* lisp/eshell/esh-io.el (eshell-close-target): Only call
'process-send-eof' once if the process's stdin is a pipe.

* test/src/process-tests.el (make-process/test-connection-type): Check
behavior of 'process-tty-name'.

* doc/lispref/processes.texi (Process Information): Document the new
argument.

* etc/NEWS: Announce this change.
---
 doc/lispref/processes.texi | 17 +++++++++++------
 etc/NEWS                   |  5 ++++-
 lisp/eshell/esh-io.el      | 27 +++++++++++++++------------
 src/process.c              | 23 +++++++++++++++++++----
 test/src/process-tests.el  |  3 +++
 5 files changed, 52 insertions(+), 23 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index a7e08054c7..bbca48e6c5 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1243,15 +1243,20 @@ Process Information
 whether the connection was closed normally or abnormally.
 @end defun
 
-@defun process-tty-name process
+@defun process-tty-name process &optional stream
 This function returns the terminal name that @var{process} is using for
 its communication with Emacs---or @code{nil} if it is using pipes
 instead of a pty (see @code{process-connection-type} in
-@ref{Asynchronous Processes}).  If @var{process} represents a program
-running on a remote host, the terminal name used by that program on
-the remote host is provided as process property @code{remote-tty}.  If
-@var{process} represents a network, serial, or pipe connection, the
-value is @code{nil}.
+@ref{Asynchronous Processes}).  If @var{stream} is one of @code{stdin},
+@code{stdout}, or @code{stderr}, this function returns the terminal
+name (or @code{nil}, as above) that @var{process} uses for that stream
+specifically.  You can use this to determine whether a particular
+stream uses a pipe or a pty.
+
+If @var{process} represents a program running on a remote host, the
+terminal name used by that program on the remote host is provided as
+process property @code{remote-tty}.  If @var{process} represents a
+network, serial, or pipe connection, the value is @code{nil}.
 @end defun
 
 @defun process-coding-system process
diff --git a/etc/NEWS b/etc/NEWS
index dc79f0826a..23777d349e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3198,7 +3198,10 @@ invocation.  Such shells are POSIX conformant by default.
 ** 'make-process' can set connection type independently for input and output.
 When calling 'make-process', communication via pty can be enabled
 selectively for just input or output by passing a cons cell for
-':connection-type', e.g. '(pipe . pty)'.
+':connection-type', e.g. '(pipe . pty)'.  When examining a process
+later, you can determine whether a particular stream for a process
+uses a pty by passing one of 'stdin', 'stdout', or 'stderr' as the
+second argument to 'process-tty-name'.
 
 +++
 ** 'signal-process' now consults the list 'signal-process-functions'.
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index c035890ddf..68e52a2c9c 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -276,18 +276,21 @@ eshell-close-target
    ;; If we're redirecting to a process (via a pipe, or process
    ;; redirection), send it EOF so that it knows we're finished.
    ((eshell-processp target)
-    ;; According to POSIX.1-2017, section 11.1.9, sending EOF causes
-    ;; all bytes waiting to be read to be sent to the process
-    ;; immediately.  Thus, if there are any bytes waiting, we need to
-    ;; send EOF twice: once to flush the buffer, and a second time to
-    ;; cause the next read() to return a size of 0, indicating
-    ;; end-of-file to the reading process.  However, some platforms
-    ;; (e.g. Solaris) actually require sending a *third* EOF.  Since
-    ;; sending extra EOFs while the process is running shouldn't break
-    ;; anything, we'll just send the maximum we'd ever need.  See
-    ;; bug#56025 for further details.
-    (let ((i 0))
-      (while (and (<= (cl-incf i) 3)
+    ;; According to POSIX.1-2017, section 11.1.9, when communicating
+    ;; via terminal, sending EOF causes all bytes waiting to be read
+    ;; to be sent to the process immediately.  Thus, if there are any
+    ;; bytes waiting, we need to send EOF twice: once to flush the
+    ;; buffer, and a second time to cause the next read() to return a
+    ;; size of 0, indicating end-of-file to the reading process.
+    ;; However, some platforms (e.g. Solaris) actually require sending
+    ;; a *third* EOF.  Since sending extra EOFs while the process is
+    ;; running are a no-op, we'll just send the maximum we'd ever
+    ;; need.  See bug#56025 for further details.
+    (let ((i 0)
+          ;; Only call `process-send-eof' once if communicating via a
+          ;; pipe (in truth, this just closes the pipe).
+          (max-attempts (if (process-tty-name target 'stdin) 3 1)))
+      (while (and (<= (cl-incf i) max-attempts)
                   (eq (process-status target) 'run))
         (process-send-eof target))))
 
diff --git a/src/process.c b/src/process.c
index da5e9cb182..adc508156f 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1243,14 +1243,29 @@ DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
   return XPROCESS (process)->command;
 }
 
-DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
+DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 2, 0,
        doc: /* Return the name of the terminal PROCESS uses, or nil if none.
 This is the terminal that the process itself reads and writes on,
-not the name of the pty that Emacs uses to talk with that terminal.  */)
-  (register Lisp_Object process)
+not the name of the pty that Emacs uses to talk with that terminal.
+
+If STREAM is one of `stdin', `stdout', or `stderr', return the name of
+the terminal PROCESS uses for that stream.  This can be used to detect
+whether a particular stream is connected via a pipe or a pty.  */)
+  (register Lisp_Object process, Lisp_Object stream)
 {
   CHECK_PROCESS (process);
-  return XPROCESS (process)->tty_name;
+  register struct Lisp_Process *p = XPROCESS (process);
+
+  if (NILP (stream))
+    return p->tty_name;
+  else if (EQ (stream, Qstdin))
+    return p->pty_in ? p->tty_name : Qnil;
+  else if (EQ (stream, Qstdout))
+    return p->pty_out ? p->tty_name : Qnil;
+  else if (EQ (stream, Qstderr))
+    return p->pty_out && NILP (p->stderrproc) ? p->tty_name : Qnil;
+  else
+    signal_error ("Unknown stream", stream);
 }
 
 static void
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 41320672a0..6ba5930ee6 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -294,6 +294,9 @@ make-process/test-connection-type
                                        "if [ -t 2 ]; then echo stderr; fi"))
                 :buffer stdout-buffer
                 args)))
+    (should (eq (and (process-tty-name proc 'stdin) t) (nth 0 ttys)))
+    (should (eq (and (process-tty-name proc 'stdout) t) (nth 1 ttys)))
+    (should (eq (and (process-tty-name proc 'stderr) t) (nth 2 ttys)))
     (process-test-wait-for-sentinel proc 0)
     (should (equal (with-current-buffer stdout-buffer (buffer-string))
                    expected-output))))
-- 
2.25.1


  reply	other threads:[~2022-07-24  5:29 UTC|newest]

Thread overview: 64+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-06-16 18:30 bug#56025: 29.0.50; em-extpipe-test-2 times out on EMBA and Cygwin Ken Brown
2022-06-16 19:30 ` Sean Whitton
2022-06-16 22:01   ` Ken Brown
2022-06-17 13:39     ` Ken Brown
2022-06-18  0:57       ` Sean Whitton
2022-06-18  2:07         ` Ken Brown
2022-06-18  2:35           ` Ken Brown
2022-06-18  3:50           ` Jim Porter
2022-06-18 17:52             ` Ken Brown
2022-06-18 19:02               ` Jim Porter
2022-06-18 20:51                 ` Ken Brown
2022-06-18 22:00                   ` Jim Porter
2022-06-18 23:46                     ` Sean Whitton
2022-06-19 16:02                     ` Ken Brown
2022-06-24  1:18                       ` Ken Brown
2022-06-24  4:40                         ` Sean Whitton
2022-06-24  6:07                         ` Eli Zaretskii
2022-06-24 16:53                           ` Jim Porter
2022-06-24 22:23                             ` Sean Whitton
2022-06-24 23:03                               ` Jim Porter
2022-06-25  5:34                                 ` Eli Zaretskii
2022-06-25 16:13                                   ` Jim Porter
2022-06-25 16:53                                     ` Eli Zaretskii
2022-06-26 16:27                                       ` Lars Ingebrigtsen
2022-06-26 17:12                                 ` Sean Whitton
2022-06-26 17:22                                   ` Jim Porter
2022-06-26 21:11                                     ` Sean Whitton
2022-06-27 13:25                                       ` Ken Brown
2022-06-27 15:51                                         ` Michael Albinus
2022-06-27 16:22                                           ` Ken Brown
2022-06-27 19:13                                             ` bug#56025: [EXT]Re: " Sean Whitton
2022-06-27 21:17                                               ` Ken Brown
2022-06-27 19:18                                         ` Jim Porter
2022-06-27 21:19                                           ` Ken Brown
2022-07-01  3:52                                             ` Jim Porter
2022-07-01  3:58                                               ` Jim Porter
2022-07-06 22:33                                               ` Ken Brown
2022-07-07  4:35                                                 ` Jim Porter
2022-07-07  4:42                                                   ` Jim Porter
2022-07-07 12:42                                                     ` Ken Brown
2022-07-17  2:35                                                       ` bug#56025: [WIP PATCH] " Jim Porter
2022-07-17  6:03                                                         ` Eli Zaretskii
2022-07-17 17:44                                                           ` Jim Porter
2022-07-17 18:26                                                             ` Eli Zaretskii
2022-07-17 18:51                                                               ` Jim Porter
2022-07-18  8:09                                                             ` Michael Albinus
2022-07-19  1:58                                                               ` Jim Porter
2022-07-19  7:59                                                                 ` Michael Albinus
2022-07-17 21:59                                                         ` Ken Brown
2022-07-18  5:26                                                           ` Jim Porter
2022-07-22  4:16                                                             ` bug#56025: [PATCH v2] " Jim Porter
2022-07-22 19:00                                                               ` Ken Brown
2022-07-24  4:05                                                                 ` Jim Porter
2022-07-24  5:19                                                                   ` bug#56025: [PATCH v3] " Jim Porter
2022-07-24  5:29                                                                     ` Jim Porter [this message]
2022-07-24  9:08                                                                       ` bug#56025: [PATCH v4] " Lars Ingebrigtsen
2022-07-24  9:48                                                                         ` Eli Zaretskii
2022-07-24 21:04                                                                         ` Ken Brown
2022-07-24  9:47                                                                       ` Eli Zaretskii
2022-07-24 17:36                                                                         ` bug#56025: [PATCH v5] " Jim Porter
2022-07-24 20:30                                                                           ` Ken Brown
2022-07-31  1:01                                                                             ` Jim Porter
2022-08-06  1:10                                                                               ` Jim Porter
2022-08-06 12:17                                                                                 ` Lars Ingebrigtsen

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=7056ea9f-a55d-28b7-52cf-caca7a9053a5@gmail.com \
    --to=jporterbugs@gmail.com \
    --cc=56025@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    --cc=kbrown@cornell.edu \
    --cc=larsi@gnus.org \
    --cc=spwhitton@email.arizona.edu \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).