From 414c64bc16680801257229b9b673f76a04b77cfd Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 29 Jan 2004 11:44:03 +0000
Subject: [PATCH] 0.8.7.30: 	More TYPE-ERRORs from stream functions 	...
 FORCE-OUTPUT, FINISH-OUTPUT, CLEAR-OUTPUT, CLEAR-INPUT

---
 NEWS                      |    2 ++
 src/pcl/gray-streams.lisp |   34 ++++++++++++++++++++++++++++------
 version.lisp-expr         |    2 +-
 3 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index 5d21de6..aaca703 100644
--- a/NEWS
+++ b/NEWS
@@ -2286,6 +2286,8 @@ changes in sbcl-0.8.8 relative to sbcl-0.8.7:
     ** OPEN :DIRECTION :IO no longer fails to work on non-existent
        files.
     ** DIRECTORY on logical pathnames is more correct.
+    ** CLEAR-INPUT, CLEAR-OUTPUT, FINISH-OUTPUT and FORCE-OUTPUT
+       signal a TYPE-ERROR if their argument is not a stream.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp
index 3ad52a1..fbf769a 100644
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -15,13 +15,19 @@
 ;;; user is responsible for some of the protocol implementation, it's
 ;;; not necessarily a bug in SBCL itself if we fall through to one of
 ;;; these default methods.
+;;;
+;;; FIXME: there's a lot of similarity in these Gray stream
+;;; implementation generic functions.  All of them could (maybe
+;;; should?) have two default methods: one on STREAM calling
+;;; BUG-OR-ERROR, and one on T signalling a TYPE-ERROR.
 (defmacro bug-or-error (stream fun)
-  `(error "~@<The stream ~S has no suitable method for ~S, ~
-           and so has fallen through to this method.  If you think that this is ~
-           a bug, please report it to the applicable authority (bugs in SBCL itself ~
-           should go to the mailing lists referenced from <http://www.sbcl.org/>).~@:>"
-           ,stream ,fun))
-
+  `(error
+    "~@<The stream ~S has no suitable method for ~S, ~
+     and so has fallen through to this method.  If you think that this is ~
+     a bug, please report it to the applicable authority (bugs in SBCL itself ~
+     should go to the mailing lists referenced from ~
+     <http://www.sbcl.org/>).~@:>"
+    ,stream ,fun))
 
 (fmakunbound 'stream-element-type)
 
@@ -218,6 +224,10 @@
 
 (defmethod stream-clear-input ((stream fundamental-character-input-stream))
   nil)
+(defmethod stream-clear-input ((stream stream))
+  (bug-or-error stream 'stream-clear-input))
+(defmethod stream-clear-input ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-read-sequence (stream seq &optional start end)
   (:documentation
@@ -379,6 +389,10 @@
 
 (defmethod stream-finish-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-finish-output ((stream stream))
+  (bug-or-error stream 'stream-finish-output))
+(defmethod stream-finish-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-force-output (stream)
   #+sb-doc
@@ -388,6 +402,10 @@
 
 (defmethod stream-force-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-force-output ((stream stream))
+  (bug-or-error stream 'stream-force-output))
+(defmethod stream-force-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-clear-output (stream)
   #+sb-doc
@@ -397,6 +415,10 @@
 
 (defmethod stream-clear-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-clear-output ((stream stream))
+  (bug-or-error stream 'stream-clear-output))
+(defmethod stream-clear-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-advance-to-column (stream column)
   #+sb-doc
diff --git a/version.lisp-expr b/version.lisp-expr
index e57b46e..d6d2e29 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".)
-"0.8.7.29"
+"0.8.7.30"
-- 
1.7.10.4