From: Leo Liu Date: Sun, 18 Jan 2015 06:03:59 +0000 (+0800) Subject: Fix seq-subseq and cl-subseq for bad bounding indices X-Git-Tag: emacs-25.0.90~2597^2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=253d44bd27b7d90b614b6b968a3b125eeb0a48f2;p=emacs.git Fix seq-subseq and cl-subseq for bad bounding indices Fixes: debbugs:19434 debbugs:19519 * lisp/emacs-lisp/cl-extra.el (cl-subseq): Use seq-subseq and fix multiple evaluation. * lisp/emacs-lisp/seq.el (seq-subseq): Throw bad bounding indices error. * test/automated/seq-tests.el (test-seq-subseq): Add more tests. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ace8d2231a8..680adc71d0a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2015-01-18 Leo Liu + + * emacs-lisp/cl-extra.el (cl-subseq): Use seq-subseq and fix + multiple evaluation. (Bug#19519) + + * emacs-lisp/seq.el (seq-subseq): Throw bad bounding indices + error. (Bug#19434) + 2015-01-18 Stefan Monnier * emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 2f8a5a62f28..afc2adbee6d 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -38,6 +38,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) ;;; Type coercion. @@ -521,28 +522,10 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." (declare (gv-setter (lambda (new) - `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) - ,new)))) - (if (stringp seq) (substring seq start end) - (let (len) - (and end (< end 0) (setq end (+ end (setq len (length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) (setq seq (nthcdr start seq))) - (if end - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res)) - (copy-sequence seq))) - (t - (or end (setq end (or len (length seq)))) - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) start (1+ start))) - res)))))) + (macroexp-let2 nil new new + `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) + ,new))))) + (seq-subseq seq start end)) ;;;###autoload (defun cl-concatenate (type &rest seqs) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index f6740c7d7f5..b28153b7f81 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -197,14 +197,18 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) ((listp seq) - (let (len) + (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) - (if (> start 0) (setq seq (nthcdr start seq))) + (when (> start 0) + (setq seq (nthcdr (1- start) seq)) + (or seq (error "%s" errtext)) + (setq seq (cdr seq))) (if end (let ((res nil)) - (while (>= (setq end (1- end)) start) + (while (and (>= (setq end (1- end)) start) seq) (push (pop seq) res)) + (or (= (1+ end) start) (error "%s" errtext)) (nreverse res)) (seq-copy seq)))) (t (error "Unsupported sequence: %s" seq)))) diff --git a/test/ChangeLog b/test/ChangeLog index 56ec3afdad7..15baf866f37 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2015-01-18 Leo Liu + + * automated/seq-tests.el (test-seq-subseq): Add more tests. + (Bug#19434) + 2015-01-17 Stefan Monnier * automated/eieio-tests.el diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el index 9fcda7f7c9d..23989799306 100644 --- a/test/automated/seq-tests.el +++ b/test/automated/seq-tests.el @@ -182,7 +182,12 @@ Evaluate BODY for each created sequence. (should (same-contents-p (seq-subseq seq 1 -1) '(3 4)))) (should (vectorp (seq-subseq [2 3 4 5] 2))) (should (stringp (seq-subseq "foo" 2 3))) - (should (listp (seq-subseq '(2 3 4 4) 2 3)))) + (should (listp (seq-subseq '(2 3 4 4) 2 3))) + (should-error (seq-subseq '(1 2 3) 4)) + (should-not (seq-subseq '(1 2 3) 3)) + (should (seq-subseq '(1 2 3) -3)) + (should-error (seq-subseq '(1 2 3) 1 4)) + (should (seq-subseq '(1 2 3) 1 3))) (ert-deftest test-seq-concatenate () (with-test-sequences (seq '(2 4 6))