From 967c14df90ace8b868280d93deabfd6742fb769d Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 31 Oct 2002 18:48:44 +0000
Subject: [PATCH] 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.

---
 src/code/seq.lisp   |   22 +++++++++++++---------
 tests/seq.pure.lisp |   46 ++++++++++++++++++++++++++++++++++++++++++++++
 version.lisp-expr   |    2 +-
 3 files changed, 60 insertions(+), 10 deletions(-)

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 77e232e..0c9448b 100644
--- 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
--- 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
--- 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"
-- 
1.7.10.4