Merge branch 'fix-576' into develop

This commit is contained in:
Daniel Kochmański 2020-04-24 11:50:13 +02:00
commit f152a3000d
2 changed files with 26 additions and 14 deletions

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

View file

@ -374,16 +374,20 @@
(signals ext:stack-overflow (labels ((f (x) (f (1+ x))))
(f 1))))
;;; Date 2020-04-18
;;; Date 2020-04-22
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/merge_requests/197
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/576
;;; Description:
;;;
;;; Ensure that with-input-from-string closes the input stream
;;; that it creates.
(test mix.0019.close-with-input-from-string-stream
;;; Ensure that with-input-from-string and with-output-to-string
;;; close the streams that they provide.
(test mix.0019.with-string-io-close-streams
(let (stream-var)
(with-input-from-string (inner-stream-var "test")
(setf stream-var inner-stream-var)
(is (open-stream-p stream-var)))
(is (streamp stream-var))
(is (not (open-stream-p stream-var)))
(with-output-to-string (inner-stream-var)
(setf stream-var inner-stream-var)
(is (open-stream-p stream-var)))
(is (not (open-stream-p stream-var)))))