mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 22:12:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

spawn-subprocess: on error signal condition

Browse source
This commit is contained in:
Daniel Kochmański 2017-02-21 08:36:24 +01:00
parent a3d68f9847
commit 5e2679e5fc
2 changed files with 16 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/c/unixsys.d
View file

@ -403,10 +403,6 @@ si_run_program_inner(cl_object command, cl_object argv, cl_object environ) {
parent_write = ecl_fixnum(ecl_nth_value(the_env, 1));
parent_read = ecl_fixnum(ecl_nth_value(the_env, 2));
if (Null(pid) || (parent_write <= 0) || (parent_read <= 0)) {
FEerror("Could not spawn subprocess to run ~S.", 1, command);
}
stream_write = ecl_make_stream_from_fd(command, parent_write,
ecl_smm_output, 8,
ECL_STREAM_DEFAULT_FORMAT,
@ -587,6 +583,17 @@ si_spawn_subprocess(cl_object command, cl_object argv, cl_object environ,
@(return ECL_NIL);
}
#endif
if (Null(pid)) {
if (parent_write) close(parent_write);
if (parent_read) close(parent_read);
if (parent_error) close(parent_error);
parent_write = 0;
parent_read = 0;
parent_error = 0;
FEerror("Could not spawn subprocess to run ~S.", 1, command);
}
@(return pid
ecl_make_fixnum(parent_write)
ecl_make_fixnum(parent_read)

17
src/lsp/process.lsp
View file

@ -187,15 +187,11 @@
(process (make-external-process)))
(with-active-processes-lock (push process *active-processes*))
(multiple-value-bind (pid parent-write parent-read parent-error)
(si:spawn-subprocess progname args environ input output error)
(unless pid
(unless (zerop parent-write) (ff-close parent-write))
(unless (zerop parent-read) (ff-close parent-read))
(unless (zerop parent-error) (ff-close parent-error))
(with-active-processes-lock
(setf *active-processes* (delete process *active-processes*)))
(error "Could not spawn subprocess to run ~S." progname))
(handler-case (si:spawn-subprocess progname args environ input output error)
(t (c)
(with-active-processes-lock
(setf *active-processes* (delete process *active-processes*)))
(signal c)))
(let ((stream-write
(when (< 0 parent-write)
(make-output-stream-from-fd progname parent-write external-format)))
@ -263,6 +259,3 @@
(defun null-stream ()
(ffi:c-inline () () :object "cl_core.null_stream" :one-liner t :side-effects nil))
(ffi:defentry ff-close (:int) (:int "close") :no-interrupts t)