From 253d44bd27b7d90b614b6b968a3b125eeb0a48f2 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Sun, 18 Jan 2015 14:03:59 +0800 Subject: [PATCH] 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. --- lisp/ChangeLog | 8 ++++++++ lisp/emacs-lisp/cl-extra.el | 27 +++++---------------------- lisp/emacs-lisp/seq.el | 10 +++++++--- test/ChangeLog | 5 +++++ test/automated/seq-tests.el | 7 ++++++- 5 files changed, 31 insertions(+), 26 deletions(-) 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)) -- 2.39.5