From 6bc7c19167d7bf98ff6cdf45e4ccd9998311bdd8 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 12 May 2011 17:07:01 +0000 Subject: [PATCH] 1.0.48.15: fix null broadcast-streams as RUN-PROGRAM output streams Regression from 1.0.48.4. Since they have element-type T, COPY-DESCRIPTOR-TO-STREAM complains about them -- but it's more efficient to special-case them to the null device anyways. Also add a missing error message about unknown element types for input streams. ...and fix numbering of RUN-PROGRAM-CAT-* tests. --- src/code/run-program.lisp | 9 +++++++-- tests/run-program.impure.lisp | 15 ++++++++++++++- version.lisp-expr | 2 +- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index e85e2cc..0f31a0f 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -938,7 +938,9 @@ Users Manual for details about the PROCESS structure."#-win32" (cond ((eq object t) ;; No new descriptor is needed. (values -1 nil)) - ((eq object nil) + ((or (eq object nil) + (and (typep object 'broadcast-stream) + (not (broadcast-stream-streams object)))) ;; Use /dev/null. (multiple-value-bind (fd errno) @@ -1051,7 +1053,10 @@ Users Manual for details about the PROCESS structure."#-win32" (loop with buf = (make-array 256 :element-type '(unsigned-byte 8)) for p = (read-sequence buf object) until (zerop p) - do (sb-unix:unix-write fd buf 0 p)))) + do (sb-unix:unix-write fd buf 0 p))) + (t + (error "Don't know how to copy from stream of element-type ~S" + et))) (sb-unix:unix-lseek fd 0 sb-unix:l_set) (push fd *close-in-parent*) (return (values fd nil))))) diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index c04337a..e62eb95 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -110,6 +110,19 @@ (assert (= 0 (read-sequence (make-array 8) out))) (assert (equalp buf data))))) +(with-test (:name :run-program-cat-4) + ;; Null broadcast stream as output + (let* ((process (sb-ext:run-program "/bin/cat" '() :wait nil + :output (make-broadcast-stream) + :input :stream)) + (in (process-input process))) + (unwind-protect + (progn + (write-string "foobar" in) + (close in) + (process-wait process)) + (process-close process)))) + ;;; Test driving an external program (cat) through pipes wrapped in ;;; composite streams. @@ -132,7 +145,7 @@ (defparameter *cat-out-pipe* (make-pipe)) (defparameter *cat-out* (make-synonym-stream '*cat-out-pipe*)) -(with-test (:name :run-program-cat-2) +(with-test (:name :run-program-cat-5) (let ((cat (run-program "/bin/cat" nil :input *cat-in* :output *cat-out* :wait nil))) (dolist (test '("This is a test!" diff --git a/version.lisp-expr b/version.lisp-expr index 50dfbdf..78f6210 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.48.14" +"1.0.48.15" -- 1.7.10.4