From 163104568d17ece9ba441063cbed13d30ef2650d Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sun, 18 Feb 2018 14:32:10 +0300
Subject: [PATCH] Fix REPLACE and REPLACE transforms when copying zero
 elements.

The indexes can become -1 conflicting with the INDEX type.
---
 src/code/seq.lisp          | 26 ++++++++++++++------------
 src/compiler/seqtran.lisp  |  4 ++--
 tests/compiler-2.pure.lisp | 13 +++++++++++++
 3 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 7da6fa50b..20097d56f 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -689,8 +689,7 @@
 
 ;;;; REPLACE
 (defun vector-replace (vector1 vector2 start1 start2 end1 diff)
-  (declare (index start1 start2)
-           ((or (eql -1) index) end1)
+  (declare ((or (eql -1) index) start1 start2 end1)
            (optimize (sb!c::insert-array-bounds-checks 0))
            ((integer -1 1) diff))
   (let ((tag1 (%other-pointer-widetag vector1))
@@ -725,18 +724,21 @@
 (sb!xc:defmacro vector-replace-from-vector ()
   `(let ((nelts (min (- target-end target-start)
                      (- source-end source-start))))
-     (with-array-data ((data1 target-sequence) (start1 target-start) (end1 target-end))
-       (with-array-data ((data2 source-sequence) (start2 source-start) (end2 source-end))
+     (with-array-data ((data1 target-sequence) (start1 target-start) (end1))
+       (declare (ignore end1))
+       (let ((end1 (the fixnum (+ start1 nelts))))
          (if (and (eq target-sequence source-sequence)
-                  (> start1 start2))
-             (let ((nelts (min (- end1 start1)
-                               (- end2 start2))))
-               (vector-replace data1 data2
-                               (the fixnum (+ start1 (the fixnum nelts) -1))
-                               (the fixnum (+ start2 (the fixnum nelts) -1))
-                               (1- target-start)
+                  (> target-start source-start))
+             (let ((end (the fixnum (1- end1))))
+               (vector-replace data1 data1
+                               end
+                               (the fixnum (- end
+                                              (- target-start source-start)))
+                               (1- start1)
                                -1))
-             (vector-replace data1 data2 start1 start2 (the fixnum (+ start1 nelts)) 1))))
+             (with-array-data ((data2 source-sequence) (start2 source-start) (end2))
+               (declare (ignore end2))
+               (vector-replace data1 data2 start1 start2 end1 1)))))
      target-sequence))
 
 (sb!xc:defmacro list-replace-from-list ()
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 8bb663b69..8fed4ce34 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -963,9 +963,9 @@
                       ;; SEQ2 must be distinct arrays.
                       ,(eql sequence-type1 sequence-type2)
                       (eq seq1 seq2) (> start1 start2))
-                     (do ((i (truly-the index (+ start1 replace-len -1))
+                     (do ((i (truly-the (or (eql -1) index) (+ start1 replace-len -1))
                              (1- i))
-                          (j (truly-the index (+ start2 replace-len -1))
+                          (j (truly-the (or (eql -1) index) (+ start2 replace-len -1))
                              (1- j)))
                          ((< i start1))
                        (declare (optimize (insert-array-bounds-checks 0)))
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 8e67bdbff..6b5a5a8e3 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -1153,3 +1153,16 @@
                   ((member ,#'car "x" cdr) p4))
          (stable-sort p1 #'<= :key p4))
     (((vector '(2) '(3) '(1)) #'car) #((1) (2) (3)) :test #'equalp)))
+
+(with-test (:name :replace-zero-elements)
+  (checked-compile-and-assert
+      ()
+      '(lambda (x)
+        (declare ((simple-vector 2) x))
+        (replace x x :start1 2))
+    (((vector 1 2)) #(1 2) :test #'equalp))
+  (checked-compile-and-assert
+      ()
+      '(lambda (x)
+        (replace x x :start1 2))
+    (((vector 1 2)) #(1 2) :test #'equalp)))
-- 
2.11.4.GIT