From 625c9493a8a7b5186144d21302437cf4f4f3571c Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Fri, 13 Apr 2012 16:09:27 +0400
Subject: [PATCH] run-program: proper handling of :if-input-does-not-exist
 NIL.

:output existing-file :if-output-exists NIL and
:input non-existing-file :if-input-does-not-exist NIL signalled errors
instead of just returning NIL as specified.

Fixes lp#968836
---
 NEWS                          |    7 +++++--
 src/code/run-program.lisp     |   21 ++++++++++++---------
 tests/run-program.impure.lisp |    7 +++++++
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/NEWS b/NEWS
index 141efbd..509ca7c 100644
--- a/NEWS
+++ b/NEWS
@@ -11,10 +11,13 @@ changes relative to sbcl-1.0.56:
     classoid even if X was not the proper name of the class. (lp#941102)
   * bug fix: declaration leakage between lexical environments due to careless
     use of NCONC in MAKE-LEXENV. (lp#924276)
-  * bug fix: ENSURE-DIRECTORIES-EXIST now works when *default-pathname-defaults*
-    contains NAME or TYPE components.
+  * bug fix: ENSURE-DIRECTORIES-EXIST now works when
+    *default-pathname-defaults* contains NAME or TYPE components.
   * bug fix: PPRINT couldn't print improper lists with CARs being some symbols
     from CL package, e.g. (loop . 10).
+  * bug fix: run-program with existent or non-existent files for :output or
+    :input when :if-output-exists or :if-input-does-not-exist are NIL properly
+    returns NIL instead of signalling an obscure error.
   * documentation:
     ** improved docstrings: REPLACE (lp#965592)
 
diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index b854e31..05c6333 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -729,6 +729,8 @@ Users Manual for details about the PROCESS structure."#-win32"
                                       ;; hard-coded symbols here.
                                       (values stdout output-stream)
                                       (get-descriptor-for ,@args))))
+                           (unless ,fd
+                             (return-from run-program))
                            ,@body))
                       (with-open-pty (((pty-name pty-stream) (pty cookie))
                                       &body body)
@@ -1010,15 +1012,16 @@ Users Manual for details about the PROCESS structure."#-win32"
            ;; 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))
-               (cond (fd
-                      (push fd *close-in-parent*)
-                      (values fd nil))
-                     (t
-                      (error "couldn't duplicate file descriptor: ~A"
-                             (strerror errno)))))))
+             (when file
+               (multiple-value-bind
+                     (fd errno)
+                   (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
+                 (cond (fd
+                        (push fd *close-in-parent*)
+                        (values fd nil))
+                       (t
+                        (error "couldn't duplicate file descriptor: ~A"
+                               (strerror errno))))))))
           ((streamp object)
            (ecase direction
              (:input
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 76972d3..8a4b3a3 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -306,3 +306,10 @@
                       (progn (run-program "run-program.impure.lisp" '()) nil)
                     (error (e)
                       (princ-to-string e))))))
+
+(with-test (:name (:run-program :if-input-does-not-exist))
+  (let ((file (pathname (sb-posix:mktemp "rpXXXXXX"))))
+    (assert (null (sb-ext:run-program "/bin/cat" '() :input file)))
+    (assert (null (sb-ext:run-program "/bin/cat" '() :output #.(or *compile-file-truename*
+                                                                   *load-truename*)
+                                      :if-output-exists nil)))))
-- 
1.7.10.4