From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 15 Jun 2009 11:05:41 +0000 (+0000)
Subject: 1.0.29.8: :PTY and stream arguments in RUN-PROGRAM
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9573c214e46195145d4fabf98799b163e356a935;p=sbcl.git

1.0.29.8: :PTY and stream arguments in RUN-PROGRAM

 * Reported by Elliot Slaughter, patch by Stas Boukarev.
---

diff --git a/NEWS b/NEWS
index 9218928..529fca2 100644
--- a/NEWS
+++ b/NEWS
@@ -13,7 +13,10 @@
     from lists (eg. ADJOIN) are compiled with both :TEST and :TEST-NOT.
     (reported by Tobias Rittweiler)
   * bug fix: regression in DIRECTORY from 1.0.28.61, pattern matching of
-    directory components now works again.
+    directory components now works again. (reported by Michael Becker and
+    Gabriel Dos Reis)
+  * bug fix: :PTY option in RUN-PROGRAM was broken with stream arguments.
+    (reported by Elliot Slaughter, thanks to Stas Boukarev)
 
 changes in sbcl-1.0.29 relative to 1.0.28:
   * IMPORTANT: bug database has moved from the BUGS file to Launchpad
diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index dbb16cc..1b9b310 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -440,7 +440,7 @@ status slot."
             (error "could not find a pty"))))))
 
 #-win32
-(defun open-pty (pty cookie)
+(defun open-pty (pty cookie &key (external-format :default))
   (when pty
     (multiple-value-bind
           (master slave name)
@@ -452,7 +452,7 @@ status slot."
           (unless new-fd
             (error "couldn't SB-UNIX:UNIX-DUP ~W: ~A" master (strerror errno)))
           (push new-fd *close-on-error*)
-          (copy-descriptor-to-stream new-fd pty cookie)))
+          (copy-descriptor-to-stream new-fd pty cookie external-format)))
       (values name
               (sb-sys:make-fd-stream master :input t :output t
                                      :element-type :default
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 9ef07e5..01100ba 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -135,3 +135,14 @@
               (sb-ext:run-program "/bin/echo" '
                                   ("It would be nice if this didn't crash.")
                                   :wait nil :output nil)))))
+
+(with-test (:name (:run-program :pty-stream))
+  (assert (equal "OK"
+                 (subseq
+                  (with-output-to-string (s)
+                    (assert (= 42 (process-exit-code
+                                   (run-program "/bin/sh" '("-c" "echo OK; exit 42") :wait t
+                                                :pty s))))
+                    s)
+                  0
+                  2))))
diff --git a/version.lisp-expr b/version.lisp-expr
index be30965..c247df6 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,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.29.7"
+"1.0.29.8"