unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
@ 2016-08-19  7:19 Tino Calancha
  2016-08-19  7:45 ` Eli Zaretskii
  2016-10-11  8:59 ` Tino Calancha
  0 siblings, 2 replies; 8+ messages in thread
From: Tino Calancha @ 2016-08-19  7:19 UTC (permalink / raw)
  To: 24264


For several functions, there is a cutoff, 8000000, in the maximum
length of the input sequence.  When the input sequence is larger
than this cutoff, no error is signaled, and the functions return
with a wrong result.

This bug has being around since cl-seq was added into Emacs in 1993.


emacs -Q:

;; Evaluate following form:
(let* ((list  (append (make-list 8000005 1) '(8)))
        (orig  (copy-sequence list))) ; To recover list from side effects.
   (require 'cl-seq)
   (insert (format "1) (cl-position 8 list): %S (exp: 8000005)\n" 
(cl-position 8 list)))
   (insert (format "2) (last list): %S (exp: (8))\n" (last list)))
   (insert (format "3) (last (cl-remove 8 list)): %S (exp: (1))\n" (last 
(cl-remove 8 list))))
   (insert (format "4) (last (cl-delete 8 list)): %S (exp: (1))\n" (last 
(cl-delete 8 list))))
   (setq list (copy-sequence orig))
   (insert (format "5) (last (cl-substitute 2 1 list) 2): %S (exp: (2 
8))\n" (last (cl-substitute 2 1 list) 2)))
   (insert (format "6) (last (cl-nsubstitute 2 1 list) 2): %S (exp: (2 
8))\n" (last (cl-nsubstitute 2 1 list) 2)))
   (setq list (copy-sequence orig))
   (cl-fill list 9)
   (insert (format "7) (last list 2)): %S (exp: (9 9))\n" (last list 2)))
   (setq list (copy-sequence orig))
   (cl-replace list (make-list 8000001 2))
   (insert (format "8) (last list 6): %S (exp: (2 1 1 1 1 8))\n" (last list 
6)))
   (insert (format "9) (car list): %S (exp: 2)\n" (car list)))
   (insert (format "10) (cl-position 1 list): %S (exp: 8000001)\n" 
(cl-position 1 list))))
;; I get the following:
1) (cl-position 8 list): nil (exp: 8000005)
2) (last list): (8) (exp: (8))
3) (last (cl-remove 8 list)): (8) (exp: (1))
4) (last (cl-delete 8 list)): (8) (exp: (1))
5) (last (cl-substitute 2 1 list) 2): (1 8) (exp: (2 8))
6) (last (cl-nsubstitute 2 1 list) 2): (1 8) (exp: (2 8))
7) (last list 2)): (1 8) (exp: (9 9))
8) (last list 6): (1 1 1 1 1 8) (exp: (2 1 1 1 1 8))
9) (car list): 2 (exp: 2)
10) (cl-position 1 list): 4000000 (exp: 8000001)
nil

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 8a39449252bc30969399d79c15dfd3ef3d3e9e69 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Fri, 19 Aug 2016 16:10:05 +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).
---
  lisp/emacs-lisp/cl-seq.el | 68 
++++++++++++++++++++++++++---------------------
  1 file changed, 38 insertions(+), 30 deletions(-)

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 21aec6c..acd20cc 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -141,8 +141,8 @@ cl-fill
    (cl--parsing-keywords ((:start 0) :end) ()
      (if (listp seq)
  	(let ((p (nthcdr cl-start 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 item)
  	    (setq p (cdr p))))
        (or cl-end (setq cl-end (length seq)))
@@ -170,16 +170,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)))))
@@ -205,9 +209,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
@@ -219,7 +224,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))
@@ -240,7 +245,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)
@@ -268,10 +273,11 @@ 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
@@ -281,7 +287,7 @@ cl-delete
  		      (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
@@ -302,7 +308,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)
@@ -385,15 +391,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))))))

@@ -423,17 +431,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))
@@ -446,7 +455,7 @@ cl-nsubstitute
  		  (progn
  		    (aset cl-seq cl-start cl-new)
  		    (setq cl-count (1- cl-count))))
-	      (setq cl-start (1+ cl-start))))))
+	      (cl-incf cl-start))))))
      cl-seq))

  ;;;###autoload
@@ -502,14 +511,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
-- 
2.8.1


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

In GNU Emacs 25.1.1 (x86_64-pc-linux-gnu, GTK+ Version 3.20.7)
  of 2016-08-19 built on calancha-pc
Repository revision: 37d4723f73998ecbf30e9f655026422b0e2017a7






^ permalink raw reply related	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-08-19  7:19 bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000 Tino Calancha
@ 2016-08-19  7:45 ` Eli Zaretskii
  2016-08-19  8:11   ` Tino Calancha
  2016-10-11  8:59 ` Tino Calancha
  1 sibling, 1 reply; 8+ messages in thread
From: Eli Zaretskii @ 2016-08-19  7:45 UTC (permalink / raw)
  To: Tino Calancha; +Cc: 24264

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Fri, 19 Aug 2016 16:19:55 +0900 (JST)
> 
> >From 8a39449252bc30969399d79c15dfd3ef3d3e9e69 Mon Sep 17 00:00:00 2001
> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Fri, 19 Aug 2016 16:10:05 +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).

Thanks.

When you fix a bug, please always include a test for that bugfix, if
doing that is practical (as it is in this case).





^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-08-19  7:45 ` Eli Zaretskii
@ 2016-08-19  8:11   ` Tino Calancha
  2016-08-19  9:05     ` Eli Zaretskii
  0 siblings, 1 reply; 8+ messages in thread
