procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow creating processes where only one of stdin or stdout is a PTY

Browse source 
* 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 (bug#56025).
This commit is contained in:
Jim Porter 2022-07-17 20:25:00 -07:00
parent b70369c557
commit d7b89ea407
12 changed files with 288 additions and 160 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
doc/lispref/processes.texi
View file

@ -705,12 +705,13 @@ coding system will apply. @xref{Default Coding Systems}.
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 @@ a buffer, which is called the associated buffer of the process
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

12
etc/NEWS
View file

@ -2332,6 +2332,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
@ -3323,6 +3329,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

55
lisp/eshell/esh-proc.el
View file

@ -250,30 +250,6 @@ The prompt will be set to PROMPT."
"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 @@ See `eshell-needs-pipe'."
(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.

5
lisp/net/tramp-adb.el
View file

@ -877,7 +877,10 @@ implementation will be used."
(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)))

5
lisp/net/tramp-sh.el
View file

@ -2842,7 +2842,10 @@ implementation will be used."
(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)))

5
lisp/net/tramp.el
View file

@ -4708,7 +4708,10 @@ substitution. SPEC-LIST is a list of char/value pairs used for
(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)))

37
src/callproc.c
View file

@ -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

3
src/lisp.h
View file

@ -4943,7 +4943,8 @@ extern void setup_process_coding_systems (Lisp_Object);
#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);

129
src/process.c
View file

@ -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 @@ signals to stop and continue a process.
: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,21 +1861,19 @@ usage: (make-process &rest ARGS) */)
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);
{
XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
is_pty_from_symbol (tem);
}
if (!NILP (stderrproc))
{
pset_stderrproc (XPROCESS (proc), stderrproc);
XPROCESS (proc)->pty_flag = false;
}
pset_stderrproc (XPROCESS (proc), stderrproc);
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
@ -2099,66 +2113,80 @@ static void
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_in || p->pty_out)
ptychannel = allocate_pty (pty_name);
if (p->pty_flag)
outchannel = inchannel = 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 @@ usage: (make-pipe-process &rest ARGS) */)
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 @@ usage: (make-serial-process &rest ARGS) */)
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))
@ -6808,7 +6839,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. */
@ -7177,7 +7208,7 @@ process has been transmitted to the serial port. */)
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))
{

5
src/process.h
View file

@ -156,8 +156,9 @@ struct Lisp_Process
/* 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;

43
test/lisp/eshell/esh-proc-tests.el
View file

@ -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 @@
(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."

121
test/src/process-tests.el
View file

@ -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 @@
(> (- (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 @@
"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 @@
(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 @@
(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 @@
(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."