Commit f55ea05b authored by Daiki Ueno's avatar Daiki Ueno Committed by Daiki Ueno

Add facility to collect stderr of async subprocess

* src/w32.h (register_aux_fd): New function declaration.
* src/w32.c (register_aux_fd): New function.
* src/process.h (struct Lisp_Process): New member stderrproc.
* src/process.c (PIPECONN_P): New macro.
(PIPECONN1_P): New macro.
(Fdelete_process, Fprocess_status, Fset_process_buffer)
(Fset_process_filter, Fset_process_sentinel, Fstop_process)
(Fcontinue_process): Handle pipe process specially.
(create_process): Respect p->stderrproc.
(Fmake_pipe_process): New function.
(Fmake_process): Add new keyword argument :stderr.
(wait_reading_process_output): Specially handle a pipe process when
it gets an EOF.
(syms_of_process): Register Qpipe and Smake_pipe_process.

* doc/lispref/processes.texi (Asynchronous Processes): Document
`make-pipe-process' and `:stderr' keyword of `make-process'.

* lisp/subr.el (start-process): Suggest to use `make-process' handle
standard error separately.

* test/automated/process-tests.el (process-test-stderr-buffer)
(process-test-stderr-filter): New tests.

* etc/NEWS: Mention new process type `pipe' and its usage with the
`:stderr' keyword of `make-process'.
parent a2940cd4
......@@ -739,6 +739,58 @@ If @var{stopped} is non-@code{nil}, start the process in the
@item :filter @var{filter}
Initialize the process filter to @var{filter}.
@item :sentinel @var{sentinel}
Initialize the process sentinel to @var{sentinel}.
@item :stderr @var{stderr}
Associate @var{stderr} with the standard error of the process.
@var{stderr} is either a buffer or a pipe process created with
@code{make-pipe-process}.
@end table
The original argument list, modified with the actual connection
information, is available via the @code{process-contact} function.
@end defun
@defun make-pipe-process &rest args
This function creates a bidirectional pipe which can be attached to a
child process (currently only useful with the @code{:stderr} keyword
of @code{make-process}).
The arguments @var{args} are a list of keyword/argument pairs.
Omitting a keyword is always equivalent to specifying it with value
@code{nil}, except for @code{:coding}.
Here are the meaningful keywords:
@table @asis
@item :name @var{name}
Use the string @var{name} as the process name. It is modified if
necessary to make it unique.
@item :buffer @var{buffer}
Use @var{buffer} as the process buffer.
@item :coding @var{coding}
If @var{coding} is a symbol, it specifies the coding system to be
used for both reading and writing of data from and to the
connection. If @var{coding} is a cons cell
@w{@code{(@var{decoding} . @var{encoding})}}, then @var{decoding}
will be used for reading and @var{encoding} for writing.
If @var{coding} is @code{nil}, the default rules for finding the
coding system will apply. @xref{Default Coding Systems}.
@item :noquery @var{query-flag}
Initialize the process query flag to @var{query-flag}.
@xref{Query Before Exit}.
@item :stop @var{stopped}
If @var{stopped} is non-@code{nil}, start the process in the
``stopped'' state.
@item :filter @var{filter}
Initialize the process filter to @var{filter}.
@item :sentinel @var{sentinel}
Initialize the process sentinel to @var{sentinel}.
@end table
......
......@@ -674,6 +674,10 @@ word syntax, use `\sw' instead.
* Lisp Changes in Emacs 25.1
** New process type `pipe', which can be used in combination with the
`:stderr' keyword of make-process to handle standard error output
of subprocess.
** New function `make-process' provides an alternative interface to
`start-process'. It allows programs to set process parameters such as
process filter, sentinel, etc., through keyword arguments (similar to
......
......@@ -1936,9 +1936,9 @@ PROGRAM is the program file name. It is searched for in `exec-path'
\(which see). If nil, just associate a pty with the buffer. Remaining
arguments are strings to give program as arguments.
If you want to separate standard output from standard error, invoke
the command through a shell and redirect one of them using the shell
syntax."
If you want to separate standard output from standard error, use
`make-process' or invoke the command through a shell and redirect
one of them using the shell syntax."
(unless (fboundp 'make-process)
(error "Emacs was compiled without subprocess support"))
(apply #'make-process
......
......@@ -189,6 +189,8 @@ process_socket (int domain, int type, int protocol)
#define NETCONN1_P(p) (EQ (p->type, Qnetwork))
#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
#define SERIALCONN1_P(p) (EQ (p->type, Qserial))
#define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
#define PIPECONN1_P(p) (EQ (p->type, Qpipe))
/* Number of events of change of status of a process. */
static EMACS_INT process_tick;
......@@ -411,6 +413,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
{
p->write_queue = val;
}
static void
pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
{
p->stderrproc = val;
}
static Lisp_Object
......@@ -837,7 +844,7 @@ nil, indicating the current buffer's process. */)
p = XPROCESS (process);
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
pset_status (p, list2 (Qexit, make_number (0)));
p->tick = ++process_tick;
......@@ -903,7 +910,7 @@ nil, indicating the current buffer's process. */)
status = p->status;
if (CONSP (status))
status = XCAR (status);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
......@@ -987,7 +994,7 @@ Return BUFFER. */)
CHECK_BUFFER (buffer);
p = XPROCESS (process);
pset_buffer (p, buffer);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
return buffer;
......@@ -1063,7 +1070,7 @@ The string argument is normally a multibyte string, except:
}
pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
return filter;
......@@ -1095,7 +1102,7 @@ It gets two arguments: the process, and a string describing the change. */)
sentinel = Qinternal_default_process_sentinel;
pset_sentinel (p, sentinel);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
return sentinel;
}
......@@ -1204,7 +1211,8 @@ list of keywords. */)
Fprocess_datagram_address (process));
#endif
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
|| EQ (key, Qt))
return contact;
if (NILP (key) && NETCONN_P (process))
return list2 (Fplist_get (contact, QChost),
......@@ -1212,6 +1220,11 @@ list of keywords. */)
if (NILP (key) && SERIALCONN_P (process))
return list2 (Fplist_get (contact, QCport),
Fplist_get (contact, QCspeed));
/* FIXME: Return a meaningful value (e.g. the child ends of pipe),
if pipe process is useful for other purposes than receiving
stderr. */
if (NILP (key) && PIPECONN_P (process))
return Qt;
return Fplist_get (contact, key);
}
......@@ -1386,10 +1399,15 @@ to use a pty, or nil to use the default specified through
: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'.
usage: (make-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
Lisp_Object xstderr, stderrproc;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1;
USE_SAFE_ALLOCA;
......@@ -1433,6 +1451,27 @@ usage: (make-process &rest ARGS) */)
if (!NILP (program))
CHECK_STRING (program);
stderrproc = Qnil;
xstderr = Fplist_get (contact, QCstderr);
if (PROCESSP (xstderr))
{
if (!PIPECONN_P (xstderr))
error ("Process is not a pipe process");
stderrproc = xstderr;
}
else if (!NILP (xstderr))
{
struct gcpro gcpro1, gcpro2;
CHECK_STRING (program);
GCPRO2 (buffer, current_dir);
stderrproc = CALLN (Fmake_pipe_process,
QCname,
concat2 (name, build_string (" stderr")),
QCbuffer,
Fget_buffer_create (xstderr));
UNGCPRO;
}
proc = make_process (name);
/* If an error occurs and we can't start the process, we want to
remove it from the process list. This means that each error
......@@ -1463,6 +1502,13 @@ usage: (make-process &rest ARGS) */)
else
report_file_error ("Unknown connection type", tem);
if (!NILP (stderrproc))
{
pset_stderrproc (XPROCESS (proc), stderrproc);
XPROCESS (proc)->pty_flag = false;
}
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
......@@ -1705,10 +1751,10 @@ 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, outchannel, errchannel = -1;
pid_t pid;
int vfork_errno;
int forkin, forkout;
int forkin, forkout, forkerr = -1;
bool pty_flag = 0;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
......@@ -1746,6 +1792,18 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
forkout = p->open_fd[SUBPROCESS_STDOUT];
if (!NILP (p->stderrproc))
{
struct Lisp_Process *pp = XPROCESS (p->stderrproc);
forkerr = pp->open_fd[SUBPROCESS_STDOUT];
errchannel = pp->open_fd[READ_FROM_SUBPROCESS];
/* Close unnecessary file descriptors. */
close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
}
}
#ifndef WINDOWSNT
......@@ -1792,6 +1850,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
char **volatile new_argv_volatile = new_argv;
int volatile forkin_volatile = forkin;
int volatile forkout_volatile = forkout;
int volatile forkerr_volatile = forkerr;
struct Lisp_Process *p_volatile = p;
pid = vfork ();
......@@ -1801,6 +1860,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
new_argv = new_argv_volatile;
forkin = forkin_volatile;
forkout = forkout_volatile;
forkerr = forkerr_volatile;
p = p_volatile;
pty_flag = p->pty_flag;
......@@ -1811,6 +1871,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
int xforkin = forkin;
int xforkout = forkout;
int xforkerr = forkerr;
/* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
......@@ -1910,10 +1971,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
if (pty_flag)
child_setup_tty (xforkout);
if (xforkerr < 0)
xforkerr = xforkout;
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
pid = child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir);
#else /* not WINDOWSNT */
child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
}
......@@ -1958,6 +2022,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
}
#endif
if (!NILP (p->stderrproc))
{
struct Lisp_Process *pp = XPROCESS (p->stderrproc);
close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
}
}
}
......@@ -2016,6 +2085,187 @@ create_pty (Lisp_Object process)
p->pid = -2;
}
DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
0, MANY, 0,
doc: /* Create and return a bidirectional pipe process.
In Emacs, pipes are represented by process objects, so input and
output work as for subprocesses, and `delete-process' closes a pipe.
However, a pipe process has no process id, it cannot be signaled,
and the status codes are different from normal processes.
Arguments are specified as keyword/argument pairs. The following
arguments are defined:
:name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
with the process. Process output goes at the end of that buffer,
unless you specify an output stream or filter function to handle the
output. If BUFFER is not given, the value of NAME is used.
:coding CODING -- If CODING is a symbol, it specifies the coding
system used for both reading and writing for this process. If CODING
is a cons (DECODING . ENCODING), DECODING is used for reading, and
ENCODING is used for writing.
:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
the process is running. If BOOL is not given, query before exiting.
:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
In the stopped state, a pipe process does not accept incoming data,
but you can send outgoing data. The stopped state is cleared by
`continue-process' and set by `stop-process'.
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
usage: (make-pipe-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object proc, contact;
struct Lisp_Process *p;
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
ptrdiff_t specpdl_count;
int inchannel, outchannel;
if (nargs == 0)
return Qnil;
contact = Flist (nargs, args);
GCPRO1 (contact);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
|| emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
report_file_error ("Creating pipe", Qnil);
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
#ifdef WINDOWSNT
register_aux_fd (inchannel);
#endif
/* Record this as an active process, with its channels. */
chan_process[inchannel] = proc;
p->infd = inchannel;
p->outfd = outchannel;
if (inchannel > max_process_desc)
max_process_desc = inchannel;
buffer = Fplist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer);
pset_buffer (p, buffer);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_type (p, Qpipe);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
pset_log (p, Qnil);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
eassert (! p->pty_flag);
if (!EQ (p->command, Qt))
{
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
}
#ifdef ADAPTIVE_READ_BUFFERING
p->adaptive_read_buffering
= (NILP (Vprocess_adaptive_read_buffering) ? 0
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
#endif
/* Make the process marker point into the process buffer (if any). */
if (BUFFERP (buffer))
set_marker_both (p->mark, buffer,
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
{
/* Setup coding systems for communicating with the network stream. */
struct gcpro gcpro1;
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val;
tem = Fplist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
{
val = tem;
if (CONSP (val))
val = XCAR (val);
}
else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
/* We dare not decode end-of-line format by setting VAL to
Qraw_text, because the existing Emacs Lisp libraries
assume that they receive bare code including a sequence of
CR LF. */
val = Qnil;
else
{
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
else
val = Qnil;
}
pset_decode_coding_system (p, val);
if (!NILP (tem))
{
val = tem;
if (CONSP (val))
val = XCDR (val);
}
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
val = Qnil;
else
{
if (CONSP (coding_systems))
val = XCDR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
else
val = Qnil;
}
pset_encode_coding_system (p, val);
}
/* This may signal an error. */
setup_process_coding_systems (proc);
specpdl_ptr = specpdl + specpdl_count;
UNGCPRO;
return proc;
}
/* Convert an internal struct sockaddr to a lisp object (vector or string).
The address family of sa is not included in the result. */
......@@ -4884,7 +5134,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
available now and a closed pipe.
With luck, a closed pipe will be accompanied by
subprocess termination and SIGCHLD. */
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
&& !PIPECONN_P (proc))
;
#endif
#ifdef HAVE_PTYS
......@@ -4916,8 +5167,18 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
#endif /* HAVE_PTYS */
/* If we can detect process termination, don't consider the
process gone just because its pipe is closed. */
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
&& !PIPECONN_P (proc))
;
else if (nread == 0 && PIPECONN_P (proc))
{
/* Preserve status of processes already terminated. */
XPROCESS (proc)->tick = ++process_tick;
deactivate_process (proc);
if (EQ (XPROCESS (proc)->status, Qrun))
pset_status (XPROCESS (proc),
list2 (Qexit, make_number (0)));
}
else
{
/* Preserve status of processes already terminated. */
......@@ -5954,7 +6215,8 @@ If PROCESS is a network or serial process, inhibit handling of incoming
traffic. */)
(Lisp_Object process, Lisp_Object current_group)
{
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
|| PIPECONN_P (process)))
{
struct Lisp_Process *p;
......@@ -5983,7 +6245,8 @@ If PROCESS is a network or serial process, resume handling of incoming
traffic. */)
(Lisp_Object process, Lisp_Object current_group)
{
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
|| PIPECONN_P (process)))
{
struct Lisp_Process *p;
......@@ -7030,7 +7293,7 @@ kill_buffer_processes (Lisp_Object buffer)
FOR_EACH_PROCESS (tail, proc)
if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
{
if (NETCONN_P (proc) || SERIALCONN_P (proc))
if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
Fdelete_process (proc);
else if (XPROCESS (proc)->infd >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
......@@ -7330,6 +7593,7 @@ syms_of_process (void)
DEFSYM (Qreal, "real");
DEFSYM (Qnetwork, "network");
DEFSYM (Qserial, "serial");
DEFSYM (Qpipe, "pipe");
DEFSYM (QCbuffer, ":buffer");
DEFSYM (QChost, ":host");
DEFSYM (QCservice, ":service");
......@@ -7346,6 +7610,7 @@ syms_of_process (void)
DEFSYM (QCplist, ":plist");
DEFSYM (QCcommand, ":command");
DEFSYM (QCconnection_type, ":connection-type");
DEFSYM (QCstderr, ":stderr");
DEFSYM (Qpty, "pty");
DEFSYM (Qpipe, "pipe");
......@@ -7451,6 +7716,7 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Sset_process_plist);
defsubr (&Sprocess_list);
defsubr (&Smake_process);
defsubr (&Smake_pipe_process);
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
defsubr (&Sset_network_process_option);
......
......@@ -105,6 +105,9 @@ struct Lisp_Process
Lisp_Object gnutls_cred_type;
#endif
/* Pipe process attached to the standard error of this process. */
Lisp_Object stderrproc;
/* After this point, there are no Lisp_Objects any more. */
/* alloc.c assumes that `pid' is the first such non-Lisp slot. */
......
......@@ -9473,6 +9473,26 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
pset_childp (p, childp2);
}
/* For make-pipe-process */
void
register_aux_fd (int infd)
{
child_process *cp;
cp = new_child ();
if (!cp)
error ("Could not create child process");
cp->fd = infd;
cp->status = STATUS_READ_ACKNOWLEDGED;
if (fd_info[ infd ].cp != NULL)
{
error ("fd_info[fd = %d] is already in use", infd);
}
fd_info[ infd ].cp = cp;
fd_info[ infd ].hnd = (HANDLE) _get_osfhandle (infd);
}
#ifdef HAVE_GNUTLS
ssize_t
......
......@@ -202,6 +202,7 @@ extern int random (void);
extern int fchmod (int, mode_t);
extern int sys_rename_replace (char const *, char const *, BOOL);
extern int pipe2 (int *, int);
extern void register_aux_fd (int);
extern void set_process_dir (char *);
extern int sys_spawnve (int, char *, char **, char **);
......
......@@ -72,4 +72,74 @@
(should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n"))))
(when batfile (delete-file batfile))))))
(ert-deftest process-test-stderr-buffer ()
(skip-unless (executable-find "bash"))
(let* ((stdout-buffer (generate-new-buffer "*stdout*"))
(stderr-buffer (generate-new-buffer "*stderr*"))
(proc (make-process :name "test"
:command (list "bash" "-c"
(concat "echo hello stdout!; "
"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))
(should (with-current-buffer stdout-buffer
(goto-char (point-min))
(looking-at "hello stdout!")))
(should (with-current-buffer stderr-buffer
(goto-char (point-min))
(looking-at "hello stderr!")))))
(ert-deftest process-test-stderr-filter ()
(skip-unless (executable-find "bash"))
(let* ((sentinel-called nil)
(stderr-sentinel-called nil)
(stdout-output nil)
(stderr-output nil)
(stdout-buffer (generate-new-buffer "*stdout*"))
(stderr-buffer (generate-new-buffer "*stderr*"))
(stderr-proc (make-pipe-process :name "stderr"
:buffer stderr-buffer))
(proc (make-process :name "test" :buffer stdout-buffer
:command (list "bash" "-c"
(concat "echo hello stdout!; "
"echo hello stderr! >&2; "
"exit 20"))
:stderr stderr-proc))
(start-time (float-time)))
(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)