Merge branch 'close-with-input-from-string-stream' into 'develop'

Always close stream in with-input-from-string

See merge request embeddable-common-lisp/ecl!197

src/lsp/iolib.lsp

@@ -34,18 +34,17 @@ automatically closed on exit."
 Evaluates FORMs with VAR bound to a string input stream from the string that
 is the value of STRING-FORM.  The stream is automatically closed on exit.
 Possible keywords are :INDEX, :START, and :END."
-  (if index
-      (multiple-value-bind (ds b)
-          (find-declarations body)
-        `(LET ((,var (MAKE-STRING-INPUT-STREAM ,string ,start ,end)))
-           ,@ds
-           (UNWIND-PROTECT
-             (MULTIPLE-VALUE-PROG1
-              (PROGN ,@b)
-              (SETF ,index (FILE-POSITION ,var)))
-             (CLOSE ,var))))
-      `(LET ((,var (MAKE-STRING-INPUT-STREAM ,string ,start ,end)))
-         ,@body)))
+  (multiple-value-bind (ds b)
+      (find-declarations body)
+    `(let ((,var (make-string-input-stream ,string ,start ,end)))
+       ,@ds
+       (unwind-protect
+            ,(if index
+                 `(multiple-value-prog1
+                      (progn ,@b)
+                    (setf ,index (file-position ,var)))
+                 `(progn ,@b))
+         (close ,var)))))
 
 (defmacro with-output-to-string ((var &optional string &rest r &key element-type) &rest body)
   "Syntax: (with-output-to-string (var [string-form]) {decl}* {form}*)

src/tests/normal-tests/mixed.lsp

@@ -373,3 +373,17 @@
 (test mix.0018.stack-overflow
   (signals ext:stack-overflow (labels ((f (x) (f (1+ x))))
                                 (f 1))))
+
+;;; Date 2020-04-18
+;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/merge_requests/197
+;;; Description:
+;;;
+;;;     Ensure that with-input-from-string closes the input stream
+;;;     that it creates.
+(test mix.0019.close-with-input-from-string-stream
+  (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)))))