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}.
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
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
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
"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)
(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.
(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)))
(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)))
(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)))
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)
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;
/* 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;
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;
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
#endif
}
#if defined (LDISC1)
- if (pty_flag && std_in >= 0)
+ if (pty_in && std_in >= 0)
{
struct termios t;
tcgetattr (std_in, &t);
}
#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;
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);
}
/* Stop blocking SIGCHLD in the child. */
unblock_child_signal (oldset);
- if (pty_flag)
+ if (pty_out)
child_setup_tty (std_out);
#endif
#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);
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.
: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
CHECK_TYPE (NILP (tem), Qnull, tem);
tem = plist_get (contact, QCconnection_type);
- if (EQ (tem, Qpty))
- XPROCESS (proc)->pty_flag = true;
- else if (EQ (tem, Qpipe))
- XPROCESS (proc)->pty_flag = false;
- else if (NILP (tem))
- XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+ if (CONSP (tem))
+ {
+ XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem));
+ XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem));
+ }
else
- report_file_error ("Unknown connection type", tem);
-
- if (!NILP (stderrproc))
{
- pset_stderrproc (XPROCESS (proc), stderrproc);
-
- XPROCESS (proc)->pty_flag = false;
+ XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
+ is_pty_from_symbol (tem);
}
+ if (!NILP (stderrproc))
+ pset_stderrproc (XPROCESS (proc), stderrproc);
+
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
verify (GNUTLS_STAGE_EMPTY == 0);
create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
struct Lisp_Process *p = XPROCESS (process);
- int inchannel, outchannel;
+ int inchannel = -1, outchannel = -1;
pid_t pid = -1;
int vfork_errno;
int forkin, forkout, forkerr = -1;
- bool pty_flag = 0;
+ bool pty_in = false, pty_out = false;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
+ int ptychannel = -1, pty_tty = -1;
sigset_t oldset;
/* Ensure that the SIGCHLD handler can notify
`wait_reading_process_output'. */
child_signal_init ();
- inchannel = outchannel = -1;
-
- if (p->pty_flag)
- outchannel = inchannel = allocate_pty (pty_name);
+ if (p->pty_in || p->pty_out)
+ ptychannel = allocate_pty (pty_name);
- if (inchannel >= 0)
+ if (ptychannel >= 0)
{
- p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
- forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
- if (forkin < 0)
+ pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
+ if (pty_tty < 0)
report_file_error ("Opening pty", Qnil);
- p->open_fd[SUBPROCESS_STDIN] = forkin;
-#else
- forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
- pty_flag = 1;
+ pty_in = p->pty_in;
+ pty_out = p->pty_out;
lisp_pty_name = build_string (pty_name);
}
+
+ /* Set up stdin for the child process. */
+ if (ptychannel >= 0 && p->pty_in)
+ {
+ p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
+ outchannel = ptychannel;
+ }
else
{
- if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
- || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+ if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
report_file_error ("Creating pipe", Qnil);
forkin = p->open_fd[SUBPROCESS_STDIN];
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+ }
+
+ /* Set up stdout for the child process. */
+ if (ptychannel >= 0 && p->pty_out)
+ {
+ forkout = pty_tty;
+ p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
+ }
+ else
+ {
+ if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+ report_file_error ("Creating pipe", Qnil);
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
forkout = p->open_fd[SUBPROCESS_STDOUT];
#if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
#endif
+ }
- if (!NILP (p->stderrproc))
- {
- struct Lisp_Process *pp = XPROCESS (p->stderrproc);
+ if (!NILP (p->stderrproc))
+ {
+ struct Lisp_Process *pp = XPROCESS (p->stderrproc);
- forkerr = pp->open_fd[SUBPROCESS_STDOUT];
+ forkerr = pp->open_fd[SUBPROCESS_STDOUT];
- /* Close unnecessary file descriptors. */
- close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
- close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
- }
+ /* Close unnecessary file descriptors. */
+ close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
+ close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
}
if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
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)
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));
{
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)
{
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);
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))
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))
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. */
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))
{
/* 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;
(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")
(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."
;; 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)
(> (- (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 ()
"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!")))
(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*"))
(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"
(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."
projects / emacs.git / commitdiff