0.6.10.1:

	made revised STRING-FOO functions accept string designators
		instead of just strings (thanks to MNA bug report)

diff --git a/BUGS b/BUGS
index 353c71a..2f2a651 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -844,17 +844,15 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   :ELEMENT-TYPE, but in sbcl-0.6.9 this is not defined for
   WITH-OUTPUT-TO-STRING.
 
-77:
-  As reported by Martin Atzmueller on sbcl-devel 2000-01-09,
-  DEF-ALIEN-VARIABLE doesn't work. With either the example in the
-  old CMU CL docs,
-    (def-alien-variable "errno" integer)
-  or another test avoiding any peculiarities of modern errno-as-macro
-  implementations,
-    (def-alien-variable "from_space" integer)
-  in sbcl-0.6.9 the operation fails with 
-    TYPE-ERROR in SB-KERNEL::OBJECT-NOT-TYPE-ERROR-HANDLER:
-      NIL is not of type SB-KERNEL:LEXENV.
+78:
+  ANSI says in one place that type declarations can be abbreviated even
+  when the type name is not a symbol, e.g.
+    (DECLAIM ((VECTOR T) *FOOVECTOR*))
+  SBCL doesn't support this. But ANSI says in another place that this
+  isn't allowed. So it's not clear this is a bug after all. (See the
+  e-mail on cmucl-help@cons.org on 2001-01-16 and 2001-01-17 from WHN
+  and Pierre Mai.)
+
 
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 

diff --git a/src/code/string.lisp b/src/code/string.lisp
index 3ffae90..0482f5d 100644 (file)
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -352,61 +352,61 @@
        (setf (schar string i) fill-char))
       (make-string count)))
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%upcase (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
           (with-one-string (string start end)
             (do ((index start (1+ index)))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setf (schar string index) (char-upcase (schar string index)))))
-          save-header)))
+          saved-header)))
 (defun string-upcase (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%upcase (copy-seq (string string)) start end))
 (defun nstring-upcase (string &key (start 0) end)
-  (frob string start end))
+  (%upcase string start end))
 ) ; FLET
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%downcase (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
           (with-one-string (string start end)
             (do ((index start (1+ index)))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setf (schar string index)
                     (char-downcase (schar string index)))))
-          save-header)))
+          saved-header)))
 (defun string-downcase (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%downcase (copy-seq (string string)) start end))
 (defun nstring-downcase (string &key (start 0) end)
-  (frob string start end))
+  (%downcase string start end))
 ) ; FLET
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%capitalize (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
            (with-one-string (string start end)
              (do ((index start (1+ index))
-                 (newword t)
-                 (char ()))
+                 (new-word? t)
+                 (char nil))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setq char (schar string index))
               (cond ((not (alphanumericp char))
-                     (setq newword t))
-              (newword
-               ;; CHAR is the first case-modifiable character after
-               ;; a sequence of non-case-modifiable characters.
-               (setf (schar string index) (char-upcase char))
-               (setq newword ()))
-              (t
-               (setf (schar string index) (char-downcase char))))))
-          save-header)))
+                     (setq new-word? t))
+                    (new-word?
+                     ;; CHAR is the first case-modifiable character after
+                     ;; a sequence of non-case-modifiable characters.
+                     (setf (schar string index) (char-upcase char))
+                     (setq new-word? nil))
+                    (t
+                     (setf (schar string index) (char-downcase char))))))
+          saved-header)))
 (defun string-capitalize (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%capitalize (copy-seq (string string)) start end))
 (defun nstring-capitalize (string &key (start 0) end)
-  (frob string start end))
+  (%capitalize string start end))
 ) ; FLET
 
 (defun string-left-trim (char-bag string)

diff --git a/tests/string.pure.lisp b/tests/string.pure.lisp
index c44ffb3..5d7fd11 100644 (file)
--- a/tests/string.pure.lisp
+++ b/tests/string.pure.lisp
@@ -13,6 +13,7 @@
 
 (in-package "CL-USER")
 
+;;; basic non-destructive case operations
 (assert (string= (string-upcase     "This is a test.") "THIS IS A TEST."))
 (assert (string= (string-downcase   "This is a test.") "this is a test."))
 (assert (string= (string-capitalize "This is a test.") "This Is A Test."))
@@ -23,3 +24,24 @@
                 "Is this 900-sex-hott, please?"))
 (assert (string= (string-capitalize "Is this 900-Sex-hott, please?")
                 "Is This 900-Sex-Hott, Please?"))
+
+;;; The non-destructive case operations accept string designators, not
+;;; just strings.
+(assert (string= (string-upcase '|String designator|) "STRING DESIGNATOR"))
+(assert (string= (string-downcase #\S) "s"))
+(assert (string= (string-downcase #\.) "."))
+(assert (string= (string-capitalize 'ya-str-desig :end 5) "Ya-StR-DESIG"))
+
+;;; basic destructive case operations
+(let ((nstring (make-array 5 :element-type 'character :fill-pointer 0)))
+  (vector-push-extend #\c nstring)
+  (vector-push-extend #\a nstring)
+  (vector-push-extend #\t nstring)
+  (nstring-upcase nstring)
+  (assert (string= nstring "CAT"))
+  (setf (fill-pointer nstring) 2)
+  (nstring-downcase nstring :start 1)
+  (setf (fill-pointer nstring) 3)
+  (assert (string= nstring "CaT"))
+  (nstring-capitalize nstring)
+  (assert (string= nstring "Cat")))

diff --git a/version.lisp-expr b/version.lisp-expr
index 833805f..2178b1f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.10"
+"0.6.10.1"