1.0.48.15: fix null broadcast-streams as RUN-PROGRAM output streams
authorNikodemus Siivola <nikodemus@random-state.net>
Thu, 12 May 2011 17:07:01 +0000 (17:07 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Thu, 12 May 2011 17:07:01 +0000 (17:07 +0000)
  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
tests/run-program.impure.lisp
version.lisp-expr

index e85e2cc..0f31a0f 100644 (file)
@@ -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)))))
index c04337a..e62eb95 100644 (file)
       (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.
 
 (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!"
index 50dfbdf..78f6210 100644 (file)
@@ -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"