From b34c64b50e8ade72fabb565a38841c4710ee8f40 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 23 Jun 2003 14:05:26 +0000
Subject: [PATCH] 0.8.0.78.vector-nil-string.5: 	Make MAKE-STRING work as
 expected 	... respect ELEMENT-TYPE 	... and
 while we're at it, make the transform not confuse the 	
 compiler when the user's ELEMENT-TYPE isn't a subtype 	
 of character 	Also add some tests for some of the gotcha's
 we've found so 	far.

---
 src/code/string.lisp         |   17 +++++++----------
 src/compiler/array-tran.lisp |    9 +++++----
 tests/string.pure.lisp       |   31 +++++++++++++++++++++++++++++++
 version.lisp-expr            |    2 +-
 4 files changed, 44 insertions(+), 15 deletions(-)

diff --git a/src/code/string.lisp b/src/code/string.lisp
index cc32c65..e638523 100644
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -348,19 +348,16 @@
   (using char-equal) of the two strings. Otherwise, returns ()."
   (string-not-greaterp* string1 string2 start1 end1 start2 end2))
 
-(defun make-string (count &key element-type ((:initial-element fill-char)))
+(defun make-string (count &key
+		    (element-type 'character)
+		    ((:initial-element fill-char)))
   #!+sb-doc
   "Given a character count and an optional fill character, makes and returns
-   a new string Count long filled with the fill character."
-  (declare (fixnum count)
-	   (ignore element-type))
+   a new string COUNT long filled with the fill character."
+  (declare (fixnum count))
   (if fill-char
-      (do ((i 0 (1+ i))
-	   (string (make-string count)))
-	  ((= i count) string)
-	(declare (fixnum i))
-	(setf (schar string i) fill-char))
-      (make-string count)))
+      (make-string count :element-type element-type :initial-element fill-char)
+      (make-string count :element-type element-type)))
 
 (flet ((%upcase (string start end)
 	 (declare (string string) (index start) (type sequence-end end))
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index e7aec41..df88690 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -189,12 +189,13 @@
 
 ;;; Just convert it into a MAKE-ARRAY.
 (deftransform make-string ((length &key
-				   (element-type 'base-char)
+				   (element-type 'character)
 				   (initial-element
 				    #.*default-init-char-form*)))
-  '(make-array (the index length)
-               :element-type element-type
-               :initial-element initial-element))
+  `(the simple-string (make-array (the index length)
+		       :element-type element-type
+		       ,@(when initial-element
+			   '(:initial-element initial-element)))))
 
 (defstruct (specialized-array-element-type-properties
 	    (:conc-name saetp-)
diff --git a/tests/string.pure.lisp b/tests/string.pure.lisp
index 5d7fd11..702dfee 100644
--- a/tests/string.pure.lisp
+++ b/tests/string.pure.lisp
@@ -45,3 +45,34 @@
   (assert (string= nstring "CaT"))
   (nstring-capitalize nstring)
   (assert (string= nstring "Cat")))
+
+;;; (VECTOR NIL)s are strings.  Tests for that and issues uncovered in
+;;; the process.
+(assert (typep (make-array 1 :element-type nil) 'string))
+(assert (not (typep (make-array 2 :element-type nil) 'base-string)))
+(assert (typep (make-string 3 :element-type nil) 'simple-string))
+(assert (not (typep (make-string 4 :element-type nil) 'simple-base-string)))
+
+(assert (subtypep (class-of (make-array 1 :element-type nil))
+		  (find-class 'string)))
+(assert (subtypep (class-of (make-array 2 :element-type nil :fill-pointer 1))
+		  (find-class 'string)))
+
+(assert (string= "" (make-array 0 :element-type nil)))
+(assert (string/= "a" (make-array 0 :element-type nil)))
+(assert (string= "" (make-array 5 :element-type nil :fill-pointer 0)))
+
+(assert (= (sxhash "")
+	   (sxhash (make-array 0 :element-type nil))
+	   (sxhash (make-array 5 :element-type nil :fill-pointer 0))
+	   (sxhash (make-string 0 :element-type nil))))
+(assert (subtypep (type-of (make-array 2 :element-type nil)) 'simple-string))
+(assert (subtypep (type-of (make-array 4 :element-type nil :fill-pointer t))
+		  'string))
+
+(assert (eq (intern "") (intern (make-array 0 :element-type nil))))
+(assert (eq (intern "")
+	    (intern (make-array 5 :element-type nil :fill-pointer 0))))
+
+(assert (raises-error? (make-string 5 :element-type t)))
+(assert (raises-error? (let () (make-string 5 :element-type t))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 058ac49..9cf83a9 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.0.78.vector-nil-string.4"
+"0.8.0.78.vector-nil-string.5"
-- 
1.7.10.4