[PATCH] Add facility to collect stderr of async subprocess

[Daiki Ueno <ueno@gnu.org>]

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

Eli Zaretskii <eliz@gnu.org> writes:

>> In any case, supporting stderr could be a starting point, as it seems to
>> be a long-standing request:
>> https://lists.gnu.org/archive/html/emacs-devel/2004-04/msg01051.html
>> and it wouldn't involve a portability issue.
>
> Redirecting the child's stderr is already supported on Windows, so
> this is only a matter of having the higher layers DTRT.

So, let's start with small (but common) things.  The attached patch adds
a new keyword `:stderr' to `make-process'.  The argument can be either a
buffer or a (newly introduced) pipe process.

One could write:

  (make-process :name "test"
                :buffer (current-buffer)
                :command (list (expand-file-name "./test.sh"))
                :stderr "stderr")

to collect the stderr output in the "stderr" buffer, or could write:

  (let ((stderr (make-pipe-process :name "stderr")))
    (make-process :name "test"
                  :buffer (current-buffer)
                  :command (list (expand-file-name "./test.sh"))
                  :stderr stderr)
    (set-process-filter stderr ...))

to collect the stderr output with a process filter.

The patch should apply after the make-process patch:

> From 206196c18652601920017b3a30316ac4205b42dd Mon Sep 17 00:00:00 2001
> From: Daiki Ueno <ueno@gnu.org>
> Date: Mon, 16 Mar 2015 11:38:05 +0900
> Subject: [PATCH] Generalize start-process with keyword args

Comments appreciated.  To be honest, a new process type to collect
stderr might be overkill, but it would make it possible for the current
process I/O functions to support further file descriptors / handles.

Regards,
-- 
Daiki Ueno

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-facility-to-collect-stderr-of-async-subprocess.patch --]
[-- Type: text/x-patch, Size: 30077 bytes --]

From 2319faa7a9853b562c2296030de70188aee75f8b Mon Sep 17 00:00:00 2001
From: Daiki Ueno <ueno@gnu.org>
Date: Mon, 9 Mar 2015 09:50:32 +0900
Subject: [PATCH] Add facility to collect stderr of async subprocess

* src/lisp.h (emacs_pipe2): New function declaration.
* src/sysdep.c (emacs_pipe2): New function.
(emacs_pipe): Define as a wrapper around emacs_pipe2.
* src/process.h (struct Lisp_Process): New member stderr.
* 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 Vprocess_pipe_list and
Vprocess_standard_error.
(Fmake_pipe_process): New function.
(Fmake_process): Add new keyword argument :stderr.
(deactivate_process): Call Fdelete_process on associated pipe
process.
(wait_reading_process_output): Don't consider a pipe process has
gone when the read end is closed.
(syms_of_process): Register Qpipe and Smake_pipe_process.

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

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

* etc/NEWS: Mention pipe process.
---
 doc/lispref/ChangeLog           |   5 +
 doc/lispref/processes.texi      |  54 +++++++
 etc/ChangeLog                   |   4 +
 etc/NEWS                        |   4 +
 src/ChangeLog                   |  22 +++
 src/lisp.h                      |   1 +
 src/process.c                   | 303 +++++++++++++++++++++++++++++++++++++---
 src/process.h                   |   3 +
 src/sysdep.c                    |  14 +-
 test/ChangeLog                  |   5 +
 test/automated/process-tests.el |  65 +++++++++
 11 files changed, 455 insertions(+), 25 deletions(-)

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 06d4630..777d386 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-17  Daiki Ueno  <ueno@gnu.org>
+
+	* processes.texi (Asynchronous Processes): Mention
+	`make-pipe-process' and `:stderr' keyword of `make-process'.
+
 2015-03-16  Daiki Ueno  <ueno@gnu.org>
 
 	* processes.texi (Asynchronous Processes): Mention `make-process'.
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 337669d..27ed697 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -743,6 +743,60 @@ 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 (typically through 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 coding system chosen for decoding
+output is @code{undecided}, meaning deduce the encoding from the
+actual data.
+@xref{Output from Processes}.
+
+@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
 
 The original argument list, modified with the actual connection
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 5d5a47f..d9a3006 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,5 +1,9 @@
 2015-03-18  Daiki Ueno  <ueno@gnu.org>
 
+	* NEWS: Mention pipe process.
+
+2015-03-18  Daiki Ueno  <ueno@gnu.org>
+
 	* NEWS: Mention `make-process'.
 
 2015-03-03  Kelvin White  <kwhite@gnu.org>
