Skip to content
Snippets Groups Projects
Commit 0b941309 authored by Elias Pipping's avatar Elias Pipping
Browse files

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
parent e128719d
Branches
Tags
No related merge requests found
...@@ -729,7 +729,7 @@ It returns a process-info object." ...@@ -729,7 +729,7 @@ It returns a process-info object."
(active-error-output-p :error-output) (active-error-output-p :error-output)
(t nil))) (t nil)))
(wait (not activity)) (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) (with-program-output ((reduced-output output-activity)
output :keys keys :setf output-result output :keys keys :setf output-result
:stream-easy-p t :active (eq activity :output)) :stream-easy-p t :active (eq activity :output))
...@@ -739,11 +739,11 @@ It returns a process-info object." ...@@ -739,11 +739,11 @@ It returns a process-info object."
(with-program-input ((reduced-input input-activity) (with-program-input ((reduced-input input-activity)
input :keys keys input :keys keys
:stream-easy-p t :active (eq activity :input)) :stream-easy-p t :active (eq activity :input))
(let ((process-info (setf process-info
(apply '%run-program command (apply '%run-program command
:wait wait :input reduced-input :output reduced-output :wait wait :input reduced-input :output reduced-output
:error-output (if (eq error-output :output) :output reduced-error-output) :error-output (if (eq error-output :output) :output reduced-error-output)
keys))) keys))
(labels ((get-stream (stream-name &optional fallbackp) (labels ((get-stream (stream-name &optional fallbackp)
(or (slot-value process-info stream-name) (or (slot-value process-info stream-name)
(when fallbackp (when fallbackp
...@@ -767,10 +767,10 @@ It returns a process-info object." ...@@ -767,10 +767,10 @@ It returns a process-info object."
(list (slot-value process-info 'input-stream) (list (slot-value process-info 'input-stream)
(slot-value process-info 'output-stream))))) (slot-value process-info 'output-stream)))))
(when stream (close stream))) (when stream (close stream)))
(setf exit-code (setf exit-code (%wait-process-result process-info)))))))
(%check-result (%wait-process-result process-info) (%check-result exit-code
:command command :process process-info :command command :process process-info
:ignore-error-status ignore-error-status)))))))) :ignore-error-status ignore-error-status)
(values output-result error-output-result exit-code))) (values output-result error-output-result exit-code)))
(defun %normalize-system-command (command) ;; helper for %USE-SYSTEM (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
...@@ -856,12 +856,12 @@ It returns a process-info object." ...@@ -856,12 +856,12 @@ It returns a process-info object."
(with-program-error-output ((reduced-error-output) (with-program-error-output ((reduced-error-output)
error-output :keys keys :setf error-output-result) error-output :keys keys :setf error-output-result)
(with-program-input ((reduced-input) input :keys keys) (with-program-input ((reduced-input) input :keys keys)
(setf exit-code (setf exit-code (apply '%system command
(%check-result (apply '%system command :input reduced-input :output reduced-output
:input reduced-input :output reduced-output :error-output reduced-error-output keys)))))
:error-output reduced-error-output keys) (%check-result exit-code
:command command :command command
:ignore-error-status ignore-error-status))))) :ignore-error-status ignore-error-status)
(values output-result error-output-result exit-code))) (values output-result error-output-result exit-code)))
(defun run-program (command &rest keys (defun run-program (command &rest keys
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment