[PATCH]: suggest fix to Bug#24264

[Tino Calancha]

Hello Emacs,

if there are no objections in one week from now i would like
to apply following patch in master branch to fix #Bug24264:

Thank you.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> From d57af0ee29a4f93dd5acbe496844cab8236cedee Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Tue, 11 Oct 2016 18:52:22 +0900
Subject: [PATCH] cl-seq: Remove max limit on input sequence length

* lisp/emacs-lisp/cl-seq.el (cl-fill, cl-replace, cl-delete)
(cl--position, cl-nsubstitute, cl-substitute, cl-remove):
Remove limit on maximum length for the input sequence
(#Bug24264).
* test/lisp/emacs-lisp/cl-seq-tests.el: Update test result as passed.
---
 lisp/emacs-lisp/cl-seq.el            | 70 ++++++++++++++++++++----------------
 test/lisp/emacs-lisp/cl-seq-tests.el |  1 -
 2 files changed, 39 insertions(+), 32 deletions(-)

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index ed27b7c..3f8b1ee 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -151,8 +151,8 @@ cl-fill
   (cl--parsing-keywords ((:start 0) :end) ()
     (if (listp cl-seq)
        (let ((p (nthcdr cl-start cl-seq))
-             (n (if cl-end (- cl-end cl-start) 8000000)))
-         (while (and p (>= (setq n (1- n)) 0))
+             (n (and cl-end (- cl-end cl-start))))
+         (while (and p (or (null n) (>= (cl-decf n) 0)))
            (setcar p cl-item)
            (setq p (cdr p))))
       (or cl-end (setq cl-end (length cl-seq)))
@@ -180,16 +180,20 @@ cl-replace
                            (elt cl-seq2 (+ cl-start2 cl-n))))))
       (if (listp cl-seq1)
          (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-               (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
+               (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
            (if (listp cl-seq2)
                (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-                     (cl-n (min cl-n1
-                                (if cl-end2 (- cl-end2 cl-start2) 4000000))))
-                 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
+                     (cl-n (cond ((and cl-n1 cl-end2)
+                                  (min cl-n1 (- cl-end2 cl-start2)))
+                                 ((and cl-n1 (null cl-end2)) cl-n1)
+                                 ((and (null cl-n1) cl-end2) (- cl-end2 
cl-start2)))))
+                 (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 
0)))
                    (setcar cl-p1 (car cl-p2))
                    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
-             (setq cl-end2 (min (or cl-end2 (length cl-seq2))
-                                (+ cl-start2 cl-n1)))
+             (setq cl-end2 (if (null cl-n1)
+                               (or cl-end2 (length cl-seq2))
+                             (min (or cl-end2 (length cl-seq2))
+                                  (+ cl-start2 cl-n1))))
              (while (and cl-p1 (< cl-start2 cl-end2))
                (setcar cl-p1 (aref cl-seq2 cl-start2))
                (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
@@ -215,9 +219,10 @@ cl-remove
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
                        (:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
+    (let ((len (length cl-seq)))
+      (if (<= (or cl-count (setq cl-count len)) 0)
        cl-seq
-      (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
+        (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
          (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
                                     cl-from-end)))
            (if cl-i
@@ -229,7 +234,7 @@ cl-remove
                  (if (listp cl-seq) cl-res
                    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
              cl-seq))
-       (setq cl-end (- (or cl-end 8000000) cl-start))
+         (setq cl-end (- (or cl-end len) cl-start))
        (if (= cl-start 0)
            (while (and cl-seq (> cl-end 0)
                        (cl--check-test cl-item (car cl-seq))
@@ -250,7 +255,7 @@ cl-remove
                                       :start 0 :end (1- cl-end)
                                       :count (1- cl-count) cl-keys))))
                cl-seq))
-         cl-seq)))))
+         cl-seq))))))

 ;;;###autoload
 (defun cl-remove-if (cl-pred cl-list &rest cl-keys)
@@ -278,20 +283,21 @@ cl-delete
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
                        (:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
+    (let ((len (length cl-seq)))
+      (if (<= (or cl-count (setq cl-count len)) 0)
        cl-seq
       (if (listp cl-seq)
-         (if (and cl-from-end (< cl-count 4000000))
+         (if (and cl-from-end (< cl-count (/ len 2)))
              (let (cl-i)
                (while (and (>= (setq cl-count (1- cl-count)) 0)
                            (setq cl-i (cl--position cl-item cl-seq cl-start
-                                                     cl-end cl-from-end)))
+                                                    cl-end cl-from-end)))
                  (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
                    (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
                      (setcdr cl-tail (cdr (cdr cl-tail)))))
                  (setq cl-end cl-i))
                cl-seq)
-           (setq cl-end (- (or cl-end 8000000) cl-start))
+           (setq cl-end (- (or cl-end len) cl-start))
            (if (= cl-start 0)
                (progn
                  (while (and cl-seq
@@ -312,7 +318,7 @@ cl-delete
                      (setq cl-p (cdr cl-p)))
                    (setq cl-end (1- cl-end)))))
            cl-seq)
-       (apply 'cl-remove cl-item cl-seq cl-keys)))))
+       (apply 'cl-remove cl-item cl-seq cl-keys))))))

 ;;;###autoload
 (defun cl-delete-if (cl-pred cl-list &rest cl-keys)
@@ -396,15 +402,17 @@ cl-substitute
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
                        (:start 0) :end :from-end) ()
     (if (or (eq cl-old cl-new)
-           (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
+           (<= (or cl-count (setq cl-from-end nil
+                                  cl-count (length cl-seq))) 0))
        cl-seq
       (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
        (if (not cl-i)
            cl-seq
          (setq cl-seq (copy-sequence cl-seq))
-         (or cl-from-end
-             (progn (setf (elt cl-seq cl-i) cl-new)
-                    (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
+         (unless cl-from-end
+           (setf (elt cl-seq cl-i) cl-new)
+           (cl-incf cl-i)
+           (cl-decf cl-count))
          (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
                 :start cl-i cl-keys))))))

@@ -434,17 +442,18 @@ cl-nsubstitute
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
                        (:start 0) :end :from-end) ()
-    (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
-       (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
+    (let ((len (length cl-seq)))
+      (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
+         (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
            (let ((cl-p (nthcdr cl-start cl-seq)))
-             (setq cl-end (- (or cl-end 8000000) cl-start))
+             (setq cl-end (- (or cl-end len) cl-start))
              (while (and cl-p (> cl-end 0) (> cl-count 0))
                (if (cl--check-test cl-old (car cl-p))
                    (progn
                      (setcar cl-p cl-new)
                      (setq cl-count (1- cl-count))))
                (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
-         (or cl-end (setq cl-end (length cl-seq)))
+           (or cl-end (setq cl-end len))
          (if cl-from-end
              (while (and (< cl-start cl-end) (> cl-count 0))
                (setq cl-end (1- cl-end))
@@ -457,7 +466,7 @@ cl-nsubstitute
                  (progn
                    (aset cl-seq cl-start cl-new)
                    (setq cl-count (1- cl-count))))
-             (setq cl-start (1+ cl-start))))))
+             (setq cl-start (1+ cl-start)))))))
     cl-seq))

 ;;;###autoload
@@ -513,14 +522,13 @@ cl-position

 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
   (if (listp cl-seq)
-      (let ((cl-p (nthcdr cl-start cl-seq)))
-       (or cl-end (setq cl-end 8000000))
-       (let ((cl-res nil))
-         (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
+      (let ((cl-p (nthcdr cl-start cl-seq))
+           cl-res)
+       (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null 
cl-res) cl-from-end))
            (if (cl--check-test cl-item (car cl-p))
                (setq cl-res cl-start))
            (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
-         cl-res))
+       cl-res)
     (or cl-end (setq cl-end (length cl-seq)))
     (if cl-from-end
        (progn
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el 
b/test/lisp/emacs-lisp/cl-seq-tests.el
index cc393f4..02d9246 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,7 +294,6 @@ cl-seq--with-side-effects

 (ert-deftest cl-seq-test-bug24264 ()
   "Test for http://debbugs.gnu.org/24264 ."
-  :expected-result :failed
   (let ((list  (append (make-list 8000005 1) '(8)))
         (list2 (make-list 8000005 2)))
     (should (cl-position 8 list))
--
2.9.3

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.1)
 of 2016-10-11
Repository revision: 9640e9f4e95cd95c04875e90a4ff638e1e51f977