- (or
- ;; If we can get an fd for the stream and the
- ;; stream's external format is the default, let the
- ;; child process use the fd for its descriptor.
- ;; Otherwise, we copy data from the stream into a
- ;; temp file, and give the temp file's descriptor to
- ;; the child.
- (multiple-value-bind (fd stream format)
- (get-stream-fd-and-external-format object :input)
- (when (and fd format
- (eq (find-external-format
- *default-external-format*)
- (find-external-format format)))
- (values fd stream)))
- (let ((fd (make-temp-fd))
- (newline (string #\Newline)))
- (loop
- (multiple-value-bind
- (line no-cr)
- (read-line object nil nil)
- (unless line
- (return))
- (let ((vector
- (string-to-octets
- line :external-format external-format)))
- (sb-unix:unix-write
- fd vector 0 (length vector)))
- (if no-cr
- (return)
- (sb-unix:unix-write fd newline 0 1))))
- (sb-unix:unix-lseek fd 0 sb-unix:l_set)
- (push fd *close-in-parent*)
- (values fd nil))))
+ (block nil
+ ;; If we can get an fd for the stream, let the child
+ ;; process use the fd for its descriptor. Otherwise,
+ ;; we copy data from the stream into a temp file, and
+ ;; give the temp file's descriptor to the
+ ;; child.
+ (multiple-value-bind (fd stream format)
+ (get-stream-fd-and-external-format object :input)
+ (declare (ignore format))
+ (when fd
+ (return (values fd stream))))
+ ;; FIXME: if we can't get the file descriptor, since
+ ;; the stream might be interactive or otherwise
+ ;; block-y, we can't know whether we can copy the
+ ;; stream's data to a temp file, so if RUN-PROGRAM was
+ ;; called with :WAIT NIL, we should probably error.
+ ;; However, STRING-STREAMs aren't fd-streams, but
+ ;; they're not prone to blocking; any user-defined
+ ;; streams that "read" from some in-memory data will
+ ;; probably be similar to STRING-STREAMs. So maybe we
+ ;; should add a STREAM-INTERACTIVE-P generic function
+ ;; for problems like this? Anyway, the machinery is
+ ;; here, if you feel like filling in the details.
+ #|
+ (when (and (null wait) #<some undetermined criterion>)
+ (error "~@<don't know how to get an fd for ~A, and so ~
+ can't ensure that copying its data to the ~
+ child process won't hang~:>" object))
+ |#
+ (let ((fd (make-temp-fd))
+ (newline (string #\Newline)))
+ (loop
+ (multiple-value-bind
+ (line no-cr)
+ (read-line object nil nil)
+ (unless line
+ (return))
+ (let ((vector (string-to-octets line)))
+ (sb-unix:unix-write
+ fd vector 0 (length vector)))
+ (if no-cr
+ (return)
+ (sb-unix:unix-write fd newline 0 1))))
+ (sb-unix:unix-lseek fd 0 sb-unix:l_set)
+ (push fd *close-in-parent*)
+ (return (values fd nil)))))