X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fgray-streams.lisp;h=2b0cc85d3e4aa9bff25871903757ca5cc239721b;hb=b86f43bae31f775d834c724e21f0f573b968f695;hp=554c904e491e85d5733096b79f56c69a5e93a267;hpb=504959cef381a69a727263ba2a70108f133f8900;p=sbcl.git

diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp
index 554c904..2b0cc85 100644
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -10,6 +10,24 @@
 ;;;; 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.
+;;;
+;;; 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))
 
 (fmakunbound 'stream-element-type)
 
@@ -25,6 +43,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 +63,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 +96,21 @@
   (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-stream))
+    nil)
+
   (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)
@@ -83,8 +122,17 @@
   (defmethod output-stream-p ((stream ansi-stream))
     (ansi-stream-output-stream-p stream))
 
+  (defmethod output-stream-p ((stream fundamental-stream))
+    nil)
+  
   (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
 ;;;
@@ -182,6 +230,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
@@ -343,6 +395,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
@@ -352,6 +408,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
@@ -361,6 +421,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
@@ -434,12 +498,22 @@
    "Used by READ-BYTE; returns either an integer, or the symbol :EOF
   if the stream is at end-of-file."))
 
+(defmethod stream-read-byte ((stream stream))
+  (bug-or-error stream 'stream-read-byte))
+(defmethod stream-read-byte ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
+
 (defgeneric stream-write-byte (stream integer)
   #+sb-doc
   (:documentation
    "Implements WRITE-BYTE; writes the integer to the stream and
   returns the integer as the result."))
 
+(defmethod stream-write-byte ((stream stream) integer)
+  (bug-or-error stream 'stream-write-byte))
+(defmethod stream-write-byte ((non-stream t) integer)
+  (error 'type-error :datum non-stream :expected-type 'stream))
+
 ;; Provide a reasonable default for binary Gray streams.  We might be
 ;; able to do better by specializing on the sequence type, but at
 ;; least the behaviour is reasonable. --tony 2003/05/08.