0.7.9.23:

	Fix the NSUBSTITUTE (and friends) bug relating to lists, start,
		end and from-end, as reported by Paul Dietz' test suite
		from the gcl distribution.
	... just recalculate bounding indices if FROM-END is non-NIL.

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 77e232e..0c9448b 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -1775,9 +1775,11 @@
     (declare (fixnum count))
     (if (listp sequence)
        (if from-end
-           (nreverse (nlist-substitute*
-                      new old (nreverse (the list sequence))
-                      test test-not start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute*
+                        new old (nreverse (the list sequence))
+                        test test-not (- length end) (- length start)
+                        count key)))
            (nlist-substitute* new old sequence
                               test test-not start end count key))
        (if from-end
@@ -1825,9 +1827,10 @@
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end
-           (nreverse (nlist-substitute-if*
-                      new test (nreverse (the list sequence))
-                      start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute-if*
+                        new test (nreverse (the list sequence))
+                        (- length end) (- length start) count key)))
            (nlist-substitute-if* new test sequence
                                  start end count key))
        (if from-end
@@ -1865,9 +1868,10 @@
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end
-           (nreverse (nlist-substitute-if-not*
-                      new test (nreverse (the list sequence))
-                      start end count key))
+           (let ((length (length sequence)))
+             (nreverse (nlist-substitute-if-not*
+                        new test (nreverse (the list sequence))
+                        (- length end) (- length start) count key)))
            (nlist-substitute-if-not* new test sequence
                                      start end count key))
        (if from-end

diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index 0ca3b1f..aa7cef7 100644 (file)
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -11,6 +11,9 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
+;;; As reported by Paul Dietz from his ansi-test suite for gcl, REMOVE
+;;; malfunctioned when given :START, :END and :FROM-END arguments.
+;;; Make sure it doesn't happen again.
 (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
        (x (copy-seq orig))
        (y (remove 3 x :from-end t :start 1 :end 5))
@@ -18,3 +21,46 @@
   (assert (equalp orig x))
   (assert (equalp y '(1 2 2 6 1 2 4 1 3 2 7)))
   (assert (equalp z '(1 3 6 1 2 4 1 3 2 7))))
+
+;;; Similarly, NSUBSTITUTE and friends were getting things wrong with
+;;; :START, :END and :FROM-END:
+(assert
+ (loop for i from 0 to 9 always
+       (loop for j from i to 10 always
+            (loop for c from 0 to (- j i) always
+                  (let* ((orig '(a a a a a a a a a a))
+                         (x (copy-seq orig))
+                         (y (nsubstitute 'x 'a x :start i :end j :count c)))
+                    (equal y (nconc (make-list i :initial-element 'a)
+                                    (make-list c :initial-element 'x)
+                                    (make-list (- 10 (+ i c))
+                                               :initial-element 'a))))))))
+
+(assert
+ (loop for i from 0 to 9 always
+       (loop for j from i to 10 always
+            (loop for c from 0 to (- j i) always
+                  (let* ((orig '(a a a a a a a a a a))
+                         (x (copy-seq orig))
+                         (y (nsubstitute-if 'x (lambda (x) (eq x 'a)) x
+                                            :start i :end j
+                                            :count c :from-end t)))
+                    (equal y (nconc (make-list (- j c) :initial-element 'a)
+                                    (make-list c :initial-element 'x)
+                                    (make-list (- 10 j)
+                                               :initial-element 'a))))))))
+(assert
+ (loop for i from 0 to 9 always
+       (loop for j from i to 10 always
+            (loop for c from 0 to (- j i) always
+                  (let* ((orig '(a a a a a a a a a a))
+                         (x (copy-seq orig))
+                         (y (nsubstitute-if-not 'x (lambda (x)
+                                                     (not (eq x 'a))) x
+                                                :start i :end j
+                                                :count c :from-end t)))
+                    (equal y (nconc (make-list (- j c) :initial-element 'a)
+                                    (make-list c :initial-element 'x)
+                                    (make-list (- 10 j)
+                                               :initial-element 'a))))))))
+

diff --git a/version.lisp-expr b/version.lisp-expr
index b08c868..16fbf4c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.22"
+"0.7.9.23"