1.0.17.42: more string trimming fixes

 * Return value in the no-op case for non-simple-strings must not be
   the underlying simple string object.

 * Correct return type (per spec) for STRING-TRIM &co is
   STRING-DESIGNATOR, but as long as we take care, we can make it
   STRING -- but the old SIMPLE-STRING is still wrong.

 * Instead of making WITH-STRING a full-blown Evil Macro, just use
   WITH-ARRAY-DATA at the call site.

 * Two more test-cases.

   patch by James Knight.

diff --git a/NEWS b/NEWS
index 7c8d8f5..71373b6 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -31,6 +31,9 @@ changes in sbcl-1.0.18 relative to 1.0.17:
     (reported by Yoshinori Tahara)
   * bug fix: more accurate disassembly annotations of foreign function
     calls.  (thanks to Andy Hefner)
+  * bug fix: trimming non-simple strings and non-string string
+    designators when the there is nothing to trim works properly.
+    (thanks to James Knight)
   * new feature: SB-POSIX bindings for mlockall, munlockall, and setsid.
     (thanks to Travis Cross)
   * fixed some bugs revealed by Paul Dietz' test suite:

diff --git a/src/code/string.lisp b/src/code/string.lisp
index de97aa9..72df091 100644 (file)
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -9,6 +9,9 @@
 
 (in-package "SB!IMPL")
 
+(eval-when (:compile-toplevel)
+  (sb!xc:defmacro %string (x) `(if (stringp ,x) ,x (string ,x))))
+
 (defun string (x)
   #!+sb-doc
   "Coerces X into a string. If X is a string, X is returned. If X is a
@@ -37,26 +40,18 @@
 ;;; keywords are parsed, and the string is hacked into a
 ;;; simple-string.
 (sb!xc:defmacro with-one-string ((string start end) &body forms)
-  `(let* ((,string (if (stringp ,string) ,string (string ,string))))
+  `(let ((,string (%string ,string)))
      (with-array-data ((,string ,string)
                        (,start ,start)
                        (,end ,end)
                        :check-fill-pointer t)
        ,@forms)))
-;;; WITH-STRING is like WITH-ONE-STRING, but doesn't parse keywords.
-(sb!xc:defmacro with-string (string &rest forms)
-  `(let ((,string (if (stringp ,string) ,string (string ,string))))
-     (with-array-data ((,string ,string)
-                       (start)
-                       (end)
-                       :check-fill-pointer t)
-       ,@forms)))
 ;;; WITH-TWO-STRINGS is used to set up string comparison operations. The
 ;;; keywords are parsed, and the strings are hacked into SIMPLE-STRINGs.
 (sb!xc:defmacro with-two-strings (string1 string2 start1 end1 cum-offset-1
                                             start2 end2 &rest forms)
-  `(let ((,string1 (if (stringp ,string1) ,string1 (string ,string1)))
-         (,string2 (if (stringp ,string2) ,string2 (string ,string2))))
+  `(let ((,string1 (%string ,string1))
+         (,string2 (%string ,string2)))
      (with-array-data ((,string1 ,string1 :offset-var ,cum-offset-1)
                        (,start1 ,start1)
                        (,end1 ,end1)
@@ -405,29 +400,33 @@ new string COUNT long filled with the fill character."
 ) ; FLET
 
 (defun generic-string-trim (char-bag string left-p right-p)
-  (with-string string
-    (let* ((left-end (if left-p
-                         (do ((index start (1+ index)))
-                             ((or (= index (the fixnum end))
-                                  (not (find (schar string index)
-                                             char-bag
-                                             :test #'char=)))
-                              index)
-                           (declare (fixnum index)))
-                         start))
-           (right-end (if right-p
-                          (do ((index (1- (the fixnum end)) (1- index)))
-                              ((or (< index left-end)
-                                   (not (find (schar string index)
-                                              char-bag
-                                              :test #'char=)))
-                               (1+ index))
-                            (declare (fixnum index)))
-                          end)))
-      (if (and (eql left-end start)
-               (eql right-end end))
-          string
-          (subseq (the simple-string string) left-end right-end)))))
+  (let ((header (%string string)))
+    (with-array-data ((string header)
+                      (start)
+                      (end)
+                      :check-fill-pointer t)
+      (let* ((left-end (if left-p
+                           (do ((index start (1+ index)))
+                               ((or (= index (the fixnum end))
+                                    (not (find (schar string index)
+                                               char-bag
+                                               :test #'char=)))
+                                index)
+                             (declare (fixnum index)))
+                           start))
+             (right-end (if right-p
+                            (do ((index (1- (the fixnum end)) (1- index)))
+                                ((or (< index left-end)
+                                     (not (find (schar string index)
+                                                char-bag
+                                                :test #'char=)))
+                                 (1+ index))
+                              (declare (fixnum index)))
+                            end)))
+        (if (and (eql left-end start)
+                 (eql right-end end))
+            header
+            (subseq (the simple-string string) left-end right-end))))))
 
 (defun string-left-trim (char-bag string)
   (generic-string-trim char-bag string t nil))

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 5f8731d..a262483 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -913,7 +913,7 @@
   simple-string (flushable))
 
 (defknown (string-trim string-left-trim string-right-trim)
-  (sequence string-designator) simple-string (flushable))
+  (sequence string-designator) string (flushable))
 
 (defknown (string-upcase string-downcase string-capitalize)
   (string-designator &key (:start index) (:end sequence-end))

diff --git a/tests/string.pure.lisp b/tests/string.pure.lisp
index 13da95d..89e9806 100644 (file)
--- a/tests/string.pure.lisp
+++ b/tests/string.pure.lisp
@@ -137,3 +137,11 @@
   (assert (equal "bc" (string-right-trim "ab" s)))
   (assert (equal "bca" s))
   (assert (equal "abcaeb" s0)))
+
+;;; Trimming non-simple-strings when there is nothing to do
+(let ((a (make-array 10 :element-type 'character :initial-contents "abcde00000" :fill-pointer 5)))
+  (assert (equal "abcde" (string-right-trim "Z" a))))
+
+;;; Trimming non-strings when there is nothing to do.
+(string-right-trim " " #\a)
+

diff --git a/version.lisp-expr b/version.lisp-expr
index d47865f..c60af46 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".)
-"1.0.17.41"
+"1.0.17.42"