mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'fix-576' into develop

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

26
src/lsp/iolib.lsp
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 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 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." The stream is automatically closed on exit and the string is returned."
(if string (multiple-value-bind (decls body)
`(LET* ((,var (MAKE-STRING-OUTPUT-STREAM-FROM-STRING ,string)) (find-declarations body)
(,(gensym) ,element-type)) (if string
;; We must evaluate element-type if it has been supplied by the user. (with-gensyms (elt-type-var)
;; Even if we ignore the value afterwards. `(let ((,var (make-string-output-stream-from-string ,string))
,@body) ;; We must evaluate element-type for side effects.
`(LET ((,var (MAKE-STRING-OUTPUT-STREAM ,@r))) (,elt-type-var ,element-type))
,@body (declare (ignore ,elt-type-var))
(GET-OUTPUT-STREAM-STRING ,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 (defun read-from-string (string
&optional (eof-error-p t) eof-value &optional (eof-error-p t) eof-value

14
src/tests/normal-tests/mixed.lsp
View file

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