From: Tino Calancha @ 2016-08-19  8:11 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 24264, Tino Calancha



> When you fix a bug, please always include a test for that bugfix, if
> doing that is practical (as it is in this case).
Ok thanks.
I just added the tests, see commit:
a4fa31150f186611ad083c3387e3cb2c5d25f991

I've being heavily testing this issue last 2 weeks.
The fix looks solid.


Regards,
Tino





^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-08-19  8:11   ` Tino Calancha
@ 2016-08-19  9:05     ` Eli Zaretskii
  2016-08-19 11:20       ` Tino Calancha
  0 siblings, 1 reply; 8+ messages in thread
From: Eli Zaretskii @ 2016-08-19  9:05 UTC (permalink / raw)
  To: Tino Calancha; +Cc: 24264

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Fri, 19 Aug 2016 17:11:32 +0900 (JST)
> cc: Tino Calancha <tino.calancha@gmail.com>, 24264@debbugs.gnu.org
> 
> > When you fix a bug, please always include a test for that bugfix, if
> > doing that is practical (as it is in this case).
> Ok thanks.
> I just added the tests, see commit:
> a4fa31150f186611ad083c3387e3cb2c5d25f991

Thanks.

> I've being heavily testing this issue last 2 weeks.
> The fix looks solid.

My comment wasn't intended to hint that I don't believe your fix is
correct; I do.  The purpose of having a test for each bug we fix is so
we never regress to have that bug again in the future.





^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-08-19  9:05     ` Eli Zaretskii
@ 2016-08-19 11:20       ` Tino Calancha
  0 siblings, 0 replies; 8+ messages in thread
From: Tino Calancha @ 2016-08-19 11:20 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 24264, Tino Calancha



On Fri, 19 Aug 2016, Eli Zaretskii wrote:

> The purpose of having a test for each bug we fix is so
> we never regress to have that bug again in the future.
No problem, i understood the meaning correctly :-)
Thank you.







^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-08-19  7:19 bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000 Tino Calancha
  2016-08-19  7:45 ` Eli Zaretskii
@ 2016-10-11  8:59 ` Tino Calancha
  2016-10-11  9:21   ` Eli Zaretskii
  1 sibling, 1 reply; 8+ messages in thread
From: Tino Calancha @ 2016-10-11  8:59 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 24264

Tino Calancha <tino.calancha@gmail.com> writes:

> For several functions, there is a cutoff, 8000000, in the maximum
> length of the input sequence.  When the input sequence is larger
> than this cutoff, no error is signaled, and the functions return
> with a wrong result.
Eli, i it OK if i push the fix for this bug to the master branch?
There is no comments after almost 2 months.





^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-10-11  8:59 ` Tino Calancha
@ 2016-10-11  9:21   ` Eli Zaretskii
  2016-10-20 11:01     ` Tino Calancha
  0 siblings, 1 reply; 8+ messages in thread
From: Eli Zaretskii @ 2016-10-11  9:21 UTC (permalink / raw)
  To: Tino Calancha; +Cc: 24264

> From: Tino Calancha <tino.calancha@gmail.com>
> CC: 24264@debbugs.gnu.org
> Date: Tue, 11 Oct 2016 17:59:34 +0900
> 
> Tino Calancha <tino.calancha@gmail.com> writes:
> 
> > For several functions, there is a cutoff, 8000000, in the maximum
> > length of the input sequence.  When the input sequence is larger
> > than this cutoff, no error is signaled, and the functions return
> > with a wrong result.
> Eli, i it OK if i push the fix for this bug to the master branch?
> There is no comments after almost 2 months.

Please ask on emacs-devel for last-opportunity comments, and if no one
objects in a week, please push to master.

Thanks.





^ permalink raw reply	[flat|nested] 8+ messages in thread

* bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000
  2016-10-11  9:21   ` Eli Zaretskii
@ 2016-10-20 11:01     ` Tino Calancha
  0 siblings, 0 replies; 8+ messages in thread
From: Tino Calancha @ 2016-10-20 11:01 UTC (permalink / raw)
  To: 24264-done

Eli Zaretskii <eliz@gnu.org> writes:

> Please ask on emacs-devel for last-opportunity comments, and if no one
> objects in a week, please push to master.
Pushed fix to master branch as commit f63a4b82





^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2016-10-20 11:01 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-08-19  7:19 bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000 Tino Calancha
2016-08-19  7:45 ` Eli Zaretskii
2016-08-19  8:11   ` Tino Calancha
2016-08-19  9:05     ` Eli Zaretskii
2016-08-19 11:20       ` Tino Calancha
2016-10-11  8:59 ` Tino Calancha
2016-10-11  9:21   ` Eli Zaretskii
2016-10-20 11:01     ` Tino Calancha

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).