From f55ea05bdf60e24c09f9064fc0d2e8a114d6e358 Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Tue, 7 Apr 2015 17:42:09 +0900 Subject: [PATCH] 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'. --- doc/lispref/processes.texi | 52 ++++++ etc/NEWS | 4 + lisp/subr.el | 6 +- src/process.c | 296 ++++++++++++++++++++++++++++++-- src/process.h | 3 + src/w32.c | 20 +++ src/w32.h | 1 + test/automated/process-tests.el | 70 ++++++++ 8 files changed, 434 insertions(+), 18 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 3e9cc50de52..f228921137c 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index 80c664fc0ce..8ee6db66a56 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/subr.el b/lisp/subr.el index 00acdb6541f..3b536f2e7d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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 diff --git a/src/process.c b/src/process.c index 2800fa58340..fbc634be49c 100644 --- a/src/process.c +++ b/src/process.c @@ -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); diff --git a/src/process.h b/src/process.h index 36979dcac9e..e889055dc23 100644 --- a/src/process.h +++ b/src/process.h @@ -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. */ diff --git a/src/w32.c b/src/w32.c index 6f16704909c..8721ed919fc 100644 --- a/src/w32.c +++ b/src/w32.c @@ -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 diff --git a/src/w32.h b/src/w32.h index 9b3521d077f..e62b93c8e2b 100644 --- a/src/w32.h +++ b/src/w32.h @@ -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 **); diff --git a/test/automated/process-tests.el b/test/automated/process-tests.el index dabfbc56b78..1dab615bed0 100644 --- a/test/automated/process-tests.el +++ b/test/automated/process-tests.el @@ -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) + (should (equal 1 (with-current-buffer stdout-buffer + (point-max)))) + (should (equal "hello stdout!\n" + (mapconcat #'identity (nreverse stdout-output) ""))) + (should stderr-sentinel-called) + (should (equal 1 (with-current-buffer stderr-buffer + (point-max)))) + (should (equal "hello stderr!\n" + (mapconcat #'identity (nreverse stderr-output) ""))))) + (provide 'process-tests) -- 2.39.2