From 24483f02706121adcd33cd614feb1409aaa3be86 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Tue, 1 Oct 2013 17:53:16 -0400
Subject: [PATCH] Fall back to %use-system where :error-output :output isn't
 supported (ABCL, CLISP). Fix missing quote for stderr on allegro.

---
 test/test-run-program.script |  1 -
 uiop/run-program.lisp        | 85 ++++++++++++++++++++----------------
 uiop/stream.lisp             |  2 +-
 3 files changed, 48 insertions(+), 40 deletions(-)

diff --git a/test/test-run-program.script b/test/test-run-program.script
index 6ec9935f..55c76895 100644
--- a/test/test-run-program.script
+++ b/test/test-run-program.script
@@ -37,7 +37,6 @@
     (run-program "cat ; echo bar  baz >&2 ; exit 42"
                  :input '("foo") :output :string :error-output '(:string :stripped t)
                  :ignore-error-status t)))
-  #-abcl
   (assert-equal
    '(("foo" "bar" "baz" "quux") nil 0)
    (multiple-value-list
diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index 58fde1cd..37f20116 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -363,7 +363,7 @@ for the implementation's underlying run-program function"
     "Determines whether a run-program I/O specifier requires Lisp-side processing
 via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
 or whether it's already taken care of by the implementation's underlying run-program."
-    (not (typep specifier '(or null string pathname (eql :interactive)
+    (not (typep specifier '(or null string pathname (member :interactive :output)
                             #+(or cmu sbcl scl) stream
                             #+lispworks file-stream)))) ;; not a type!? comm:socket-stream
 
@@ -442,7 +442,7 @@ It returns a process-info plist with possible keys:
                         (multiple-value-list
                          (apply f :input %input :output %output
                                   :allow-other-keys t `(,@args ,@keys)))))
-                 (assert (eq error-output :interactive))
+                 (assert (eq %error-output :terminal))
                  ;;; since we now always return a code, we can't use this code path, anyway!
                  (etypecase %command
                    #+os-windows (string (run 'ext:run-shell-command %command))
@@ -580,7 +580,7 @@ It returns a process-info plist with possible keys:
     ;; GF is the generic function to call to handle arbitrary values of SPEC
     ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
     ;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
-    ;; DIRECTION is :INPUT or :OUTPUT for the direction of this io argument
+    ;; DIRECTION is :INPUT, :OUTPUT or :ERROR-OUTPUT for the direction of this io argument
     ;; FUN is a function of the new reduced spec and an activity function to call with a stream
     ;; when the subprocess is active and communicating through that stream.
     ;; ACTIVEP is a boolean true if we will get to run code while the process is running
@@ -588,36 +588,46 @@ It returns a process-info plist with possible keys:
     ;; RETURNER is a function called with the value of the activity.
     ;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
     (declare (ignorable stream-easy-p))
-    (when (eq spec t) (setf spec tval))
-    (labels ((activity (stream)
-               (call-function returner (call-stream-processor gf spec stream)))
-             (easy-case ()
-               (funcall fun spec nil))
-             (hard-case ()
-               (if activep
-                   (funcall fun :stream #'activity)
-                   (with-temporary-file (:pathname tmp :stream s
-                                         :direction (ecase direction (:input :output) (:output :io))
-                                         :element-type element-type
-                                         :external-format external-format)
-                     (ecase direction
-                       (:input ;; for input
-                        (unwind-protect (activity s)
-                          (ignore-errors (close s)))
-                        (funcall fun tmp nil))
-                       (:output ;; for output, error-output
-                        (unwind-protect
-                             (multiple-value-prog1 (funcall fun tmp nil)
-                               (activity s))
-                          (ignore-errors (close s)))))))))
-      (typecase spec
-        ((or null string pathname (eql :interactive))
-         (easy-case))
-        #+(or cmu sbcl scl) ;; streams are only easy on implementations that try very hard
-        (stream
-         (if stream-easy-p (easy-case) (hard-case)))
-        (t
-         (hard-case)))))
+    (let* ((actual-spec (if (eq spec t) tval spec))
+           (activity-spec (if (eq actual-spec :output)
+                              (ecase direction
+                                ((:input :output)
+                                 (error "~S not allowed as a ~S ~S spec"
+                                        :output 'run-program direction))
+                                ((:error-output)
+                                 nil))
+                              actual-spec)))
+      (labels ((activity (stream)
+                 (call-function returner (call-stream-processor gf activity-spec stream)))
+               (easy-case ()
+                 (funcall fun actual-spec nil))
+               (hard-case ()
+                 (if activep
+                     (funcall fun :stream #'activity)
+                     (with-temporary-file (:pathname tmp :stream s
+                                           :direction (ecase direction
+                                                        ((:input) :output)
+                                                        ((:output :error-output) :io))
+                                           :element-type element-type
+                                           :external-format external-format)
+                       (ecase direction
+                         (:input
+                          (unwind-protect (activity s)
+                            (ignore-errors (close s)))
+                          (funcall fun tmp nil))
+                         ((:output :error-output)
+                          (unwind-protect
+                               (multiple-value-prog1 (funcall fun tmp nil)
+                                 (activity s))
+                            (ignore-errors (close s)))))))))
+        (typecase activity-spec
+          ((or null string pathname (eql :interactive))
+           (easy-case))
+          #+(or cmu sbcl scl) ;; streams are only easy on implementations that try very hard
+          (stream
+           (if stream-easy-p (easy-case) (hard-case)))
+          (t
+           (hard-case))))))
 
   (defmacro place-setter (place)
     (when place
@@ -650,7 +660,7 @@ It returns a process-info plist with possible keys:
             #'(lambda (,reduced-error-output-var ,error-output-activity-var)
                 ,@(unless eoavp `((declare (ignore ,error-output-activity-var))))
                 ,@body)
-            :output ,error-output-form ,active (place-setter ,setf) ,keys))
+            :error-output ,error-output-form ,active (place-setter ,setf) ,keys))
 
   (defun %use-run-program (command &rest keys
                            &key input output error-output ignore-error-status &allow-other-keys)
@@ -659,8 +669,7 @@ It returns a process-info plist with possible keys:
     (assert (not (member :stream (list input output error-output))))
     (let* ((active-input-p (%active-io-specifier-p input))
            (active-output-p (%active-io-specifier-p output))
-           (active-error-output-p (or (eq error-output :output)
-                                      (%active-io-specifier-p error-output)))
+           (active-error-output-p (%active-io-specifier-p error-output))
            (activity
              (cond
                (active-output-p :output)
@@ -673,8 +682,7 @@ It returns a process-info plist with possible keys:
                             output :keys keys :setf output-result
                             :stream-easy-p t :active (eq activity :output))
         (with-program-error-output ((reduced-error-output error-output-activity)
-                                    (unless (eq error-output :output) error-output)
-                                    :keys keys :setf error-output-result
+                                    error-output :keys keys :setf error-output-result
                                     :stream-easy-p t :active (eq activity :error-output))
           (with-program-input ((reduced-input input-activity)
                                input :keys keys
@@ -839,6 +847,7 @@ or an indication of failure via the EXIT-CODE of the process"
       (apply (if (or force-shell
                      #+(or clisp ecl) (or (not ignore-error-status) t)
                      #+clisp (eq error-output :interactive)
+                     #+(or abcl clisp) (eq :error-output :output)
                      #+(and lispworks os-unix) (%interactivep input output error-output)
                      #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) t)
                  '%use-system '%use-run-program)
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index 507ccb25..d1630966 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -63,7 +63,7 @@
 
   (defun setup-stderr ()
     (setf *stderr*
-          #.(or #+allegro excl::*stderr*
+          #.(or #+allegro 'excl::*stderr*
                 #+clozure 'ccl::*stderr*
                 #+(or cmu scl) 'system:*stderr*
                 #+ecl 'ext::+process-error-output+
-- 
GitLab