1.0.19.22: fix bug #425

 * Make CLOSE drop input buffers from ANSI-STREAMs. Reported by Damien
   Cassou on sbcl-devel.

 * Signal SB-INT:CLOSED-STREAM-ERROR instead of a SIMPLE-ERROR -- good
   for clarity, enables a proper test.

BUGS

@@ -1858,30 +1858,6 @@ generally try to check returns in safe code, so we should here too.)
 
  (Test-case adapted from CL-PPCRE.)
 
-425: reading from closed streams
-
- Reported by Damien Cassou on sbcl-devel. REPL transcript follows:
-
-  * (open ".bashrc" :direction :input)
-  #<SB-SYS:FD-STREAM for "file /home/cassou/.bashrc" {A6ADFC9}>
-  * (defparameter *s* *)
-  *S*
-  * (read-line *s*)
-  "# -*- Mode: Sh -*-"
-  * (read-line *s*)
-  "# Files you make look like rw-r--r--"
-  * (open-stream-p *s*)
-  T
-  * (close *s*)
-  T
-  * (open-stream-p *s*)
-  NIL
-  * (read-line *s*)
-  "umask 022"
-
- The problem is with the fast path using ansi-stream-cin-buffer not hitting
- closed-flame.
-
 426: inlining failure involving multiple nested calls
 
    (declaim (inline foo))

NEWS

@@ -21,6 +21,9 @@ changes in sbcl-1.0.20 relative to 1.0.19:
     (AREF (THE STRING X) Y) as being CHARACTER.
   * optimization: CLRHASH on empty hash-tables no longer does pointless
     work. (thanks to Alec Berryman)
+  * bug fix: fixed #425; CLOSE drops input buffers from streams, so
+    READ-LINE &co can no longer read from them afterwards. (reported
+    by Damien Cassou)
   * bug fix: fixed #427: unused local aliens no longer cause compiler
     breakage. (reported by Stelian Ionescu, Andy Hefner and Stanislaw
     Halik)

package-data-list.lisp-expr

@@ -859,6 +859,7 @@ possibly temporariliy, because it might be used internally."
                "*SETF-FDEFINITION-HOOK*"
 
                ;; error-reporting facilities
+               "CLOSED-STREAM-ERROR"
                "COMPILED-PROGRAM-ERROR"
                "ENCAPSULATED-CONDITION"
                "INTERPRETED-PROGRAM-ERROR"

src/code/condition.lisp

@@ -648,6 +648,11 @@
              "end of file on ~S"
              (stream-error-stream condition)))))
 
+(define-condition closed-stream-error (stream-error) ()
+  (:report
+   (lambda (condition stream)
+     (format stream "~S is closed" (stream-error-stream condition)))))
+
 (define-condition file-error (error)
   ((pathname :reader file-error-pathname :initarg :pathname))
   (:report

src/code/fd-stream.lisp

@@ -2042,7 +2042,12 @@
      (setf (fd-stream-unread fd-stream) arg1)
      (setf (fd-stream-listen fd-stream) t))
     (:close
-     (cond (arg1                    ; We got us an abort on our hands.
+     ;; Drop input buffers
+     (setf (ansi-stream-in-index fd-stream) +ansi-stream-in-buffer-length+
+           (ansi-stream-cin-buffer fd-stream) nil
+           (ansi-stream-in-buffer fd-stream) nil)
+     (cond (arg1
+            ;; We got us an abort on our hands.
             (let ((outputp (fd-stream-obuf fd-stream))
                   (file (fd-stream-file fd-stream))
                   (orig (fd-stream-original fd-stream)))

src/code/stream.lisp

@@ -53,7 +53,7 @@
          :format-arguments (list stream)))
 (defun closed-flame (stream &rest ignore)
   (declare (ignore ignore))
-  (error "~S is closed." stream))
+  (error 'closed-stream-error :stream stream))
 (defun no-op-placeholder (&rest ignore)
   (declare (ignore ignore)))
 

tests/stream.impure.lisp

@@ -497,5 +497,24 @@
                         (multiple-value-list (read-line in nil nil))))))
     (delete-file pathname)
     (assert (equal result '(("a" nil) ("b" t) (nil t))))))
+
+;;; READ-LINE used to work on closed streams because input buffers were left in place
+(with-test (:name :bug-425)
+  ;; Normal close
+  (let ((f (open "stream.impure.lisp" :direction :input)))
+    (assert (stringp (read-line f)))
+    (close f)
+    (assert (eq :fii
+                (handler-case
+                    (read-line f)
+                  (sb-int:closed-stream-error () :fii)))))
+  ;; Abort
+  (let ((f (open "stream.impure.lisp" :direction :input)))
+    (assert (stringp (read-line f nil nil)))
+    (close f :abort t)
+    (assert (eq :faa
+                (handler-case
+                    (read-line f)
+                  (sb-int:closed-stream-error () :faa))))))
 
 ;;; success

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.19.21"
+"1.0.19.22"