From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 3 Jun 2008 15:27:21 +0000 (+0000)
Subject: 1.0.17.22: respect fill-pointers when trimming strings (regression 1.0.12.23)
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2d9524f6c89f3cf6794b5bd262778fff856a7777;p=sbcl.git

1.0.17.22: respect fill-pointers when trimming strings (regression 1.0.12.23)

 * Revealed by ansi-tests.
---

diff --git a/NEWS b/NEWS
index 5141699..36c8581 100644
--- a/NEWS
+++ b/NEWS
@@ -19,6 +19,8 @@ changes in sbcl-1.0.18 relative to 1.0.17:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** NIL is a valid function name (regression at 1.0.13.38)
     ** FILL on lists was missing its return value (regression at 1.0.12.27)
+    ** STRING-TRIM, STRING-LEFT-TRIM, and STRING-RIGHT-TRIMP did not respect
+       fill pointers properly (regression at 1.0.12.23)
 
 changes in sbcl-1.0.17 relative to 1.0.16:
   * temporary regression: user code can no longer allocate closure
diff --git a/src/code/string.lisp b/src/code/string.lisp
index dede948..439371b 100644
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -423,9 +423,9 @@ new string COUNT long filled with the fill character."
                                               :test #'char=)))
                                (1+ index))
                             (declare (fixnum index)))
-                          (length string))))
+                          end)))
       (if (and (eql left-end 0)
-               (eql right-end (length string)))
+               (eql right-end end))
           string
           (subseq (the simple-string string) left-end right-end)))))
 
diff --git a/tests/string.pure.lisp b/tests/string.pure.lisp
index 82ccc94..cd96fb1 100644
--- a/tests/string.pure.lisp
+++ b/tests/string.pure.lisp
@@ -119,3 +119,11 @@
   (make-test " x x " "x x " " x x" "x x"))
 
 
+;;; Trimming should respect fill-pointers
+(let* ((s (make-array 9 :initial-contents "abcdabadd" :element-type
+                      'character :fill-pointer 7))
+       (s2 (string-left-trim "ab" s))
+       (s3 (string-right-trim "ab" s)))
+  (assert (equal "abcdaba" s))
+  (assert (equal "cdaba" s2))
+  (assert (equal "abcd" s3)))
diff --git a/version.lisp-expr b/version.lisp-expr
index fb141ad..3ac39ea 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".)
-"1.0.17.21"
+"1.0.17.22"