0.8.2.1:

	As reported by Edi Weitz on sbcl-help 2003-07-17, WITH-OUTPUT-TO-STRING
	should accept an :ELEMENT-TYPE keyword argument:
	... make it so;
	... make it so for MAKE-STRING-OUTPUT-STREAM too;
	(implementation of such while preserving efficiency in our (vector nil)
		world is slightly contorted; we accumulate arbitrary
		characters, then convert to the requested type when the
		stream's string is requested)
	... add tests for reasonable behaviour.

diff --git a/NEWS b/NEWS
index f57ee08..c833b23 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1937,6 +1937,11 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1:
     ** condition slot accessors are methods.
     ** (VECTOR NIL) is a subtype of STRING.
 
+changes in sbcl-0.8.3 relative to sbcl-0.8.2:
+  * bug fix: WITH-OUTPUT-TO-STRING (and MAKE-STRING-OUTPUT-STREAM) now
+    accept and act upon their :ELEMENT-TYPE keyword argument.
+    (reported by Edi Weitz)
+
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
     down, it might impact TRACE. They both encapsulate functions, and

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 9159bfb..1091114 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -363,8 +363,9 @@
           ,@(when index
               `((setf ,index (string-input-stream-current ,var)))))))))
 
-(defmacro-mundanely with-output-to-string ((var &optional string)
-                                          &body forms-decls)
+(defmacro-mundanely with-output-to-string 
+    ((var &optional string &key (element-type ''character))
+     &body forms-decls)
   (multiple-value-bind (forms decls) (parse-body forms-decls nil)
     (if string
       `(let ((,var (make-fill-pointer-output-stream ,string)))
@@ -372,7 +373,7 @@
         (unwind-protect
             (progn ,@forms)
           (close ,var)))
-      `(let ((,var (make-string-output-stream)))
+      `(let ((,var (make-string-output-stream :element-type ,element-type)))
         ,@decls
         (unwind-protect
             (progn ,@forms)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index c35f45f..db2865d 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -1182,12 +1182,16 @@
                      (sout #'string-sout)
                      (misc #'string-out-misc)
                       ;; The string we throw stuff in.
-                      (string (make-string 40)
+                      (string (missing-arg)
                              :type (simple-array character (*))))
-           (:constructor make-string-output-stream ())
+           (:constructor make-string-output-stream 
+                         (&key (element-type 'character)
+                          &aux (string (make-string 40))))
            (:copier nil))
   ;; Index of the next location to use.
-  (index 0 :type fixnum))
+  (index 0 :type fixnum)
+  ;; Requested element type
+  (element-type 'character))
 
 #!+sb-doc
 (setf (fdocumentation 'make-string-output-stream 'function)
@@ -1254,8 +1258,19 @@
 (defun get-output-stream-string (stream)
   (declare (type string-output-stream stream))
   (let* ((length (string-output-stream-index stream))
-        (result (make-string length)))
-    (replace result (string-output-stream-string stream))
+        (element-type (string-output-stream-element-type stream))
+        (result 
+         (case element-type
+           ;; Overwhelmingly common case; can be inlined.
+           ((character) (make-string length))
+           (t (make-string length :element-type element-type)))))
+    ;; For the benefit of the REPLACE transform, let's do this, so
+    ;; that the common case isn't ludicrously expensive.
+    (etypecase result 
+      ((simple-array character (*)) 
+       (replace result (string-output-stream-string stream)))
+      ((simple-array nil (*))
+       (replace result (string-output-stream-string stream))))
     (setf (string-output-stream-index stream) 0)
     result))
 

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 6b80f4d..3043940 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -919,7 +919,10 @@
 (defknown make-echo-stream (stream stream) stream (flushable))
 (defknown make-string-input-stream (string &optional index index) stream
   (flushable unsafe))
-(defknown make-string-output-stream () stream (flushable))
+(defknown make-string-output-stream 
+    (&key (:element-type type-specifier)) 
+    stream 
+  (flushable))
 (defknown get-output-stream-string (stream) simple-string ())
 (defknown streamp (t) boolean (movable foldable flushable))
 (defknown stream-element-type (stream) type-specifier

diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp
index 016b31c..4bf264c 100644 (file)
--- a/tests/stream.pure.lisp
+++ b/tests/stream.pure.lisp
@@ -102,3 +102,23 @@
   (assert (char= (read-char stream) #\a))
   (assert (file-position stream :end))
   (assert (eq (read-char stream nil 'foo) 'foo)))
+
+;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
+;;; :ELEMENT-TYPE keyword argument
+(macrolet ((frob (element-type-form)
+            `(progn
+               (let ((s (with-output-to-string 
+                          (s nil ,@(when element-type-form
+                                     `(:element-type ,element-type-form))))))
+                 (assert (typep s '(simple-array ,(if element-type-form
+                                                      (eval element-type-form)
+                                                      'character)
+                                                 (0)))))
+               (get-output-stream-string 
+                (make-string-output-stream
+                 ,@(when element-type-form
+                     `(:element-type ,element-type-form)))))))
+  (frob nil)
+  (frob 'character)
+  (frob 'base-char)
+  (frob 'nil))

diff --git a/version.lisp-expr b/version.lisp-expr
index 90a6b18..2668ff9 100644 (file)
--- 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.2"
+"0.8.2.1"