Always close stream in with-output-to-string & cosmetic changes

Fix #576, Related to !197, 72560efa5a

with-output-to-string is required to close the output stream that it provides
for the extent of the body forms [1]. The current definition does not do that.

This change wraps the body forms in unwind-protect clauses to ensure the stream
is always closed on exit. Because declarations cannot appear at the beginning of
progn forms, any potential declarations are extracted from the body forms and
moved to the beginning of the surrounding let form's body.

element-type is no longer bound to a gensym, but evaluated inside the let body.

The uppercased names are downcased for a more coherent appearance.

[1]: http://www.lispworks.com/documentation/HyperSpec/Body/m_w_out_.htm
This commit is contained in:
Moritz Petersen 2020-04-21 23:35:55 +02:00 committed by Daniel Kochmański
parent 29c415b19d
commit 660b1bec69

View file

@ -51,15 +51,23 @@ Possible keywords are :INDEX, :START, and :END."
Evaluates FORMs with VAR bound to a string output stream to the string that is
the value of STRING-FORM. If STRING-FORM is not given, a new string is used.
The stream is automatically closed on exit and the string is returned."
(if string
`(LET* ((,var (MAKE-STRING-OUTPUT-STREAM-FROM-STRING ,string))
(,(gensym) ,element-type))
;; We must evaluate element-type if it has been supplied by the user.
;; Even if we ignore the value afterwards.
,@body)
`(LET ((,var (MAKE-STRING-OUTPUT-STREAM ,@r)))
,@body
(GET-OUTPUT-STREAM-STRING ,var))))
(multiple-value-bind (decls body)
(find-declarations body)
(if string
(with-gensyms (elt-type-var)
`(let ((,var (make-string-output-stream-from-string ,string))
;; We must evaluate element-type for side effects.
(,elt-type-var ,element-type))
(declare (ignore ,elt-type-var))
,@decls
(unwind-protect (progn ,@body)
(close ,var))))
`(let ((,var (make-string-output-stream ,@r)))
,@decls
(unwind-protect (progn
,@body
(get-output-stream-string ,var))
(close ,var))))))
(defun read-from-string (string
&optional (eof-error-p t) eof-value