From 50fca61940fb5338f73a867cf6f721ee6b94fdf7 Mon Sep 17 00:00:00 2001 From: Moritz Petersen Date: Tue, 21 Apr 2020 23:35:55 +0200 Subject: [PATCH 1/2] Always close stream in with-output-to-string & cosmetic changes Fix #576, Related to !197, 72560efa5a4300e6 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 --- src/lsp/iolib.lsp | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/lsp/iolib.lsp b/src/lsp/iolib.lsp index 696f488b2..421188e60 100644 --- a/src/lsp/iolib.lsp +++ b/src/lsp/iolib.lsp @@ -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 + `(let ((,var (make-string-output-stream-from-string ,string))) + ,@decls + ;; We must evaluate element-type if it has been supplied by the user. + ;; Even if we ignore the value afterwards. + ,element-type + (unwind-protect (progn ,@body) + (close ,var))) + `(let ((,var (make-string-output-stream ,@r))) + ,@decls + ,element-type + (unwind-protect (progn + ,@body + (get-output-stream-string ,var)) + (close ,var)))))) (defun read-from-string (string &optional (eof-error-p t) eof-value -- GitLab From 6f96963a23aa4e5dcbd04d3457b19d857463bc8e Mon Sep 17 00:00:00 2001 From: Moritz Petersen Date: Wed, 22 Apr 2020 22:03:14 +0200 Subject: [PATCH 2/2] Add a regression test for the bug described in #576 Merge a test for with-output-to-string with the one for with-input-input-from-string to ensure both close their streams. Remove check for stream-var being a stream outside of w-i-f-s & w-o-t-s. According to the specification, the streams' extent ends with the respective providing form. If the stream was indeed not acccessible anymore, the test would not pass. In that case open-stream-p should signal a type-error, causing the test to crash. However in ECL we can assume that the stream is still intact. --- src/tests/normal-tests/mixed.lsp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index 455201185..b1e9cd262 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -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))))) -- GitLab