diff --git a/etc/NEWS b/etc/NEWS
index 8cfc238..da19b3f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -623,6 +623,10 @@ word syntax, use `\sw' instead.
 \f
 * Lisp Changes in Emacs 25.1
 
+** New process type `pipe', which can be used in combination with the
+   `:stderr' keyword of make-process to collect standard error output
+   of subprocess.
+
 ** New function make-process provides a generalized Lisp interface to
    subprocess creation.
 
diff --git a/src/ChangeLog b/src/ChangeLog
index 8f9a5ee..421e3c5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,27 @@
 2015-03-17  Daiki Ueno  <ueno@gnu.org>
 
+	Add facility to collect stderr of async subprocess
+	* lisp.h (emacs_pipe2): New function declaration.
+	* sysdep.c (emacs_pipe2): New function.
+	(emacs_pipe): Define as a wrapper around emacs_pipe2.
+	* process.h (struct Lisp_Process): New member stderr.
+	* 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 Vprocess_pipe_list and
+	Vprocess_standard_error.
+	(Fmake_pipe_process): New function.
+	(Fmake_process): Add new keyword argument :stderr.
+	(deactivate_process): Call Fdelete_process on associated pipe
+	process.
+	(wait_reading_process_output): Don't consider a pipe process has
+	gone when the read end is closed.
+	(syms_of_process): Register Qpipe and Smake_pipe_process.
+
+2015-03-17  Daiki Ueno  <ueno@gnu.org>
+
 	* process.c (Fmake_process): New function.
 	(create_process, create_pty): Check p->pty_flag instead of
 	Vprocess_connection_type.
diff --git a/src/lisp.h b/src/lisp.h
index b730619..2e161da 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4378,6 +4378,7 @@ extern void emacs_backtrace (int);
 extern _Noreturn void emacs_abort (void) NO_INLINE;
 extern int emacs_open (const char *, int, int);
 extern int emacs_pipe (int[2]);
+extern int emacs_pipe2 (int[2], int);
 extern int emacs_close (int);
 extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
 extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
diff --git a/src/process.c b/src/process.c
index 6068540..9596ccd 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;
@@ -420,6 +422,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
 {
   p->write_queue = val;
 }
+static void
+pset_stderr (struct Lisp_Process *p, Lisp_Object val)
+{
+  p->stderr = val;
+}
 
 \f
 static Lisp_Object
@@ -846,7 +853,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;
@@ -912,7 +919,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;
@@ -996,7 +1003,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;
@@ -1072,7 +1079,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;
@@ -1104,7 +1111,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;
 }
@@ -1192,13 +1199,13 @@ DEFUN ("process-query-on-exit-flag",
 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
        1, 2, 0,
        doc: /* Return the contact info of PROCESS; t for a real child.
-For a network or serial connection, the value depends on the optional
-KEY arg.  If KEY is nil, value is a cons cell of the form (HOST
-SERVICE) for a network connection or (PORT SPEED) for a serial
-connection.  If KEY is t, the complete contact information for the
-connection is returned, else the specific value for the keyword KEY is
-returned.  See `make-network-process' or `make-serial-process' for a
-list of keywords.  */)
+For a network or serial connection, or a pipe, the value depends on
+the optional KEY arg.  If KEY is nil, value is a cons cell of the form
+\(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
+connection, or (INPUT OUTPUT) for a pipe.  If KEY is t, the complete
+contact information for the connection is returned, else the specific
+value for the keyword KEY is returned.  See `make-network-process' or
+`make-serial-process' for a list of keywords.  */)
   (register Lisp_Object process, Lisp_Object key)
 {
   Lisp_Object contact;
@@ -1395,10 +1402,14 @@ 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.
+
 usage: (make-process &rest ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
+  Lisp_Object stderr_proc;
   unsigned char **new_argv;
   ptrdiff_t new_argc;
   ptrdiff_t i;
@@ -1442,6 +1453,27 @@ usage: (make-process &rest ARGS)  */)
   if (!NILP (program))
     CHECK_STRING (program);
 
+  stderr_proc = Fplist_get (contact, QCstderr);
+  if (!NILP (stderr_proc))
+    {
+      if (PROCESSP (stderr_proc))
+	{
+	  if (!PIPECONN_P (stderr_proc))
+	    error ("Process is not a pipe process");
+	}
+      else
+	{
+	  struct gcpro gcpro1, gcpro2;
+	  GCPRO2 (buffer, current_dir);
+	  stderr_proc = CALLN (Fmake_pipe_process,
+			       QCname,
+			       concat2 (name, build_string (" stderr")),
+			       QCbuffer,
+			       Fget_buffer_create (stderr_proc));
+	  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
@@ -1475,6 +1507,12 @@ usage: (make-process &rest ARGS)  */)
   else
     XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
 
+  if (!NILP (stderr_proc))
+    {
+      pset_stderr (XPROCESS (proc), stderr_proc);
+      XPROCESS (proc)->pty_flag = 0;
+    }
+
 #ifdef HAVE_GNUTLS
   /* AKA GNUTLS_INITSTAGE(proc).  */
   XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
@@ -1719,16 +1757,16 @@ 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;
   pid_t pid;
   int vfork_errno;
-  int forkin, forkout;
+  int forkin, forkout, forkerr;
   bool pty_flag = 0;
   char pty_name[PTY_NAME_SIZE];
   Lisp_Object lisp_pty_name = Qnil;
   sigset_t oldset;
 
-  inchannel = outchannel = -1;
+  inchannel = outchannel = errchannel = -1;
 
   if (p->pty_flag)
     outchannel = inchannel = allocate_pty (pty_name);
@@ -1748,6 +1786,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
 #else
       forkin = forkout = -1;
 #endif /* not USG, or USG_SUBTTY_WORKS */
+      forkerr = -1;
       pty_flag = 1;
       lisp_pty_name = build_string (pty_name);
     }
@@ -1760,6 +1799,23 @@ 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->stderr))
+	{
+	  struct Lisp_Process *pp = XPROCESS (p->stderr);
+
+	  forkerr = pp->open_fd[SUBPROCESS_STDOUT];
+	  errchannel = pp->open_fd[READ_FROM_SUBPROCESS];
+
+	  /* FORKERR will be redirected in child_setup.  */
+	  fcntl (forkerr, F_SETFD, FD_CLOEXEC);
+
+	  /* Close unnecessary file descriptors.  */
+	  close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
+	  close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
+	}
+      else
+	forkerr = -1;
     }
 
 #ifndef WINDOWSNT
