From 5d5894082c39ca44da75d38859d669c7b2108f6a Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 5 Aug 2008 10:38:36 +0000 Subject: [PATCH] 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 | 24 ------------------------ NEWS | 3 +++ package-data-list.lisp-expr | 1 + src/code/condition.lisp | 5 +++++ src/code/fd-stream.lisp | 7 ++++++- src/code/stream.lisp | 2 +- tests/stream.impure.lisp | 19 +++++++++++++++++++ version.lisp-expr | 2 +- 8 files changed, 36 insertions(+), 27 deletions(-) diff --git a/BUGS b/BUGS index b1d99eb18..8fd2a83a6 100644 --- a/BUGS +++ b/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) - # - * (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)) diff --git a/NEWS b/NEWS index 745603c7a..d3d006630 100644 --- a/NEWS +++ b/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) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index f3ceeaa66..3329b3c29 100644 --- a/package-data-list.lisp-expr +++ b/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" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 9ec433e1e..d7b2e4d3d 100644 --- a/src/code/condition.lisp +++ b/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 diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 8961da47b..de635c70f 100644 --- a/src/code/fd-stream.lisp +++ b/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))) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index e2bb25da6..eb40f5864 100644 --- a/src/code/stream.lisp +++ b/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))) diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index e6cb01c7a..851990f68 100644 --- a/tests/stream.impure.lisp +++ b/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 diff --git a/version.lisp-expr b/version.lisp-expr index 0c334cba8..7f183ba1b 100644 --- a/version.lisp-expr +++ b/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" -- 2.11.4.GIT