From: Richard M Kreuter <kreuter@users.sourceforge.net>
Date: Thu, 31 Jan 2008 19:29:24 +0000 (+0000)
Subject: 1.0.14.9: Fix regression in RUN-PROGRAM when :INPUT et al. are pathnames.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0e5d338cec4e90475ea88f6892c24c62a07ae579;p=sbcl.git

1.0.14.9: Fix regression in RUN-PROGRAM when :INPUT et al. are pathnames.

* GET-DESCRIPTOR-FOR is defined with &rest, &key, and
  &allow-other-keys, and one pathway passes the &rest list to OPEN.  A
  recent addition of a keyword argument to GET-DESCRIPTOR-FOR that
  OPEN didn't recognize created a problem.

* Add test for the correct behavior.
---

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 22fcfdb..df3e173 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -976,7 +976,11 @@ Users Manual for details about the PROCESS structure."#-win32"
                 (error "Direction must be either :INPUT or :OUTPUT, not ~S."
                        direction)))))
           ((or (pathnamep object) (stringp object))
-           (with-open-stream (file (apply #'open object keys))
+           ;; GET-DESCRIPTOR-FOR uses &allow-other-keys, so rather
+           ;; than munge the &rest list for OPEN, just disable keyword
+           ;; validation there.
+           (with-open-stream (file (apply #'open object :allow-other-keys t
+                                          keys))
              (multiple-value-bind
                    (fd errno)
                  (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 644bc2b..0200e14 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -106,3 +106,17 @@
        (with-open-file (f *tmpfile*)
          (assert (equal "baz" (read-line f)))))
   (delete-file *tmpfile*))
+
+;; Around 1.0.12 there was a regression when :INPUT or :OUTPUT was a
+;; pathname designator.  Since these use the same code, it should
+;; suffice to test just :INPUT.
+(let ((file))
+  (unwind-protect
+       (progn (with-open-file (f "run-program-test.tmp" :direction :output)
+                (setf file (truename f))
+                (write-line "Foo" f))
+                  (assert (run-program "cat" ()
+                                       :input file :output t
+                                       :search t :wait t)))
+    (when file
+      (delete-file file))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 497066b..23b050c 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.14.8"
+"1.0.14.9"