From: Kevin M. Rosenberg Date: Sun, 11 Apr 2004 00:55:45 +0000 (+0000) Subject: r8929: fix for openmcl command-output X-Git-Tag: v3.8.6~684 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=a443a60adefa64f590d2803e85c7e4657e806225 r8929: fix for openmcl command-output --- diff --git a/base/utils.lisp b/base/utils.lisp index 0221ac4..57e3e26 100644 --- a/base/utils.lisp +++ b/base/utils.lisp @@ -137,6 +137,14 @@ (if error error "")) status))) +(defun read-stream-to-string (in) + (with-output-to-string (out) + (let ((eof (gensym))) + (do ((line (read-line in nil eof) + (read-line in nil eof))) + ((eq line eof)) + (format out "~A~%" line))))) + ;; From KMRCL (defun %command-output (control-string &rest args) "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and @@ -188,16 +196,19 @@ returns (VALUES string-output error-output exit-status)" (ext:run-shell-command command :output :terminal :wait t)) #+openmcl - (let ((process (ccl:run-program - "/bin/sh" - (list "-c" command) - :input nil :output :stream :error :stream - :wait t))) - (values - (get-output-stream-string (ccl::external-process-output-stream process)) - (get-output-stream-string (ccl::external-process-error-stream process)) - (nth-value 1 (ccl::external-process-status process)))) - + (let* ((process (ccl:run-program + "/bin/sh" + (list "-c" command) + :input nil :output :stream :error :stream + :wait t)) + (output (read-stream-to-string (ccl::external-process-output-stream process))) + (error (read-stream-to-string (ccl::external-process-error-stream process)))) + (close (ccl::external-process-output-stream process)) + (close (ccl::external-process-error-stream process)) + (values output + error + (nth-value 1 (ccl::external-process-status process)))) + #-(or openmcl clisp lispworks allegro scl cmu sbcl) (error "COMMAND-OUTPUT not implemented for this Lisp")