From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: [PATCH]: suggest fix to Bug#24264 Date: Tue, 11 Oct 2016 19:00:41 +0900 (JST) Message-ID: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Trace: blaine.gmane.org 1476180086 13452 195.159.176.226 (11 Oct 2016 10:01:26 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 11 Oct 2016 10:01:26 +0000 (UTC) User-Agent: Alpine 2.20 (DEB 67 2015-01-07) Cc: Tino Calancha To: Emacs developers Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Oct 11 12:01:21 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bttrr-0000vK-PY for ged-emacs-devel@m.gmane.org; Tue, 11 Oct 2016 12:01:04 +0200 Original-Received: from localhost ([::1]:54696 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bttrq-00069i-8T for ged-emacs-devel@m.gmane.org; Tue, 11 Oct 2016 06:01:02 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45567) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bttrf-00069E-1u for emacs-devel@gnu.org; Tue, 11 Oct 2016 06:00:56 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bttrZ-0003sn-OV for emacs-devel@gnu.org; Tue, 11 Oct 2016 06:00:50 -0400 Original-Received: from mail-pa0-x244.google.com ([2607:f8b0:400e:c03::244]:35569) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bttrZ-0003s2-Au for emacs-devel@gnu.org; Tue, 11 Oct 2016 06:00:45 -0400 Original-Received: by mail-pa0-x244.google.com with SMTP id qn10so1345192pac.2 for ; Tue, 11 Oct 2016 03:00:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:date:to:cc:subject:message-id:user-agent:mime-version; bh=yBNr+fsODrvO9+IYY0SCckb1vyuHmsK5h9cTGMzl9jg=; b=dThMvnzX/mevMFN1PjeGam8eR2ygc+eDb8Uln+92al0wBF33PO+T28fNp/MGRugppH LFnJvbu/vj10jG8scGEPSOi3EfLtSsEzsM++tVWU5n7gV4pLJPlJEgLVi/q9iffqP3JY pvYL4+KKMYc7/OghyytnOJO3nRgi8jSzp6GRzZLcfCsFsTXV39Fv2w4WRLrAiVCraTWK Pc+VcKtZaeNBI0qvqx+LnKRoPXv7o9qUZL2io3LGSekri/lszHBGDQKljvZc92MW3PKP LNKho5I27qRjiFiz4Hwq73ywWCbDnVe1DKw3GNOQu+YIrlHkEC7c5UzfDy1ROX45qi3V sVZQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:date:to:cc:subject:message-id:user-agent :mime-version; bh=yBNr+fsODrvO9+IYY0SCckb1vyuHmsK5h9cTGMzl9jg=; b=f4OCs6uDDZcyF6hIVaDi7BqtZRGLnudzh1lBnC3+9beyvu67rdYKbdTbI7FCPEqSw6 d6pOxlzhNehrghyHTkvg485OWimoqtpdHTpc1oLec97VcweO/C7XDFbVxqIWd32HKZoL KBZi0d4QV7JVFVsuSods7v3Gg1dw57LOTkGPCO+/MwoCwM7IEI1cmuRnqFaaf5SGO3TS Ygpe1+5yVq0UuxT/MrzF9nOfhrEgf6vluwhlgj9QyR8GGFzHO7QfguRkTZbDEUWslidn UwWYyESHmQ7ZMdvUsmIozkFofLxWui3ufd132BePHo9/k5k0tCVQSvCCM2hh/+jKUwR1 0CMg== X-Gm-Message-State: AA6/9RnD0Y5v3sGqWVykhiiL4NtPnllPoVL+8fN9OUhFhmiRgqh+2rcyYqhk6Lef68X5aw== X-Received: by 10.66.16.74 with SMTP id e10mr5576418pad.148.1476180044108; Tue, 11 Oct 2016 03:00:44 -0700 (PDT) Original-Received: from calancha-pc (57.92.100.220.dy.bbexcite.jp. [220.100.92.57]) by smtp.gmail.com with ESMTPSA id h130sm3363298pfe.35.2016.10.11.03.00.42 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 11 Oct 2016 03:00:43 -0700 (PDT) X-Google-Original-From: Tino Calancha X-X-Sender: calancha@calancha-pc X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2607:f8b0:400e:c03::244 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:208155 Archived-At: 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 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