From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#24264: 25.1; cl-seq: Several funcs give wrong result if (length seq) >= 8000000 Date: Fri, 19 Aug 2016 16:19:55 +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 1471591285 17741 195.159.176.226 (19 Aug 2016 07:21:25 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 19 Aug 2016 07:21:25 +0000 (UTC) User-Agent: Alpine 2.20 (DEB 67 2015-01-07) To: 24264@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Aug 19 09:21:19 2016 Return-path: Envelope-to: geb-bug-gnu-emacs@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 1bae7C-0004Hc-SE for geb-bug-gnu-emacs@m.gmane.org; Fri, 19 Aug 2016 09:21:19 +0200 Original-Received: from localhost ([::1]:55763 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae79-0001OJ-NE for geb-bug-gnu-emacs@m.gmane.org; Fri, 19 Aug 2016 03:21:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43171) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae71-0001O2-Pv for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:21:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bae6w-0001q6-Jg for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:21:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36075) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae6w-0001q2-GH for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:21:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bae6w-0004mD-DD for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:21:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 19 Aug 2016 07:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 24264 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.147159122318284 (code B ref -1); Fri, 19 Aug 2016 07:21:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 19 Aug 2016 07:20:23 +0000 Original-Received: from localhost ([127.0.0.1]:33787 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bae6I-0004ko-HD for submit@debbugs.gnu.org; Fri, 19 Aug 2016 03:20:22 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:52021) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bae6H-0004kd-3B for submit@debbugs.gnu.org; Fri, 19 Aug 2016 03:20:21 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bae6A-0001kr-2c for submit@debbugs.gnu.org; Fri, 19 Aug 2016 03:20:15 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:39253) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae69-0001kl-VF for submit@debbugs.gnu.org; Fri, 19 Aug 2016 03:20:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42978) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae66-0001IM-SS for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:20:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bae60-0001ex-Q2 for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:20:09 -0400 Original-Received: from mail-pa0-x244.google.com ([2607:f8b0:400e:c03::244]:35658) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bae60-0001eq-Ea for bug-gnu-emacs@gnu.org; Fri, 19 Aug 2016 03:20:04 -0400 Original-Received: by mail-pa0-x244.google.com with SMTP id cf3so3005154pad.2 for ; Fri, 19 Aug 2016 00:20:04 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:date:to:subject:message-id:user-agent:mime-version; bh=UXe9eXKlKQvUbHn4N7BmLAinRz+ZDnp6WkDxGm9bfv0=; b=laaMi7KRIcMg7XZGaFRXiCE0sbmTYnLuTXQYUeRJfpBKYO0AEbKmd8ixW6AtGYbgKW AcdIGPcUvQRVaaBGzmvrQMvn5NV9JjUPm2KwtjmIsujScJVYJfMXYB79OtLSYKVRdM6H AlncppCZMI8oQl7PvqviNnu6w0qhSJhDur3V5+eQFGx5qhk3zKmMHxzoKX8B9y7O8PKw SHEkMwIEQhlYXzn5ftwfrCMQYo6q+UP68mWr4kTtXye4NhjZx+v19/smk4Qog1n9X8WU 9eJSIRmqoLODsICIaWxorK0sUSizvtO7R6rdBg7ePwVymSCoBUpz1R3L2Ck4XL0V/8O/ EPvA== 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:subject:message-id:user-agent :mime-version; bh=UXe9eXKlKQvUbHn4N7BmLAinRz+ZDnp6WkDxGm9bfv0=; b=f37WlHPaeFD58cZs5H8UZQql+cFC0vbfrLw5+1iwyYf1bbregU9vVYkDxZ1BS4aC5/ vjZdqOGXRkQeo2FJP64E05xMUB5tW1tMDLtfNjLH37Jsb4Nj4Un14ozodh11/LSoAvpQ sFRad8rcapN0hcHcnUJB/lF6M1rkwIpX6HYiluHIXYMhoTetcKnjUNCyFP5J2/EykoaS U6dp/u0ykvEtwUUfi993YAgVw82gKv6Ofe+l2R27E9GrUJUQIXJqIUCcGlSlfvFvffPd N0qwNsK1iGucnl7hZoFu2IkbPJY+uRiXpEDWPuJa7CdIul51W628pGg+4EI4THqZsBrT r5xw== X-Gm-Message-State: AEkoous0V6xcKXUV86W9gSQSeaCuh8gLw+LWwh+Wx0OnmDslOCgjvbvU2VDyB3X4Jl6uvA== X-Received: by 10.66.132.11 with SMTP id oq11mr11131310pab.4.1471591203378; Fri, 19 Aug 2016 00:20:03 -0700 (PDT) Original-Received: from calancha-pc (214018171106.wi-fi.kddi.com. [106.171.18.214]) by smtp.gmail.com with ESMTPSA id xv9sm8674834pab.36.2016.08.19.00.20.01 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 19 Aug 2016 00:20:02 -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-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:122378 Archived-At: 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 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