From 0b941309bc9d80e27a89d057ba764aee7b74e1a9 Mon Sep 17 00:00:00 2001
From: Elias Pipping <elias.pipping@fu-berlin.de>
Date: Fri, 9 Sep 2016 19:50:02 +0000
Subject: [PATCH] Move %check-result out of with-program-*put

This allows the :setf of with-program-*put to complete so that
in particular, any remaining output will be written
---
 uiop/run-program.lisp | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index 330f2dfb7..3105520ce 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -729,7 +729,7 @@ It returns a process-info object."
                (active-error-output-p :error-output)
                (t nil)))
            (wait (not activity))
-           output-result error-output-result exit-code)
+           output-result error-output-result exit-code process-info)
       (with-program-output ((reduced-output output-activity)
                             output :keys keys :setf output-result
                             :stream-easy-p t :active (eq activity :output))
@@ -739,11 +739,11 @@ It returns a process-info object."
           (with-program-input ((reduced-input input-activity)
                                input :keys keys
                                :stream-easy-p t :active (eq activity :input))
-            (let ((process-info
+            (setf process-info
                     (apply '%run-program command
                            :wait wait :input reduced-input :output reduced-output
                            :error-output (if (eq error-output :output) :output reduced-error-output)
-                           keys)))
+                           keys))
               (labels ((get-stream (stream-name &optional fallbackp)
                          (or (slot-value process-info stream-name)
                              (when fallbackp
@@ -767,10 +767,10 @@ It returns a process-info object."
                                           (list (slot-value process-info 'input-stream)
                                                 (slot-value process-info 'output-stream)))))
                     (when stream (close stream)))
-                  (setf exit-code
-                        (%check-result (%wait-process-result process-info)
-                                       :command command :process process-info
-                                       :ignore-error-status ignore-error-status))))))))
+                  (setf exit-code (%wait-process-result process-info)))))))
+      (%check-result exit-code
+                     :command command :process process-info
+                     :ignore-error-status ignore-error-status)
       (values output-result error-output-result exit-code)))
 
   (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
@@ -856,12 +856,12 @@ It returns a process-info object."
         (with-program-error-output ((reduced-error-output)
                                     error-output :keys keys :setf error-output-result)
           (with-program-input ((reduced-input) input :keys keys)
-            (setf exit-code
-                  (%check-result (apply '%system command
-                                        :input reduced-input :output reduced-output
-                                        :error-output reduced-error-output keys)
-                                 :command command
-                                 :ignore-error-status ignore-error-status)))))
+            (setf exit-code (apply '%system command
+                                   :input reduced-input :output reduced-output
+                                   :error-output reduced-error-output keys)))))
+      (%check-result exit-code
+                     :command command
+                     :ignore-error-status ignore-error-status)
       (values output-result error-output-result exit-code)))
 
   (defun run-program (command &rest keys
-- 
GitLab