From 8ee41eac134a552e07e966dd16d681e8216147fc Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 3 Jun 2008 16:00:15 +0000 Subject: [PATCH] 1.0.17.23: respect displacement indices when trimming strings (regression 1.0.12.23) * Revealed by ansi-tests. --- NEWS | 4 +++- src/code/string.lisp | 4 ++-- tests/string.pure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 4 files changed, 16 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 36c8581f0..348f80049 100644 --- a/NEWS +++ b/NEWS @@ -19,8 +19,10 @@ 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 + ** STRING-TRIM, STRING-LEFT-TRIM, and STRING-RIGHT-TRIM did not respect fill pointers properly (regression at 1.0.12.23) + ** STRING-TRIM, STRING-LEFT-TRIM, and STRING-RIGHT-TRIM did not respect + displacement indices 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 439371bdd..de97aa906 100644 --- a/src/code/string.lisp +++ b/src/code/string.lisp @@ -414,7 +414,7 @@ new string COUNT long filled with the fill character." :test #'char=))) index) (declare (fixnum index))) - 0)) + start)) (right-end (if right-p (do ((index (1- (the fixnum end)) (1- index))) ((or (< index left-end) @@ -424,7 +424,7 @@ new string COUNT long filled with the fill character." (1+ index)) (declare (fixnum index))) end))) - (if (and (eql left-end 0) + (if (and (eql left-end start) (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 cd96fb1ef..13da95df5 100644 --- a/tests/string.pure.lisp +++ b/tests/string.pure.lisp @@ -127,3 +127,13 @@ (assert (equal "abcdaba" s)) (assert (equal "cdaba" s2)) (assert (equal "abcd" s3))) + +;;; Trimming should replace displacement offsets +(let* ((etype 'base-char) + (s0 + (make-array '(6) :initial-contents "abcaeb" :element-type etype)) + (s + (make-array '(3) :element-type etype :displaced-to s0 :displaced-index-offset 1))) + (assert (equal "bc" (string-right-trim "ab" s))) + (assert (equal "bca" s)) + (assert (equal "abcaeb" s0))) diff --git a/version.lisp-expr b/version.lisp-expr index 3ac39ea7b..5d8d32def 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.22" +"1.0.17.23" -- 2.11.4.GIT