From a96369c72588c5457d71d6aaea35f2c450b19ef5 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Mon, 11 Nov 2002 10:33:01 +0000
Subject: [PATCH] 0.7.9.42:         Fixed bug 225: STRING-STREAM must be a
 class (reported bu         Gilbert Baumann)

---
 BUGS                     |    3 +--
 NEWS                     |    2 ++
 src/code/late-type.lisp  |    1 -
 src/code/stream.lisp     |   40 ++++++++++++++++++++++------------------
 tests/stream.impure.lisp |   14 ++++++++++++++
 version.lisp-expr        |    2 +-
 6 files changed, 40 insertions(+), 22 deletions(-)

diff --git a/BUGS b/BUGS
index 59f201f..51727a3 100644
--- a/BUGS
+++ b/BUGS
@@ -1320,8 +1320,7 @@ WORKAROUND:
           (ignore-errors (progn (values-list (car (list '(1 . 2)))) t)))
 
 225:
-  As reported by Gilbert Baumann on free-clim mailing list 2002-11-11,
-  there is no class STRING-STREAM.
+  (fixed in 0.7.9.42)
 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
diff --git a/NEWS b/NEWS
index 441a859..f61d675 100644
--- a/NEWS
+++ b/NEWS
@@ -1397,6 +1397,8 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9:
     Matthew Danish)
   * fixed Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug (thanks
     to Matthew Danish)
+  * fixed bug 225: STRING-STREAM is now a class (reported byg Gilbert
+    Baumann)
 
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe
diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 3cd0808..a790c44 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2248,7 +2248,6 @@
     ((type= type (specifier-type 'float)) 'float)
     ((type= type (specifier-type 'real)) 'real)
     ((type= type (specifier-type 'sequence)) 'sequence)
-    ((type= type (specifier-type 'string-stream)) 'string-stream)
     (t `(or ,@(mapcar #'type-specifier (union-type-types type))))))
 
 ;;; Two union types are equal if they are each subtypes of each
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 807c422..6e0e377 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -11,10 +11,6 @@
 
 (in-package "SB!IMPL")
 
-(deftype string-stream ()
-  '(or string-input-stream string-output-stream
-       fill-pointer-output-stream))
-
 ;;;; standard streams
 
 ;;; The initialization of these streams is performed by
@@ -1039,18 +1035,25 @@
 	       (stream-misc-dispatch out operation arg1 arg2)))))))
 
 
+;;;; string streams
+(defstruct (string-stream
+             (:include ansi-stream)
+             (:constructor nil)
+             (:copier nil))
+  (string nil :type string))
+
 ;;;; string input streams
 
 (defstruct (string-input-stream
-	     (:include ansi-stream
+	     (:include string-stream
 		       (in #'string-inch)
 		       (bin #'string-binch)
 		       (n-bin #'string-stream-read-n-bytes)
-		       (misc #'string-in-misc))
+		       (misc #'string-in-misc)
+                       (string nil :type simple-string))
 	     (:constructor internal-make-string-input-stream
 			   (string current end))
 	     (:copier nil))
-  (string nil :type simple-string)
   (current nil :type index)
   (end nil :type index))
 
@@ -1134,14 +1137,14 @@
 ;;;; string output streams
 
 (defstruct (string-output-stream
-	    (:include ansi-stream
+	    (:include string-stream
 		      (out #'string-ouch)
 		      (sout #'string-sout)
-		      (misc #'string-out-misc))
+		      (misc #'string-out-misc)
+                      ;; The string we throw stuff in.
+                      (string (make-string 40) :type simple-string))
 	    (:constructor make-string-output-stream ())
 	    (:copier nil))
-  ;; The string we throw stuff in.
-  (string (make-string 40) :type simple-string)
   ;; Index of the next location to use.
   (index 0 :type fixnum))
 
@@ -1230,16 +1233,17 @@
 	(satisfies array-has-fill-pointer-p)))
 
 (defstruct (fill-pointer-output-stream
- 	    (:include ansi-stream
+ 	    (:include string-stream
 		      (out #'fill-pointer-ouch)
 		      (sout #'fill-pointer-sout)
-		      (misc #'fill-pointer-misc))
+		      (misc #'fill-pointer-misc)
+                      ;; a string with a fill pointer where we stuff
+                      ;; the stuff we write
+                      (string (error "missing argument")
+                              :type string-with-fill-pointer
+                              :read-only t))
 	    (:constructor make-fill-pointer-output-stream (string))
-	    (:copier nil))
-  ;; a string with a fill pointer where we stuff the stuff we write
-  (string (error "missing argument")
-	  :type string-with-fill-pointer
-	  :read-only t))
+	    (:copier nil)))
 
 (defun fill-pointer-ouch (stream character)
   (let* ((buffer (fill-pointer-output-stream-string stream))
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index caf58cc..0908560 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -41,6 +41,20 @@
 			  (make-string-output-stream)
 			  (make-string-input-stream "foo"))
 			 type-error)))
+
+;;; bug 225: STRING-STREAM was not a class
+(eval `(defgeneric bug225 (s)
+         ,@(mapcar (lambda (class)
+                     `(:method :around ((s ,class)) (cons ',class (call-next-method))))
+                   '(stream string-stream sb-impl::string-input-stream
+                     sb-impl::string-output-stream))
+         (:method (class) nil)))
+
+(assert (equal (bug225 (make-string-input-stream "hello"))
+               '(sb-impl::string-input-stream string-stream stream)))
+(assert (equal (bug225 (make-string-output-stream))
+               '(sb-impl::string-output-stream string-stream stream)))
+
 
 ;;; success
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 6b9f789..635883e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.41"
+"0.7.9.42"
-- 
1.7.10.4