@@ -1805,6 +1861,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 ();
@@ -1814,6 +1871,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;
@@ -1824,6 +1882,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
@@ -1923,10 +1982,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 */
     }
 
@@ -1971,6 +2033,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->stderr))
+	{
+	  struct Lisp_Process *pp = XPROCESS (p->stderr);
+	  close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
+	}
     }
 }
 
@@ -2029,6 +2096,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_pipe2 (p->open_fd + SUBPROCESS_STDIN, O_BINARY) != 0
+      || emacs_pipe2 (p->open_fd + READ_FROM_SUBPROCESS, O_BINARY) != 0)
+    report_file_error ("Creating pipe", Qnil);
+  outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+  inchannel = p->open_fd[READ_FROM_SUBPROCESS];
+
+  /* Child doesn't need inchannel/outchannel after exec.  */
+  fcntl (inchannel, F_SETFD, FD_CLOEXEC);
+  fcntl (outchannel, F_SETFD, FD_CLOEXEC);
+
+  fcntl (inchannel, F_SETFL, O_NONBLOCK);
+  fcntl (outchannel, F_SETFL, O_NONBLOCK);
+
+  /* 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;
+}
+
 \f
 /* Convert an internal struct sockaddr to a lisp object (vector or string).
    The address family of sa is not included in the result.  */
