diff options
| author | Tino Calancha | 2016-10-20 19:51:55 +0900 |
|---|---|---|
| committer | Tino Calancha | 2016-10-20 19:51:55 +0900 |
| commit | f63a4b82f0e8634a76e4e7794bb7c7c4e734c4ba (patch) | |
| tree | 33fde3abfa871ba42ca1c252836fba89078132aa | |
| parent | 10a2239627bd5369bf46d013eb7cfbe27553c8d9 (diff) | |
| download | emacs-f63a4b82f0e8634a76e4e7794bb7c7c4e734c4ba.tar.gz emacs-f63a4b82f0e8634a76e4e7794bb7c7c4e734c4ba.zip | |
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 expected result as passed.
| -rw-r--r-- | lisp/emacs-lisp/cl-seq.el | 70 | ||||
| -rw-r--r-- | 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 ed27b7c7d05..3f8b1eec66e 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el | |||
| @@ -151,8 +151,8 @@ called. | |||
| 151 | (cl--parsing-keywords ((:start 0) :end) () | 151 | (cl--parsing-keywords ((:start 0) :end) () |
| 152 | (if (listp cl-seq) | 152 | (if (listp cl-seq) |
| 153 | (let ((p (nthcdr cl-start cl-seq)) | 153 | (let ((p (nthcdr cl-start cl-seq)) |
| 154 | (n (if cl-end (- cl-end cl-start) 8000000))) | 154 | (n (and cl-end (- cl-end cl-start)))) |
| 155 | (while (and p (>= (setq n (1- n)) 0)) | 155 | (while (and p (or (null n) (>= (cl-decf n) 0))) |
| 156 | (setcar p cl-item) | 156 | (setcar p cl-item) |
| 157 | (setq p (cdr p)))) | 157 | (setq p (cdr p)))) |
| 158 | (or cl-end (setq cl-end (length cl-seq))) | 158 | (or cl-end (setq cl-end (length cl-seq))) |
| @@ -180,16 +180,20 @@ SEQ1 is destructively modified, then returned. | |||
| 180 | (elt cl-seq2 (+ cl-start2 cl-n)))))) | 180 | (elt cl-seq2 (+ cl-start2 cl-n)))))) |
| 181 | (if (listp cl-seq1) | 181 | (if (listp cl-seq1) |
| 182 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) | 182 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) |
| 183 | (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) | 183 | (cl-n1 (and cl-end1 (- cl-end1 cl-start1)))) |
| 184 | (if (listp cl-seq2) | 184 | (if (listp cl-seq2) |
| 185 | (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) | 185 | (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) |
| 186 | (cl-n (min cl-n1 | 186 | (cl-n (cond ((and cl-n1 cl-end2) |
| 187 | (if cl-end2 (- cl-end2 cl-start2) 4000000)))) | 187 | (min cl-n1 (- cl-end2 cl-start2))) |
| 188 | (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) | 188 | ((and cl-n1 (null cl-end2)) cl-n1) |
| 189 | ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2))))) | ||
| 190 | (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0))) | ||
| 189 | (setcar cl-p1 (car cl-p2)) | 191 | (setcar cl-p1 (car cl-p2)) |
| 190 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) | 192 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) |
| 191 | (setq cl-end2 (min (or cl-end2 (length cl-seq2)) | 193 | (setq cl-end2 (if (null cl-n1) |
| 192 | (+ cl-start2 cl-n1))) | 194 | (or cl-end2 (length cl-seq2)) |
| 195 | (min (or cl-end2 (length cl-seq2)) | ||
| 196 | (+ cl-start2 cl-n1)))) | ||
| 193 | (while (and cl-p1 (< cl-start2 cl-end2)) | 197 | (while (and cl-p1 (< cl-start2 cl-end2)) |
| 194 | (setcar cl-p1 (aref cl-seq2 cl-start2)) | 198 | (setcar cl-p1 (aref cl-seq2 cl-start2)) |
| 195 | (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) | 199 | (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) |
| @@ -215,9 +219,10 @@ to avoid corrupting the original SEQ. | |||
| 215 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" | 219 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" |
| 216 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end | 220 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end |
| 217 | (:start 0) :end) () | 221 | (:start 0) :end) () |
| 218 | (if (<= (or cl-count (setq cl-count 8000000)) 0) | 222 | (let ((len (length cl-seq))) |
| 223 | (if (<= (or cl-count (setq cl-count len)) 0) | ||
| 219 | cl-seq | 224 | cl-seq |
| 220 | (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) | 225 | (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2)))) |
| 221 | (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end | 226 | (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end |
| 222 | cl-from-end))) | 227 | cl-from-end))) |
| 223 | (if cl-i | 228 | (if cl-i |
| @@ -229,7 +234,7 @@ to avoid corrupting the original SEQ. | |||
| 229 | (if (listp cl-seq) cl-res | 234 | (if (listp cl-seq) cl-res |
| 230 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) | 235 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) |
| 231 | cl-seq)) | 236 | cl-seq)) |
| 232 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 237 | (setq cl-end (- (or cl-end len) cl-start)) |
| 233 | (if (= cl-start 0) | 238 | (if (= cl-start 0) |
| 234 | (while (and cl-seq (> cl-end 0) | 239 | (while (and cl-seq (> cl-end 0) |
| 235 | (cl--check-test cl-item (car cl-seq)) | 240 | (cl--check-test cl-item (car cl-seq)) |
| @@ -250,7 +255,7 @@ to avoid corrupting the original SEQ. | |||
| 250 | :start 0 :end (1- cl-end) | 255 | :start 0 :end (1- cl-end) |
| 251 | :count (1- cl-count) cl-keys)))) | 256 | :count (1- cl-count) cl-keys)))) |
| 252 | cl-seq)) | 257 | cl-seq)) |
| 253 | cl-seq))))) | 258 | cl-seq)))))) |
| 254 | 259 | ||
| 255 | ;;;###autoload | 260 | ;;;###autoload |
| 256 | (defun cl-remove-if (cl-pred cl-list &rest cl-keys) | 261 | (defun cl-remove-if (cl-pred cl-list &rest cl-keys) |
| @@ -278,20 +283,21 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 278 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" | 283 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" |
| 279 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end | 284 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end |
| 280 | (:start 0) :end) () | 285 | (:start 0) :end) () |
| 281 | (if (<= (or cl-count (setq cl-count 8000000)) 0) | 286 | (let ((len (length cl-seq))) |
| 287 | (if (<= (or cl-count (setq cl-count len)) 0) | ||
| 282 | cl-seq | 288 | cl-seq |
| 283 | (if (listp cl-seq) | 289 | (if (listp cl-seq) |
| 284 | (if (and cl-from-end (< cl-count 4000000)) | 290 | (if (and cl-from-end (< cl-count (/ len 2))) |
| 285 | (let (cl-i) | 291 | (let (cl-i) |
| 286 | (while (and (>= (setq cl-count (1- cl-count)) 0) | 292 | (while (and (>= (setq cl-count (1- cl-count)) 0) |
| 287 | (setq cl-i (cl--position cl-item cl-seq cl-start | 293 | (setq cl-i (cl--position cl-item cl-seq cl-start |
| 288 | cl-end cl-from-end))) | 294 | cl-end cl-from-end))) |
| 289 | (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) | 295 | (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) |
| 290 | (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) | 296 | (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) |
| 291 | (setcdr cl-tail (cdr (cdr cl-tail))))) | 297 | (setcdr cl-tail (cdr (cdr cl-tail))))) |
| 292 | (setq cl-end cl-i)) | 298 | (setq cl-end cl-i)) |
| 293 | cl-seq) | 299 | cl-seq) |
| 294 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 300 | (setq cl-end (- (or cl-end len) cl-start)) |
| 295 | (if (= cl-start 0) | 301 | (if (= cl-start 0) |
| 296 | (progn | 302 | (progn |
| 297 | (while (and cl-seq | 303 | (while (and cl-seq |
| @@ -312,7 +318,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 312 | (setq cl-p (cdr cl-p))) | 318 | (setq cl-p (cdr cl-p))) |
| 313 | (setq cl-end (1- cl-end))))) | 319 | (setq cl-end (1- cl-end))))) |
| 314 | cl-seq) | 320 | cl-seq) |
| 315 | (apply 'cl-remove cl-item cl-seq cl-keys))))) | 321 | (apply 'cl-remove cl-item cl-seq cl-keys)))))) |
| 316 | 322 | ||
| 317 | ;;;###autoload | 323 | ;;;###autoload |
| 318 | (defun cl-delete-if (cl-pred cl-list &rest cl-keys) | 324 | (defun cl-delete-if (cl-pred cl-list &rest cl-keys) |
| @@ -396,15 +402,17 @@ to avoid corrupting the original SEQ. | |||
| 396 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count | 402 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count |
| 397 | (:start 0) :end :from-end) () | 403 | (:start 0) :end :from-end) () |
| 398 | (if (or (eq cl-old cl-new) | 404 | (if (or (eq cl-old cl-new) |
| 399 | (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) | 405 | (<= (or cl-count (setq cl-from-end nil |
| 406 | cl-count (length cl-seq))) 0)) | ||
| 400 | cl-seq | 407 | cl-seq |
| 401 | (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) | 408 | (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) |
| 402 | (if (not cl-i) | 409 | (if (not cl-i) |
| 403 | cl-seq | 410 | cl-seq |
| 404 | (setq cl-seq (copy-sequence cl-seq)) | 411 | (setq cl-seq (copy-sequence cl-seq)) |
| 405 | (or cl-from-end | 412 | (unless cl-from-end |
| 406 | (progn (setf (elt cl-seq cl-i) cl-new) | 413 | (setf (elt cl-seq cl-i) cl-new) |
| 407 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) | 414 | (cl-incf cl-i) |
| 415 | (cl-decf cl-count)) | ||
| 408 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count | 416 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count |
| 409 | :start cl-i cl-keys)))))) | 417 | :start cl-i cl-keys)))))) |
| 410 | 418 | ||
| @@ -434,17 +442,18 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 434 | \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" | 442 | \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" |
| 435 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count | 443 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count |
| 436 | (:start 0) :end :from-end) () | 444 | (:start 0) :end :from-end) () |
| 437 | (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) | 445 | (let ((len (length cl-seq))) |
| 438 | (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) | 446 | (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0) |
| 447 | (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2)))) | ||
| 439 | (let ((cl-p (nthcdr cl-start cl-seq))) | 448 | (let ((cl-p (nthcdr cl-start cl-seq))) |
| 440 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 449 | (setq cl-end (- (or cl-end len) cl-start)) |
| 441 | (while (and cl-p (> cl-end 0) (> cl-count 0)) | 450 | (while (and cl-p (> cl-end 0) (> cl-count 0)) |
| 442 | (if (cl--check-test cl-old (car cl-p)) | 451 | (if (cl--check-test cl-old (car cl-p)) |
| 443 | (progn | 452 | (progn |
| 444 | (setcar cl-p cl-new) | 453 | (setcar cl-p cl-new) |
| 445 | (setq cl-count (1- cl-count)))) | 454 | (setq cl-count (1- cl-count)))) |
| 446 | (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) | 455 | (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) |
| 447 | (or cl-end (setq cl-end (length cl-seq))) | 456 | (or cl-end (setq cl-end len)) |
| 448 | (if cl-from-end | 457 | (if cl-from-end |
| 449 | (while (and (< cl-start cl-end) (> cl-count 0)) | 458 | (while (and (< cl-start cl-end) (> cl-count 0)) |
| 450 | (setq cl-end (1- cl-end)) | 459 | (setq cl-end (1- cl-end)) |
| @@ -457,7 +466,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 457 | (progn | 466 | (progn |
| 458 | (aset cl-seq cl-start cl-new) | 467 | (aset cl-seq cl-start cl-new) |
| 459 | (setq cl-count (1- cl-count)))) | 468 | (setq cl-count (1- cl-count)))) |
| 460 | (setq cl-start (1+ cl-start)))))) | 469 | (setq cl-start (1+ cl-start))))))) |
| 461 | cl-seq)) | 470 | cl-seq)) |
| 462 | 471 | ||
| 463 | ;;;###autoload | 472 | ;;;###autoload |
| @@ -513,14 +522,13 @@ Return the index of the matching item, or nil if not found. | |||
| 513 | 522 | ||
| 514 | (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) | 523 | (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) |
| 515 | (if (listp cl-seq) | 524 | (if (listp cl-seq) |
| 516 | (let ((cl-p (nthcdr cl-start cl-seq))) | 525 | (let ((cl-p (nthcdr cl-start cl-seq)) |
| 517 | (or cl-end (setq cl-end 8000000)) | 526 | cl-res) |
| 518 | (let ((cl-res nil)) | 527 | (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end)) |
| 519 | (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) | ||
| 520 | (if (cl--check-test cl-item (car cl-p)) | 528 | (if (cl--check-test cl-item (car cl-p)) |
| 521 | (setq cl-res cl-start)) | 529 | (setq cl-res cl-start)) |
| 522 | (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) | 530 | (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) |
| 523 | cl-res)) | 531 | cl-res) |
| 524 | (or cl-end (setq cl-end (length cl-seq))) | 532 | (or cl-end (setq cl-end (length cl-seq))) |
| 525 | (if cl-from-end | 533 | (if cl-from-end |
| 526 | (progn | 534 | (progn |
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index cc393f40583..02d9246db21 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el | |||
| @@ -294,7 +294,6 @@ Body are forms defining the test." | |||
| 294 | 294 | ||
| 295 | (ert-deftest cl-seq-test-bug24264 () | 295 | (ert-deftest cl-seq-test-bug24264 () |
| 296 | "Test for http://debbugs.gnu.org/24264 ." | 296 | "Test for http://debbugs.gnu.org/24264 ." |
| 297 | :expected-result :failed | ||
| 298 | (let ((list (append (make-list 8000005 1) '(8))) | 297 | (let ((list (append (make-list 8000005 1) '(8))) |
| 299 | (list2 (make-list 8000005 2))) | 298 | (list2 (make-list 8000005 2))) |
| 300 | (should (cl-position 8 list)) | 299 | (should (cl-position 8 list)) |