From 9afb0bc650cd36dc093be6958a224e86d59d3893 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Sun, 18 Jan 2004 21:02:27 +0000
Subject: [PATCH] 0.8.7.17: 	Various stream functions should signal
 TYPE-ERROR if their 	argument is not a stream 	...
 also implement a potentially useful diagnostic to unconfuse
 		users of extensible streams which don't
 fully implement 		the protocol.

---
 NEWS                      |    8 +++++++-
 src/pcl/gray-streams.lisp |   44 ++++++++++++++++++++++++++++++++++++++++----
 version.lisp-expr         |    2 +-
 3 files changed, 48 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index f522482..b08faff 100644
--- a/NEWS
+++ b/NEWS
@@ -2239,15 +2239,21 @@ changes in sbcl-0.8.8 relative to sbcl-0.8.7:
     (thanks to Vincent Arkesteijn)
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the x86 backend.
+  * optimization: SEARCH on simple-base-strings can now be open-coded.
+    (see also contrib/compiler-extras.lisp for inspiration for
+    teaching the compiler about the Boyer-Moore algorithm).
   * bug fix: functions =, /=, <, <=, >, >= did not check the argument
     type when called with 1 argument; PEEK-CHAR checked type of
     PEEK-TYPE only after having read first character from a
     stream. (reported by Peter Graves)
   * fixed some bugs revealed by Paul Dietz' test suite:
-    ** in stack analysys liveness information is propagated from
+    ** in stack analysis liveness information is propagated from
        non-local entry points.
     ** pathwise CAST removing failed when the CAST node did not start
        a block.
+    ** INPUT-STREAM-P, OUTPUT-STREAM-P, STREAM-ELEMENT-TYPE and
+       OPEN-STREAM-P 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 554c904..3ad52a1 100644
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -10,6 +10,18 @@
 ;;;; more information.
 
 (in-package "SB-GRAY")
+
+;;; BUG-OR-ERROR: because we have extensible streams, wherewith the
+;;; 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.
+(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))
+
 
 (fmakunbound 'stream-element-type)
 
@@ -25,6 +37,12 @@
 
 (defmethod stream-element-type ((stream fundamental-character-stream))
   'character)
+
+(defmethod stream-element-type ((stream stream))
+  (bug-or-error stream 'stream-element-type))
+
+(defmethod stream-element-type ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric pcl-open-stream-p (stream)
   #+sb-doc
@@ -39,6 +57,12 @@
 (defmethod pcl-open-stream-p ((stream fundamental-stream))
   (stream-open-p stream))
 
+(defmethod pcl-open-stream-p ((stream stream))
+  (bug-or-error stream 'open-stream-p))
+
+(defmethod pcl-open-stream-p ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
+
 ;;; bootstrapping hack
 (pcl-open-stream-p (make-string-output-stream))
 (setf (fdefinition 'open-stream-p) #'pcl-open-stream-p)
@@ -66,12 +90,18 @@
   (defgeneric input-stream-p (stream)
     #+sb-doc
     (:documentation "Can STREAM perform input operations?"))
-
+  
   (defmethod input-stream-p ((stream ansi-stream))
     (ansi-stream-input-stream-p stream))
-
+  
   (defmethod input-stream-p ((stream fundamental-input-stream))
-    t))
+    t)
+
+  (defmethod input-stream-p ((stream stream))
+    (bug-or-error stream 'input-stream-p))
+  
+  (defmethod input-stream-p ((non-stream t))
+    (error 'type-error :datum non-stream :expected-type 'stream)))
 
 (let ()
   (fmakunbound 'output-stream-p)
@@ -84,7 +114,13 @@
     (ansi-stream-output-stream-p stream))
 
   (defmethod output-stream-p ((stream fundamental-output-stream))
-    t))
+    t)
+
+  (defmethod output-stream-p ((stream stream))
+    (bug-or-error stream 'output-stream-p))
+
+  (defmethod output-stream-p ((non-stream t))
+    (error 'type-error :datum non-stream :expected-type 'stream)))
 
 ;;; character input streams
 ;;;
diff --git a/version.lisp-expr b/version.lisp-expr
index 745e2aa..11ab5cf 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.16"
+"0.8.7.17"
-- 
1.7.10.4