@@ -3946,6 +4194,7 @@ deactivate_process (Lisp_Object proc)
   int inchannel;
   struct Lisp_Process *p = XPROCESS (proc);
   int i;
+  Lisp_Object tem;
 
 #ifdef HAVE_GNUTLS
   /* Delete GnuTLS structures in PROC, if any.  */
@@ -4004,6 +4253,9 @@ deactivate_process (Lisp_Object proc)
 	  max_process_desc = i;
 	}
     }
+
+  if (!NILP (p->stderr))
+    Fdelete_process (p->stderr);
 }
 
 \f
@@ -4897,7 +5149,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
@@ -4929,7 +5182,8 @@ 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
 		{
@@ -5964,7 +6218,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;
 
@@ -5993,7 +6248,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;
 
@@ -7040,7 +7296,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);
@@ -7340,6 +7596,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");
@@ -7356,6 +7613,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");
 
@@ -7461,6 +7719,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 36979dc..92d7b64 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 standard error.  */
+    Lisp_Object stderr;
+
     /* 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/sysdep.c b/src/sysdep.c
index 0a0b0ac..2fe4624 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2257,19 +2257,27 @@ emacs_fopen (char const *file, char const *mode)
 /* Create a pipe for Emacs use.  */
 
 int
-emacs_pipe (int fd[2])
+emacs_pipe2 (int fd[2], int flags)
 {
 #ifdef MSDOS
   return pipe (fd);
 #else  /* !MSDOS */
-  int result = pipe2 (fd, O_BINARY | O_CLOEXEC);
+  return pipe2 (fd, flags);
+#endif	/* !MSDOS */
+}
+
+int
+emacs_pipe (int fd[2])
+{
+  int result = emacs_pipe2 (fd, O_BINARY | O_CLOEXEC);
+#ifndef MSDOS
   if (! O_CLOEXEC && result == 0)
     {
       fcntl (fd[0], F_SETFD, FD_CLOEXEC);
       fcntl (fd[1], F_SETFD, FD_CLOEXEC);
     }
-  return result;
 #endif	/* !MSDOS */
+  return result;
 }
 
 /* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
diff --git a/test/ChangeLog b/test/ChangeLog
index 6a474e1..0f61e24 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-18  Daiki Ueno  <ueno@gnu.org>
+
+	* automated/process-tests.el (process-test-stderr-buffer)
+	(process-test-stderr-filter): New tests.
+
 2015-03-10  Jackson Ray Hamilton  <jackson@jacksonrayhamilton.com>
 
 	* indent/js-indent-init-dynamic.js: Fix spelling error.
diff --git a/test/automated/process-tests.el b/test/automated/process-tests.el
index dabfbc5..3389387 100644
--- a/test/automated/process-tests.el
+++ b/test/automated/process-tests.el
@@ -72,4 +72,69 @@
               (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n"))))
         (when batfile (delete-file batfile))))))
 
+(ert-deftest process-test-stderr-buffer ()
+  (let* ((stdout-buffer (generate-new-buffer "*stdout*"))
+	 (stderr-buffer (generate-new-buffer "*stderr*"))
+	 (proc (make-process :name "test" :buffer stdout-buffer
+			     :command (list "bash" "-c"
+					    (concat "echo hello stdout!; "
+						    "echo hello stderr! >&2; "
+						    "exit 20"))
+			     :stderr stderr-buffer))
+	 (sentinel-called nil)
+	 (start-time (float-time)))
+    (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 ()
+  (let* ((sentinel-called nil)
+	 (stderr-sentinel-called nil)
+	 (stdout-input nil)
+	 (stderr-input 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-input)))
+    (set-process-sentinel proc (lambda (proc msg)
+				 (setq sentinel-called t)))
+    (set-process-filter stderr-proc (lambda (proc input)
+				      (push input stderr-input)))
+    (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-input) "")))
+    (should stderr-sentinel-called)
+    (should (equal 1 (with-current-buffer stderr-buffer
+		       (point-max))))
+    (should (equal "hello stderr!\n"
+		   (mapconcat #'identity (nreverse stderr-input) "")))))
+
 (provide 'process-tests)
-- 
2.1.0