X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Futils.lisp;h=57e3e26fb5f0559de0c2a43e3e447adbd0c5b216;hb=fa32c4233b4a02ae631602dbb0a234ab10df8aaf;hp=0221ac4eb7b1837d4e51b526ffe17ce68792ee21;hpb=e5744a78271044484b3399d4fc1d55b3e8808784;p=clsql.git 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")