Commit 253d44bd authored by Leo Liu's avatar Leo Liu

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.
parent 909126de
2015-01-18 Leo Liu <sdl.web@gmail.com>
* 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 <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include
......
......@@ -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)
......
......@@ -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))))
......
2015-01-18 Leo Liu <sdl.web@gmail.com>
* automated/seq-tests.el (test-seq-subseq): Add more tests.
(Bug#19434)
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/eieio-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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment