all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH] Bound index checks in cl-seq functions
@ 2017-02-04 16:40 Tino Calancha
  2017-02-04 20:42 ` Philipp Stephani
                   ` (3 more replies)
  0 siblings, 4 replies; 14+ messages in thread
From: Tino Calancha @ 2017-02-04 16:40 UTC (permalink / raw)
  To: Emacs developers; +Cc: tino.calancha


Consider following evaluations:

(cl-position 2 (list 1 2 3) :start -999)
=> -998
(cl-position 2 (list 1 2 3) :start 999)
=> nil
(cl-position 2 (list 1 2 3) :start 1 :end 0)
=> nil

*) In the first two, the indices are out of range.
*) In the 3rd, the start index is higher than the end index.

Guy L. Steele recommends to throw an error in those cases:
http://www.lispworks.com/documentation/HyperSpec/Issues/iss332_w.htm

We have partially done the job, at least for `cl-subseq':
(cl-subseq (list 1 2 3) 999)
; Signal: "Bad bounding indices: 999, nil"

(cl-subseq (list 1 2 3) -999)
; Signal: "Bad bounding indices: -999, nil"

(cl-subseq (list 1 2 3) -1)
=> (3) ; This is OK as documented in the docstring.

See:
https://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00182.html

It would be nice if all the sequence functions in cl-seq.el
throw errors in those situations.

What do you think?
The following patch implements such bounding checks for the indices.
Comments are very welcome.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From c076a16716d6b9ad5c971d67375223974df53a40 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sat, 4 Feb 2017 21:53:48 +0900
Subject: [PATCH 1/3] cl--parsing-keywords: Check for negative indices

* lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords):
Throw and error when the user inputs a negative index for the sequence.
---
 lisp/emacs-lisp/cl-seq.el | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 67ff1a00bd..558adf22fe 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -59,7 +59,13 @@ cl--parsing-keywords
                    (setq mem `(and ,mem (setq cl-if ,mem) t)))
                (list (intern
                       (format "cl-%s" (substring (symbol-name var) 1)))
-                     (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+                     `(if (and (string-match ":\\(start\\|end\\)" (symbol-name ,var))
+                               (integerp (or ,mem ,(car (cdr-safe x))))
+                               (not (natnump (or ,mem ,(car (cdr-safe x))))))
+                          (error "Wrong negative index '%s': natnump, %s"
+                                 (substring (symbol-name ,var) 1)
+                                 (or ,mem ,(car (cdr-safe x))))
+                        (or ,mem ,(car (cdr-safe x)))))))
            kwords)
      ,@(append
         (and (not (eq other-keys t))
-- 
2.11.0

From 9898718b96109c5815b81f8dc8868de4d86db453 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sun, 5 Feb 2017 00:04:12 +0900
Subject: [PATCH 2/3] cl--check-bound-indices: Check for unbound indices

Throw and error if the user inputs an index higher than the sequence length
or if :start value is higher than :end value.
* lisp/emacs-lisp/cl-seq.el (cl--check-bound-indices): New defun.
(cl-reduce, cl-fill, cl-replace, cl-remove, cl-delete)
(cl--delete-duplicates, cl-substitute, cl-nsubstitute, cl-position)
(cl-count, cl-mismatch, cl-search): Use it.
---
 lisp/emacs-lisp/cl-seq.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 558adf22fe..0cb7ac7bdd 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -42,6 +42,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
 
 ;; Keyword parsing.
 ;; This is special-cased here so that we can compile
@@ -118,6 +119,44 @@ cl-test
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
+;; Throw an error when :start or :end are > sequence length.
+(defmacro cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
+  (declare (debug t))
+  `(let ((len1 (length ,cl-seq1))
+         (len2 (and ,cl-seq2 (length ,cl-seq2)))
+         (kwds (list :start1 :start2 :start :end1 :end2 :end))
+         (keys ,cl-keys)
+         alist)
+     (while keys
+       (when (and (memq (car keys) kwds)
+                  (string-match ":\\(start\\|end\\)\\([1-2]?\\)\\'"
+                                (symbol-name (car keys))))
+         (delq (car keys) kwds) ; Ignore succesive equal keys.
+         (let* ((idx (match-string 2 (symbol-name (car keys))))
+                (len (if (equal idx "2") len2 len1)))
+           (when (integerp (cadr keys))
+             (push (cons (car keys) (cadr keys)) alist))
+           (when (> (cadr keys) len)
+             (error "Wrong bounding indices '%s', %s > (length %s), %s"
+                    (substring (symbol-name (car keys)) 1)
+                    (cadr keys)
+                    (concat "cl-seq" idx)
+                    len))))
+       (setq keys (cddr keys)))
+     ;; Check :start value > :end value.
+     (mapc (lambda (x)
+             (and-let* ((start (alist-get (car x) alist))
+                        (end (alist-get (cdr x) alist)))
+               (when (> start end)
+                 (error "Bad bounding indices '%s', '%s': %d, %d"
+                        (substring (symbol-name (car x)) 1)
+                        (substring (symbol-name (cdr x)) 1)
+                        start
+                        end))))
+           (list (cons :start :end)
+                 (cons :start1 :end1)
+                 (cons :start2 :end2)))))
+
 ;;;###autoload
 (defun cl-reduce (cl-func cl-seq &rest cl-keys)
   "Reduce two-argument FUNCTION across SEQ.
@@ -134,6 +173,7 @@ cl-reduce
 
 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
     (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
@@ -155,6 +195,7 @@ cl-fill
 \nKeywords supported:  :start :end
 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start 0) :end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (if (listp cl-seq)
 	(let ((p (nthcdr cl-start cl-seq))
 	      (n (and cl-end (- cl-end cl-start))))
@@ -176,6 +217,7 @@ cl-replace
 \nKeywords supported:  :start1 :end1 :start2 :end2
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
+    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
     (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
 	(or (= cl-start1 cl-start2)
 	    (let* ((cl-len (length cl-seq1))
@@ -225,6 +267,7 @@ cl-remove
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (let ((len (length cl-seq)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
@@ -289,6 +332,7 @@ cl-delete
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (let ((len (length cl-seq)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
@@ -362,6 +406,7 @@ cl--delete-duplicates
           ;; We need to parse :if, otherwise `cl-if' is unbound.
           (:test :test-not :key (:start 0) :end :from-end :if)
 	  ()
+        (cl--check-bound-indices cl-seq nil cl-keys)
 	(if cl-from-end
 	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
 	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
@@ -407,6 +452,7 @@ cl-substitute
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
 			(:start 0) :end :from-end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (if (or (eq cl-old cl-new)
 	    (<= (or cl-count (setq cl-from-end nil
 				   cl-count (length cl-seq))) 0))
@@ -448,6 +494,7 @@ 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) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (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))))
@@ -524,6 +571,7 @@ cl-position
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not
 			(:start 0) :end :from-end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
 
 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
@@ -568,6 +616,7 @@ cl-count
 \nKeywords supported:  :test :test-not :key :start :end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (let ((cl-count 0) cl-x)
       (or cl-end (setq cl-end (length cl-seq)))
       (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
@@ -600,6 +649,7 @@ cl-mismatch
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
 			(:start1 0) :end1 (:start2 0) :end2) ()
+    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
     (or cl-end1 (setq cl-end1 (length cl-seq1)))
     (or cl-end2 (setq cl-end2 (length cl-seq2)))
     (if cl-from-end
@@ -631,6 +681,7 @@ cl-search
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
 			(:start1 0) :end1 (:start2 0) :end2) ()
+    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
     (or cl-end1 (setq cl-end1 (length cl-seq1)))
     (or cl-end2 (setq cl-end2 (length cl-seq2)))
     (if (>= cl-start1 cl-end1)
-- 
2.11.0

From 50cce9d03fa96d622d20f2218ec5ddcfeb246425 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sun, 5 Feb 2017 01:06:01 +0900
Subject: [PATCH 3/3] * test/lisp/emacs-lisp/cl-seq-tests.el
 (cl-seq-check-bounds): New test.

---
 test/lisp/emacs-lisp/cl-seq-tests.el | 91 ++++++++++++++++++++++++++++++++++++
 1 file changed, 91 insertions(+)

diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 61e3d72033..f5ecfe4b92 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,6 +294,7 @@ cl-seq--with-side-effects
 
 (ert-deftest cl-seq-test-bug24264 ()
   "Test for http://debbugs.gnu.org/24264 ."
+  :tags '(:expensive-test)
   (let ((list  (append (make-list 8000005 1) '(8)))
         (list2 (make-list 8000005 2)))
     (should (cl-position 8 list))
@@ -302,6 +303,96 @@ cl-seq--with-side-effects
     (should (equal '(2 8) (last (cl-replace list list2) 2)))
     (should (equal '(1 1) (last (cl-fill list 1) 2)))))
 
+(ert-deftest cl-seq-check-bounds ()
+  (let ((lst (list 1 2 3))
+        (lst2 (list 'a 'b 'c))
+        ;; t means pass, nil means fails.
+        (tests '("((lambda (x y) (cl-reduce #'max x :start 1)) . t)"
+                 "((lambda (x y) (cl-reduce #'max x :start -1)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 4)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-fill x 'b :start 3)) . t)"
+                 "((lambda (x y) (cl-fill x 'b :start 4)))"
+                 "((lambda (x y) (cl-fill x 'b :start -1)))"
+                 "((lambda (x y) (cl-fill x 'b :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-replace x y :start1 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start2 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start1 4)))"
+                 "((lambda (x y) (cl-replace x y :start2 4)))"
+                 "((lambda (x y) (cl-replace x y :start1 -1)))"
+                 "((lambda (x y) (cl-replace x y :start2 -1)))"
+                 "((lambda (x y) (cl-replace x y :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-replace x y :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove nil x :start 4)))"
+                 "((lambda (x y) (cl-remove nil x :start -1)))"
+                 "((lambda (x y) (cl-remove nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete nil x :start 4)))"
+                 "((lambda (x y) (cl-delete nil x :start -1)))"
+                 "((lambda (x y) (cl-delete nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-position 2 x :start 4)))"
+                 "((lambda (x y) (cl-position 2 x :start -1)))"
+                 "((lambda (x y) (cl-position 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-count 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-count 2 x :start 4)))"
+                 "((lambda (x y) (cl-count 2 x :start -1)))"
+                 "((lambda (x y) (cl-count 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 3)) . t)"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 4)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 4 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 -1 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-search x x :start1 3 :start2 3)) . t)"
+                 "((lambda (x y) (cl-search x x :start1 4 :start2 4)))"
+                 "((lambda (x y) (cl-search x x :start1 -1 :start2 3)))"
+                 "((lambda (x y) (cl-search x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-search x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-search x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-subseq x -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -2 -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -4)))"
+                 "((lambda (x y) (cl-subseq x 2 1)))")))
+    (dolist (limit '("start" "end"))
+      (dolist (x tests)
+        (let ((form
+               (car
+                (read-from-string
+                 (cond ((string-match ":start\\([1-2]?\\) \\([0-9-]+\\) :end\\([1-2]?\\)" x)
+                        x)
+                       ((string= limit "start") x)
+                       (t
+                        (replace-regexp-in-string "start" limit x)))))))
+          (if (cdr form)
+              (should (funcall (car form) lst lst2))
+            (should-error (funcall (car form) lst lst2))))))))
+
 
 (provide 'cl-seq-tests)
 ;;; cl-seq-tests.el ends here
-- 
2.11.0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
 of 2017-02-04
Repository revision: ff4dd0d39c3f5dfb8f4988f840c2c05621db32db



^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: [PATCH] Bound index checks in cl-seq functions
  2017-02-04 16:40 [PATCH] Bound index checks in cl-seq functions Tino Calancha
@ 2017-02-04 20:42 ` Philipp Stephani
  2017-02-04 20:51 ` Noam Postavsky
                   ` (2 subsequent siblings)
  3 siblings, 0 replies; 14+ messages in thread
From: Philipp Stephani @ 2017-02-04 20:42 UTC (permalink / raw)
  To: Tino Calancha, Emacs developers

[-- Attachment #1: Type: text/plain, Size: 17447 bytes --]

Tino Calancha <tino.calancha@gmail.com> schrieb am Sa., 4. Feb. 2017 um
17:41 Uhr:

>
> Consider following evaluations:
>
> (cl-position 2 (list 1 2 3) :start -999)
> => -998
> (cl-position 2 (list 1 2 3) :start 999)
> => nil
> (cl-position 2 (list 1 2 3) :start 1 :end 0)
> => nil
>
> *) In the first two, the indices are out of range.
> *) In the 3rd, the start index is higher than the end index.
>
> Guy L. Steele recommends to throw an error in those cases:
> http://www.lispworks.com/documentation/HyperSpec/Issues/iss332_w.htm
>
> We have partially done the job, at least for `cl-subseq':
> (cl-subseq (list 1 2 3) 999)
> ; Signal: "Bad bounding indices: 999, nil"
>
> (cl-subseq (list 1 2 3) -999)
> ; Signal: "Bad bounding indices: -999, nil"
>
> (cl-subseq (list 1 2 3) -1)
> => (3) ; This is OK as documented in the docstring.
>
> See:
> https://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00182.html
>
> It would be nice if all the sequence functions in cl-seq.el
> throw errors in those situations.
>
> What do you think?
>

I agree that these should throw errors.


> The following patch implements such bounding checks for the indices.
> Comments are very welcome.
>
>
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> From c076a16716d6b9ad5c971d67375223974df53a40 Mon Sep 17 00:00:00 2001
> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Sat, 4 Feb 2017 21:53:48 +0900
> Subject: [PATCH 1/3] cl--parsing-keywords: Check for negative indices
>
> * lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords):
> Throw and error when the user inputs a negative index for the sequence.
> ---
>  lisp/emacs-lisp/cl-seq.el | 8 +++++++-
>  1 file changed, 7 insertions(+), 1 deletion(-)
>
> diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
> index 67ff1a00bd..558adf22fe 100644
> --- a/lisp/emacs-lisp/cl-seq.el
> +++ b/lisp/emacs-lisp/cl-seq.el
> @@ -59,7 +59,13 @@ cl--parsing-keywords
>                     (setq mem `(and ,mem (setq cl-if ,mem) t)))
>                 (list (intern
>                        (format "cl-%s" (substring (symbol-name var) 1)))
> -                     (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
> +                     `(if (and (string-match ":\\(start\\|end\\)"
> (symbol-name ,var))
>

I think you can replace the string-match with (memq ,var '(:start :end))


> +                               (integerp (or ,mem ,(car (cdr-safe x))))
> +                               (not (natnump (or ,mem ,(car (cdr-safe
> x))))))
> +                          (error "Wrong negative index '%s': natnump, %s"
> +                                 (substring (symbol-name ,var) 1)
>

Please use (signal 'args-out-of-range ...) to be more specific and
consistent with similar checks.


> +                                 (or ,mem ,(car (cdr-safe x))))
> +                        (or ,mem ,(car (cdr-safe x)))))))
>             kwords)
>       ,@(append
>          (and (not (eq other-keys t))
> --
> 2.11.0
>
> From 9898718b96109c5815b81f8dc8868de4d86db453 Mon Sep 17 00:00:00 2001
> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Sun, 5 Feb 2017 00:04:12 +0900
> Subject: [PATCH 2/3] cl--check-bound-indices: Check for unbound indices
>
> Throw and error if the user inputs an index higher than the sequence length
> or if :start value is higher than :end value.
> * lisp/emacs-lisp/cl-seq.el (cl--check-bound-indices): New defun.
> (cl-reduce, cl-fill, cl-replace, cl-remove, cl-delete)
> (cl--delete-duplicates, cl-substitute, cl-nsubstitute, cl-position)
> (cl-count, cl-mismatch, cl-search): Use it.
> ---
>  lisp/emacs-lisp/cl-seq.el | 51
> +++++++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 51 insertions(+)
>
> diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
> index 558adf22fe..0cb7ac7bdd 100644
> --- a/lisp/emacs-lisp/cl-seq.el
> +++ b/lisp/emacs-lisp/cl-seq.el
> @@ -42,6 +42,7 @@
>  ;;; Code:
>
>  (require 'cl-lib)
> +(eval-when-compile (require 'subr-x))
>
>  ;; Keyword parsing.
>  ;; This is special-cased here so that we can compile
> @@ -118,6 +119,44 @@ cl-test
>  (defvar cl-if) (defvar cl-if-not)
>  (defvar cl-key)
>
> +;; Throw an error when :start or :end are > sequence length.
> +(defmacro cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
> +  (declare (debug t))
> +  `(let ((len1 (length ,cl-seq1))
> +         (len2 (and ,cl-seq2 (length ,cl-seq2)))
> +         (kwds (list :start1 :start2 :start :end1 :end2 :end))
> +         (keys ,cl-keys)
> +         alist)
> +     (while keys
> +       (when (and (memq (car keys) kwds)
> +                  (string-match ":\\(start\\|end\\)\\([1-2]?\\)\\'"
> +                                (symbol-name (car keys))))
> +         (delq (car keys) kwds) ; Ignore succesive equal keys.
> +         (let* ((idx (match-string 2 (symbol-name (car keys))))
> +                (len (if (equal idx "2") len2 len1)))
> +           (when (integerp (cadr keys))
> +             (push (cons (car keys) (cadr keys)) alist))
> +           (when (> (cadr keys) len)
> +             (error "Wrong bounding indices '%s', %s > (length %s), %s"
> +                    (substring (symbol-name (car keys)) 1)
> +                    (cadr keys)
> +                    (concat "cl-seq" idx)
> +                    len))))
> +       (setq keys (cddr keys)))
> +     ;; Check :start value > :end value.
> +     (mapc (lambda (x)
> +             (and-let* ((start (alist-get (car x) alist))
> +                        (end (alist-get (cdr x) alist)))
> +               (when (> start end)
> +                 (error "Bad bounding indices '%s', '%s': %d, %d"
> +                        (substring (symbol-name (car x)) 1)
> +                        (substring (symbol-name (cdr x)) 1)
> +                        start
> +                        end))))
> +           (list (cons :start :end)
> +                 (cons :start1 :end1)
> +                 (cons :start2 :end2)))))
> +
>  ;;;###autoload
>  (defun cl-reduce (cl-func cl-seq &rest cl-keys)
>    "Reduce two-argument FUNCTION across SEQ.
> @@ -134,6 +173,7 @@ cl-reduce
>
>  \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
>      (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
>      (if cl-from-end (setq cl-seq (nreverse cl-seq)))
> @@ -155,6 +195,7 @@ cl-fill
>  \nKeywords supported:  :start :end
>  \n(fn SEQ ITEM [KEYWORD VALUE]...)"
>    (cl--parsing-keywords ((:start 0) :end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (if (listp cl-seq)
>         (let ((p (nthcdr cl-start cl-seq))
>               (n (and cl-end (- cl-end cl-start))))
> @@ -176,6 +217,7 @@ cl-replace
>  \nKeywords supported:  :start1 :end1 :start2 :end2
>  \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
>    (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
> +    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
>      (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
>         (or (= cl-start1 cl-start2)
>             (let* ((cl-len (length cl-seq1))
> @@ -225,6 +267,7 @@ cl-remove
>  \n(fn ITEM SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
>                         (:start 0) :end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (let ((len (length cl-seq)))
>        (if (<= (or cl-count (setq cl-count len)) 0)
>         cl-seq
> @@ -289,6 +332,7 @@ cl-delete
>  \n(fn ITEM SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
>                         (:start 0) :end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (let ((len (length cl-seq)))
>        (if (<= (or cl-count (setq cl-count len)) 0)
>         cl-seq
> @@ -362,6 +406,7 @@ cl--delete-duplicates
>            ;; We need to parse :if, otherwise `cl-if' is unbound.
>            (:test :test-not :key (:start 0) :end :from-end :if)
>           ()
> +        (cl--check-bound-indices cl-seq nil cl-keys)
>         (if cl-from-end
>             (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
>               (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
> @@ -407,6 +452,7 @@ cl-substitute
>  \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :if :if-not :count
>                         (:start 0) :end :from-end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (if (or (eq cl-old cl-new)
>             (<= (or cl-count (setq cl-from-end nil
>                                    cl-count (length cl-seq))) 0))
> @@ -448,6 +494,7 @@ 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) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (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))))
> @@ -524,6 +571,7 @@ cl-position
>  \n(fn ITEM SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :if :if-not
>                         (:start 0) :end :from-end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
>
>  (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
> @@ -568,6 +616,7 @@ cl-count
>  \nKeywords supported:  :test :test-not :key :start :end
>  \n(fn ITEM SEQ [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0)
> :end) ()
> +    (cl--check-bound-indices cl-seq nil cl-keys)
>      (let ((cl-count 0) cl-x)
>        (or cl-end (setq cl-end (length cl-seq)))
>        (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
> @@ -600,6 +649,7 @@ cl-mismatch
>  \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :from-end
>                         (:start1 0) :end1 (:start2 0) :end2) ()
> +    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
>      (or cl-end1 (setq cl-end1 (length cl-seq1)))
>      (or cl-end2 (setq cl-end2 (length cl-seq2)))
>      (if cl-from-end
> @@ -631,6 +681,7 @@ cl-search
>  \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
>    (cl--parsing-keywords (:test :test-not :key :from-end
>                         (:start1 0) :end1 (:start2 0) :end2) ()
> +    (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)
>      (or cl-end1 (setq cl-end1 (length cl-seq1)))
>      (or cl-end2 (setq cl-end2 (length cl-seq2)))
>      (if (>= cl-start1 cl-end1)
> --
> 2.11.0
>
> From 50cce9d03fa96d622d20f2218ec5ddcfeb246425 Mon Sep 17 00:00:00 2001
> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Sun, 5 Feb 2017 01:06:01 +0900
> Subject: [PATCH 3/3] * test/lisp/emacs-lisp/cl-seq-tests.el
>  (cl-seq-check-bounds): New test.
>
> ---
>  test/lisp/emacs-lisp/cl-seq-tests.el | 91
> ++++++++++++++++++++++++++++++++++++
>  1 file changed, 91 insertions(+)
>
> diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el
> b/test/lisp/emacs-lisp/cl-seq-tests.el
> index 61e3d72033..f5ecfe4b92 100644
> --- a/test/lisp/emacs-lisp/cl-seq-tests.el
> +++ b/test/lisp/emacs-lisp/cl-seq-tests.el
> @@ -294,6 +294,7 @@ cl-seq--with-side-effects
>
>  (ert-deftest cl-seq-test-bug24264 ()
>    "Test for http://debbugs.gnu.org/24264 ."
> +  :tags '(:expensive-test)
>    (let ((list  (append (make-list 8000005 1) '(8)))
>          (list2 (make-list 8000005 2)))
>      (should (cl-position 8 list))
> @@ -302,6 +303,96 @@ cl-seq--with-side-effects
>      (should (equal '(2 8) (last (cl-replace list list2) 2)))
>      (should (equal '(1 1) (last (cl-fill list 1) 2)))))
>
> +(ert-deftest cl-seq-check-bounds ()
> +  (let ((lst (list 1 2 3))
> +        (lst2 (list 'a 'b 'c))
> +        ;; t means pass, nil means fails.
> +        (tests '("((lambda (x y) (cl-reduce #'max x :start 1)) . t)"
> +                 "((lambda (x y) (cl-reduce #'max x :start -1)))"
> +                 "((lambda (x y) (cl-reduce #'max x :start 4)))"
> +                 "((lambda (x y) (cl-reduce #'max x :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-fill x 'b :start 3)) . t)"
> +                 "((lambda (x y) (cl-fill x 'b :start 4)))"
> +                 "((lambda (x y) (cl-fill x 'b :start -1)))"
> +                 "((lambda (x y) (cl-fill x 'b :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-replace x y :start1 3)) . t)"
> +                 "((lambda (x y) (cl-replace x y :start2 3)) . t)"
> +                 "((lambda (x y) (cl-replace x y :start1 4)))"
> +                 "((lambda (x y) (cl-replace x y :start2 4)))"
> +                 "((lambda (x y) (cl-replace x y :start1 -1)))"
> +                 "((lambda (x y) (cl-replace x y :start2 -1)))"
> +                 "((lambda (x y) (cl-replace x y :start1 2 :end1 1)))"
> +                 "((lambda (x y) (cl-replace x y :start2 2 :end2 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-remove nil x :start 3)) . t)"
> +                 "((lambda (x y) (cl-remove nil x :start 4)))"
> +                 "((lambda (x y) (cl-remove nil x :start -1)))"
> +                 "((lambda (x y) (cl-remove nil x :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-delete nil x :start 3)) . t)"
> +                 "((lambda (x y) (cl-delete nil x :start 4)))"
> +                 "((lambda (x y) (cl-delete nil x :start -1)))"
> +                 "((lambda (x y) (cl-delete nil x :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-remove-duplicates x :start 3)) . t)"
> +                 "((lambda (x y) (cl-remove-duplicates x :start 4)))"
> +                 "((lambda (x y) (cl-remove-duplicates x :start -1)))"
> +                 "((lambda (x y) (cl-remove-duplicates x :start 2 :end
> 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-substitute 'foo 2 x :start 3)) . t)"
> +                 "((lambda (x y) (cl-substitute 'foo 2 x :start 4)))"
> +                 "((lambda (x y) (cl-substitute 'foo 2 x :start -1)))"
> +                 "((lambda (x y) (cl-substitute 'foo 2 x :start 2 :end
> 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 3)) . t)"
> +                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 4)))"
> +                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start -1)))"
> +                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 2 :end
> 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-position 2 x :start 4)))"
> +                 "((lambda (x y) (cl-position 2 x :start -1)))"
> +                 "((lambda (x y) (cl-position 2 x :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-count 2 x :start 3)) . t)"
> +                 "((lambda (x y) (cl-count 2 x :start 4)))"
> +                 "((lambda (x y) (cl-count 2 x :start -1)))"
> +                 "((lambda (x y) (cl-count 2 x :start 2 :end 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 3)) .
> t)"
> +                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 4)))"
> +                 "((lambda (x y) (cl-mismatch x x :start1 4 :start2 1)))"
> +                 "((lambda (x y) (cl-mismatch x x :start1 -1 :start2 1)))"
> +                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 -1)))"
> +                 "((lambda (x y) (cl-mismatch x x :start1 2 :end1 1)))"
> +                 "((lambda (x y) (cl-mismatch x x :start2 2 :end2 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-search x x :start1 3 :start2 3)) .
> t)"
> +                 "((lambda (x y) (cl-search x x :start1 4 :start2 4)))"
> +                 "((lambda (x y) (cl-search x x :start1 -1 :start2 3)))"
> +                 "((lambda (x y) (cl-search x x :start1 1 :start2 -1)))"
> +                 "((lambda (x y) (cl-search x x :start1 2 :end1 1)))"
> +                 "((lambda (x y) (cl-search x x :start2 2 :end2 1)))"
> +                 ;;
> +                 "((lambda (x y) (cl-subseq x -1)) . t)"
> +                 "((lambda (x y) (cl-subseq x -2 -1)) . t)"
> +                 "((lambda (x y) (cl-subseq x -4)))"
> +                 "((lambda (x y) (cl-subseq x 2 1)))")))
> +    (dolist (limit '("start" "end"))
> +      (dolist (x tests)
> +        (let ((form
> +               (car
> +                (read-from-string
> +                 (cond ((string-match ":start\\([1-2]?\\) \\([0-9-]+\\)
> :end\\([1-2]?\\)" x)
> +                        x)
> +                       ((string= limit "start") x)
> +                       (t
> +                        (replace-regexp-in-string "start" limit x)))))))
> +          (if (cdr form)
> +              (should (funcall (car form) lst lst2))
> +            (should-error (funcall (car form) lst lst2))))))))
> +
>
>  (provide 'cl-seq-tests)
>  ;;; cl-seq-tests.el ends here
> --
> 2.11.0
>
>
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
>  of 2017-02-04
> Repository revision: ff4dd0d39c3f5dfb8f4988f840c2c05621db32db
>
>

[-- Attachment #2: Type: text/html, Size: 29044 bytes --]

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: [PATCH] Bound index checks in cl-seq functions
  2017-02-04 16:40 [PATCH] Bound index checks in cl-seq functions Tino Calancha
  2017-02-04 20:42 ` Philipp Stephani
@ 2017-02-04 20:51 ` Noam Postavsky
  2017-02-05  7:11   ` [PATCH v2] " Tino Calancha
  2017-02-10  7:43 ` Tino Calancha
  2017-02-12 21:26 ` [PATCH] " Johan Bockgård
  3 siblings, 1 reply; 14+ messages in thread
From: Noam Postavsky @ 2017-02-04 20:51 UTC (permalink / raw)
  To: Tino Calancha; +Cc: Emacs developers

On Sat, Feb 4, 2017 at 11:40 AM, Tino Calancha <tino.calancha@gmail.com> wrote:
> +;; Throw an error when :start or :end are > sequence length.
> +(defmacro cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)

I wonder why this is a macro and not a function.



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: [PATCH v2] Bound index checks in cl-seq functions
  2017-02-04 20:51 ` Noam Postavsky
@ 2017-02-05  7:11   ` Tino Calancha
  2017-02-05 14:56     ` [PATCH v3] " Tino Calancha
  2017-02-05 16:11     ` [PATCH v2] " Clément Pit-Claudel
  0 siblings, 2 replies; 14+ messages in thread
From: Tino Calancha @ 2017-02-05  7:11 UTC (permalink / raw)
  To: Noam Postavsky; +Cc: Philipp Stephani, Emacs developers, tino.calancha

Noam Postavsky <npostavs@users.sourceforge.net> writes:

> On Sat, Feb 4, 2017 at 11:40 AM, Tino Calancha <tino.calancha@gmail.com> wrote:
>> +;; Throw an error when :start or :end are > sequence length.
>> +(defmacro cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
>
> I wonder why this is a macro and not a function.
Me either.  The commit message say defun.  A possible case of Emacs
goblins...
Updated the patch with:
I) `cl--check-bound-indices' is a function.
II) `cl--check-bound-indices' returns on success the sequence[s]
    length[s], so that callers don't need to recompute them.
III) Updated manual and added NEWS entry.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 72500280762c9fcf4ad13c1285732f2ac5f5e89d Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sun, 5 Feb 2017 15:56:25 +0900
Subject: [PATCH] Check for out-of-range indices in cl-seq function

Throw and error if the user inputs out of range indices
or if :start value is higher than :end value.
* lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords):
Check for negative indices.
(cl--check-bound-indices): New defun; check for indices > seq length,
or start index > end index.
(cl-reduce, cl-fill, cl-replace, cl-remove, cl-delete)
(cl--delete-duplicates, cl-substitute, cl-nsubstitute, cl-position)
(cl-count, cl-mismatch, cl-search): Use it.
* doc/misc/cl.texi (Sequence Basics): Update manual.
; * etc/NEWS: Announce the change.
* test/lisp/emacs-lisp/cl-seq-tests.el (cl-seq-check-bounds): New test.
---
 doc/misc/cl.texi                     |   4 +-
 etc/NEWS                             |   4 +
 lisp/emacs-lisp/cl-seq.el            | 355 +++++++++++++++++++++--------------
 test/lisp/emacs-lisp/cl-seq-tests.el |  90 +++++++++
 4 files changed, 307 insertions(+), 146 deletions(-)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 8baa0bd88c..6f387f5cbb 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3247,7 +3247,9 @@ Sequence Basics
 (exclusive) are affected by the operation.  The @var{end} argument
 may be passed @code{nil} to signify the length of the sequence;
 otherwise, both @var{start} and @var{end} must be integers, with
-@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.
+@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.  Emacs
+signals an error when this condition is not true, except for
+@code{cl-subseq} which allows negative indices.
 If the function takes two sequence arguments, the limits are
 defined by keywords @code{:start1} and @code{:end1} for the first,
 and @code{:start2} and @code{:end2} for the second.
diff --git a/etc/NEWS b/etc/NEWS
index cbf2b70c82..b14f8eca5a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -706,6 +706,10 @@ processes on exit.
 * Incompatible Lisp Changes in Emacs 26.1
 
 +++
+** CL sequence functions now throw errors when the input indices
+are out of range, or if :start index is higher than :end index.
+
++++
 ** Resizing a frame no longer runs 'window-configuration-change-hook'.
 Put your function on 'window-size-change-functions' instead.
 
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 67ff1a00bd..314448ce93 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -42,6 +42,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
 
 ;; Keyword parsing.
 ;; This is special-cased here so that we can compile
@@ -59,7 +60,13 @@ cl--parsing-keywords
                    (setq mem `(and ,mem (setq cl-if ,mem) t)))
                (list (intern
                       (format "cl-%s" (substring (symbol-name var) 1)))
-                     (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+                     `(if (and (string-match ":\\(start\\|end\\)" (symbol-name ,var))
+                               (integerp (or ,mem ,(car (cdr-safe x))))
+                               (not (natnump (or ,mem ,(car (cdr-safe x))))))
+                          (error "Wrong negative index '%s': natnump, %s"
+                                 (substring (symbol-name ,var) 1)
+                                 (or ,mem ,(car (cdr-safe x))))
+                        (or ,mem ,(car (cdr-safe x)))))))
            kwords)
      ,@(append
         (and (not (eq other-keys t))
@@ -112,6 +119,49 @@ cl-test
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
+;; Throw an error when :start or :end are > sequence length,
+;; or if :start > :end.
+;; If CL-SEQ2 is nil, then return (length cl-seq1), otherwise
+;; return (cons (length cl-seq1) (length cl-seq2)).
+(defun cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
+  (let ((len1 (length cl-seq1))
+        (len2 (and cl-seq2 (length cl-seq2)))
+        (kwds (list :start1 :start2 :start :end1 :end2 :end))
+        alist)
+    (while cl-keys
+      (when (and (memq (car cl-keys) kwds)
+                 (string-match ":\\(start\\|end\\)\\([1-2]?\\)\\'"
+                               (symbol-name (car cl-keys))))
+        (delq (car cl-keys) kwds) ; Ignore succesive equal keys.
+        (let* ((idx (match-string 2 (symbol-name (car cl-keys))))
+               (len (if (equal idx "2") len2 len1)))
+          (when (integerp (cadr cl-keys))
+            (push (cons (car cl-keys) (cadr cl-keys)) alist))
+          (when (> (cadr cl-keys) len)
+            (error "Wrong bounding indices '%s', %s > (length %s), %s"
+                   (substring (symbol-name (car cl-keys)) 1)
+                   (cadr cl-keys)
+                   (concat "cl-seq" idx)
+                   len))))
+      (setq cl-keys (cddr cl-keys)))
+    ;; Check :start value > :end value.
+    (mapc (lambda (x)
+            (and-let* ((start (alist-get (car x) alist))
+                       (end (alist-get (cdr x) alist))
+                       (bad-indices (> start end)))
+              (error "Bad bounding indices '%s', '%s': %d, %d"
+                     (substring (symbol-name (car x)) 1)
+                     (substring (symbol-name (cdr x)) 1)
+                     start
+                     end)))
+          (list (cons :start :end)
+                (cons :start1 :end1)
+                (cons :start2 :end2)))
+    ;; Return sequence lengths.
+    (if len2
+        (cons len1 len2)
+      len1)))
+
 ;;;###autoload
 (defun cl-reduce (cl-func cl-seq &rest cl-keys)
   "Reduce two-argument FUNCTION across SEQ.
@@ -128,6 +178,7 @@ cl-reduce
 
 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
     (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
@@ -149,18 +200,19 @@ cl-fill
 \nKeywords supported:  :start :end
 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start 0) :end) ()
-    (if (listp cl-seq)
-	(let ((p (nthcdr cl-start cl-seq))
-	      (n (and cl-end (- cl-end cl-start))))
-	  (while (and p (or (null n) (>= (cl-decf n) 0)))
-	    (setcar p cl-item)
-	    (setq p (cdr p))))
-      (or cl-end (setq cl-end (length cl-seq)))
-      (if (and (= cl-start 0) (= cl-end (length cl-seq)))
-	  (fillarray cl-seq cl-item)
-	(while (< cl-start cl-end)
-	  (aset cl-seq cl-start cl-item)
-	  (setq cl-start (1+ cl-start)))))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (if (listp cl-seq)
+          (let ((p (nthcdr cl-start cl-seq))
+                (n (and cl-end (- cl-end cl-start))))
+            (while (and p (or (null n) (>= (cl-decf n) 0)))
+              (setcar p cl-item)
+              (setq p (cdr p))))
+        (or cl-end (setq cl-end len))
+        (if (and (= cl-start 0) (= cl-end len))
+            (fillarray cl-seq cl-item)
+          (while (< cl-start cl-end)
+            (aset cl-seq cl-start cl-item)
+            (setq cl-start (1+ cl-start))))))
     cl-seq))
 
 ;;;###autoload
@@ -170,44 +222,47 @@ cl-replace
 \nKeywords supported:  :start1 :end1 :start2 :end2
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(setf (elt cl-seq1 (+ cl-start1 cl-n))
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (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 (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)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
+    (let*  ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+            (len1 (car lens))
+            (len2 (cdr lens)))
+      (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
+          (or (= cl-start1 cl-start2)
+              (let* ((cl-len len1)
+                     (cl-n (min (- (or cl-end1 cl-len) cl-start1)
+                                (- (or cl-end2 cl-len) cl-start2))))
+                (while (>= (setq cl-n (1- cl-n)) 0)
+                  (setf (elt cl-seq1 (+ cl-start1 cl-n))
+                        (elt cl-seq2 (+ cl-start2 cl-n))))))
+        (if (listp cl-seq1)
+            (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
+                  (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
+              (if (listp cl-seq2)
+                  (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
+                        (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 (if (null cl-n1)
+                                  (or cl-end2 len2)
+                                (min (or cl-end2 len2)
+                                     (+ 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)))))
+          (setq cl-end1 (min (or cl-end1 len1)
+                             (+ cl-start1 (- (or cl-end2 len2)
+                                             cl-start2))))
+          (if (listp cl-seq2)
+              (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
+                (while (< cl-start1 cl-end1)
+                  (aset cl-seq1 cl-start1 (car cl-p2))
+                  (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
+            (while (< cl-start1 cl-end1)
+              (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
+              (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))))
     cl-seq1))
 
 ;;;###autoload
@@ -219,7 +274,7 @@ cl-remove
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
         (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
@@ -283,7 +338,7 @@ cl-delete
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
       (if (listp cl-seq)
@@ -356,39 +411,40 @@ cl--delete-duplicates
           ;; We need to parse :if, otherwise `cl-if' is unbound.
           (:test :test-not :key (:start 0) :end :from-end :if)
 	  ()
-	(if cl-from-end
-	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
-	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	      (while (> cl-end 1)
-		(setq cl-i 0)
-		(while (setq cl-i (cl--position (cl--check-key (car cl-p))
-                                                (cdr cl-p) cl-i (1- cl-end)))
-		  (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				    cl-p (nthcdr cl-start cl-seq) cl-copy nil))
-		  (let ((cl-tail (nthcdr cl-i cl-p)))
-		    (setcdr cl-tail (cdr (cdr cl-tail))))
-		  (setq cl-end (1- cl-end)))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)
-		      cl-start (1+ cl-start)))
-	      cl-seq)
-	  (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	  (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
-		      (cl--position (cl--check-key (car cl-seq))
-                                    (cdr cl-seq) 0 (1- cl-end)))
-	    (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
-	  (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
-			(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
-	    (while (and (cdr (cdr cl-p)) (> cl-end 1))
-	      (if (cl--position (cl--check-key (car (cdr cl-p)))
-                                (cdr (cdr cl-p)) 0 (1- cl-end))
-		  (progn
-		    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				      cl-p (nthcdr (1- cl-start) cl-seq)
-				      cl-copy nil))
-		    (setcdr cl-p (cdr (cdr cl-p))))
-		(setq cl-p (cdr cl-p)))
-	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
-	    cl-seq)))
+        (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+          (if cl-from-end
+              (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
+                (setq cl-end (- (or cl-end len) cl-start))
+                (while (> cl-end 1)
+                  (setq cl-i 0)
+                  (while (setq cl-i (cl--position (cl--check-key (car cl-p))
+                                                  (cdr cl-p) cl-i (1- cl-end)))
+                    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                      cl-p (nthcdr cl-start cl-seq) cl-copy nil))
+                    (let ((cl-tail (nthcdr cl-i cl-p)))
+                      (setcdr cl-tail (cdr (cdr cl-tail))))
+                    (setq cl-end (1- cl-end)))
+                  (setq cl-p (cdr cl-p) cl-end (1- cl-end)
+                        cl-start (1+ cl-start)))
+                cl-seq)
+            (setq cl-end (- (or cl-end len) cl-start))
+            (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
+                        (cl--position (cl--check-key (car cl-seq))
+                                      (cdr cl-seq) 0 (1- cl-end)))
+              (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
+            (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
+                          (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
+              (while (and (cdr (cdr cl-p)) (> cl-end 1))
+                (if (cl--position (cl--check-key (car (cdr cl-p)))
+                                  (cdr (cdr cl-p)) 0 (1- cl-end))
+                    (progn
+                      (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                        cl-p (nthcdr (1- cl-start) cl-seq)
+                                        cl-copy nil))
+                      (setcdr cl-p (cdr (cdr cl-p))))
+                  (setq cl-p (cdr cl-p)))
+                (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
+              cl-seq))))
     (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
 
@@ -400,21 +456,22 @@ cl-substitute
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (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 (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))
-	  (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))))))
+                               (:start 0) :end :from-end) ()
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (if (or (eq cl-old cl-new)
+              (<= (or cl-count (setq cl-from-end nil
+                                     cl-count len)) 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))
+            (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)))))))
 
 ;;;###autoload
 (defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
@@ -442,7 +499,7 @@ 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) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (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)))
@@ -518,7 +575,8 @@ cl-position
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not
 			(:start 0) :end :from-end) ()
-    (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (cl--position cl-item cl-seq cl-start (or cl-end len) cl-from-end))))
 
 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
   (if (listp cl-seq)
@@ -562,8 +620,9 @@ cl-count
 \nKeywords supported:  :test :test-not :key :start :end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
-    (let ((cl-count 0) cl-x)
-      (or cl-end (setq cl-end (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys))
+          (cl-count 0) cl-x)
+      (or cl-end (setq cl-end len))
       (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
       (while (< cl-start cl-end)
 	(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
@@ -593,28 +652,31 @@ cl-mismatch
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl--check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl--check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+           (len1 (car lens))
+           (len2 (cdr lens)))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if cl-from-end
+          (progn
+            (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                        (cl--check-match (elt cl-seq1 (1- cl-end1))
+                                         (elt cl-seq2 (1- cl-end2))))
+              (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
+            (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+                 (1- cl-end1)))
+        (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+              (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+          (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                      (cl--check-match (if cl-p1 (car cl-p1)
+                                         (aref cl-seq1 cl-start1))
+                                       (if cl-p2 (car cl-p2)
+                                         (aref cl-seq2 cl-start2))))
+            (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+                  cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+          (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+               cl-start1))))))
 
 ;;;###autoload
 (defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
@@ -624,24 +686,27 @@ cl-search
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if (>= cl-start1 cl-end1)
-	(if cl-from-end cl-end2 cl-start2)
-      (let* ((cl-len (- cl-end1 cl-start1))
-	     (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
-	     (cl-if nil) cl-pos)
-	(setq cl-end2 (- cl-end2 (1- cl-len)))
-	(while (and (< cl-start2 cl-end2)
-		    (setq cl-pos (cl--position cl-first cl-seq2
-                                               cl-start2 cl-end2 cl-from-end))
-		    (apply 'cl-mismatch cl-seq1 cl-seq2
-			   :start1 (1+ cl-start1) :end1 cl-end1
-			   :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
-			   :from-end nil cl-keys))
-	  (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
-	(and (< cl-start2 cl-end2) cl-pos)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+           (len1 (car lens))
+           (len2 (cdr lens)))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if (>= cl-start1 cl-end1)
+          (if cl-from-end cl-end2 cl-start2)
+        (let* ((cl-len (- cl-end1 cl-start1))
+               (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
+               (cl-if nil) cl-pos)
+          (setq cl-end2 (- cl-end2 (1- cl-len)))
+          (while (and (< cl-start2 cl-end2)
+                      (setq cl-pos (cl--position cl-first cl-seq2
+                                                 cl-start2 cl-end2 cl-from-end))
+                      (apply 'cl-mismatch cl-seq1 cl-seq2
+                             :start1 (1+ cl-start1) :end1 cl-end1
+                             :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
+                             :from-end nil cl-keys))
+            (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
+          (and (< cl-start2 cl-end2) cl-pos))))))
 
 ;;;###autoload
 (defun cl-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 61e3d72033..7a7693a515 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -302,6 +302,96 @@ cl-seq--with-side-effects
     (should (equal '(2 8) (last (cl-replace list list2) 2)))
     (should (equal '(1 1) (last (cl-fill list 1) 2)))))
 
+(ert-deftest cl-seq-check-bounds ()
+  (let ((lst (list 1 2 3))
+        (lst2 (list 'a 'b 'c))
+        ;; t means pass, nil means fails.
+        (tests '("((lambda (x y) (cl-reduce #'max x :start 1)) . t)"
+                 "((lambda (x y) (cl-reduce #'max x :start -1)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 4)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-fill x 'b :start 3)) . t)"
+                 "((lambda (x y) (cl-fill x 'b :start 4)))"
+                 "((lambda (x y) (cl-fill x 'b :start -1)))"
+                 "((lambda (x y) (cl-fill x 'b :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-replace x y :start1 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start2 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start1 4)))"
+                 "((lambda (x y) (cl-replace x y :start2 4)))"
+                 "((lambda (x y) (cl-replace x y :start1 -1)))"
+                 "((lambda (x y) (cl-replace x y :start2 -1)))"
+                 "((lambda (x y) (cl-replace x y :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-replace x y :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove nil x :start 4)))"
+                 "((lambda (x y) (cl-remove nil x :start -1)))"
+                 "((lambda (x y) (cl-remove nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete nil x :start 4)))"
+                 "((lambda (x y) (cl-delete nil x :start -1)))"
+                 "((lambda (x y) (cl-delete nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-position 2 x :start 4)))"
+                 "((lambda (x y) (cl-position 2 x :start -1)))"
+                 "((lambda (x y) (cl-position 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-count 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-count 2 x :start 4)))"
+                 "((lambda (x y) (cl-count 2 x :start -1)))"
+                 "((lambda (x y) (cl-count 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 3)) . t)"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 4)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 4 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 -1 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-search x x :start1 3 :start2 3)) . t)"
+                 "((lambda (x y) (cl-search x x :start1 4 :start2 4)))"
+                 "((lambda (x y) (cl-search x x :start1 -1 :start2 3)))"
+                 "((lambda (x y) (cl-search x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-search x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-search x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-subseq x -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -2 -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -4)))"
+                 "((lambda (x y) (cl-subseq x 2 1)))")))
+    (dolist (limit '("start" "end"))
+      (dolist (x tests)
+        (let ((form
+               (car
+                (read-from-string
+                 (cond ((string-match ":start\\([1-2]?\\) \\([0-9-]+\\) :end\\([1-2]?\\)" x)
+                        x)
+                       ((string= limit "start") x)
+                       (t
+                        (replace-regexp-in-string "start" limit x)))))))
+          (if (cdr form)
+              (should (funcall (car form) lst lst2))
+            (should-error (funcall (car form) lst lst2))))))))
+
 
 (provide 'cl-seq-tests)
 ;;; cl-seq-tests.el ends here
-- 
2.11.0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
 of 2017-02-05
Repository revision: 148100d98319499f0ac6f57b8be08cbd14884a5c




^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: [PATCH v3] Bound index checks in cl-seq functions
  2017-02-05  7:11   ` [PATCH v2] " Tino Calancha
@ 2017-02-05 14:56     ` Tino Calancha
  2017-02-05 16:11     ` [PATCH v2] " Clément Pit-Claudel
  1 sibling, 0 replies; 14+ messages in thread
From: Tino Calancha @ 2017-02-05 14:56 UTC (permalink / raw)
  To: Emacs developers

Tino Calancha <tino.calancha@gmail.com> writes:

I have updated the patch with following 3 dots.
(New patch below).

I) Fix mistake in previous patch:
(Following is a diff with respect patch #2)

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 314448ce93..e531fcb511 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -136,13 +136,13 @@ cl--check-bound-indices
         (let* ((idx (match-string 2 (symbol-name (car cl-keys))))
                (len (if (equal idx "2") len2 len1)))
           (when (integerp (cadr cl-keys))
-            (push (cons (car cl-keys) (cadr cl-keys)) alist))
+            (push (cons (car cl-keys) (cadr cl-keys)) alist)
             (when (> (cadr cl-keys) len)
               (error "Wrong bounding indices '%s', %s > (length %s), %s"
                      (substring (symbol-name (car cl-keys)) 1)
                      (cadr cl-keys)
                      (concat "cl-seq" idx)
-                   len))))
+                     len)))))

II) Added test for `cl-delete-duplicates'.

III) Amend `edmacro-format-keys' to prevent `cl-mismatch' call
     with :end1/:end2 > (length seq)
My goblins informed me after some tests at
test/lisp/kmacro-tests.el
started to fail.  The new patch fix that.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 50ab342682911f343e70f58b5eb30b24981a783a Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sun, 5 Feb 2017 23:39:51 +0900
Subject: [PATCH 1/2] Check for out-of-range indices in cl-seq function

Throw and error if the user inputs out of range indices
or if :start value is higher than :end value.
* lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords):
Check for negative indices.
(cl--check-bound-indices): New defun; check for indices > seq length,
or start index > end index.
(cl-reduce, cl-fill, cl-replace, cl-remove, cl-delete)
(cl--delete-duplicates, cl-substitute, cl-nsubstitute, cl-position)
(cl-count, cl-mismatch, cl-search): Use it.
* doc/misc/cl.texi (Sequence Basics): Update manual.
; * etc/NEWS: Announce the change.
* test/lisp/emacs-lisp/cl-seq-tests.el (cl-seq-check-bounds): New test.
---
 doc/misc/cl.texi                     |   4 +-
 etc/NEWS                             |   4 +
 lisp/emacs-lisp/cl-seq.el            | 355 +++++++++++++++++++++--------------
 test/lisp/emacs-lisp/cl-seq-tests.el |  95 ++++++++++
 4 files changed, 312 insertions(+), 146 deletions(-)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 8baa0bd88c..6f387f5cbb 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3247,7 +3247,9 @@ Sequence Basics
 (exclusive) are affected by the operation.  The @var{end} argument
 may be passed @code{nil} to signify the length of the sequence;
 otherwise, both @var{start} and @var{end} must be integers, with
-@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.
+@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.  Emacs
+signals an error when this condition is not true, except for
+@code{cl-subseq} which allows negative indices.
 If the function takes two sequence arguments, the limits are
 defined by keywords @code{:start1} and @code{:end1} for the first,
 and @code{:start2} and @code{:end2} for the second.
diff --git a/etc/NEWS b/etc/NEWS
index cbf2b70c82..b14f8eca5a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -706,6 +706,10 @@ processes on exit.
 * Incompatible Lisp Changes in Emacs 26.1
 
 +++
+** CL sequence functions now throw errors when the input indices
+are out of range, or if :start index is higher than :end index.
+
++++
 ** Resizing a frame no longer runs 'window-configuration-change-hook'.
 Put your function on 'window-size-change-functions' instead.
 
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 67ff1a00bd..e531fcb511 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -42,6 +42,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
 
 ;; Keyword parsing.
 ;; This is special-cased here so that we can compile
@@ -59,7 +60,13 @@ cl--parsing-keywords
                    (setq mem `(and ,mem (setq cl-if ,mem) t)))
                (list (intern
                       (format "cl-%s" (substring (symbol-name var) 1)))
-                     (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+                     `(if (and (string-match ":\\(start\\|end\\)" (symbol-name ,var))
+                               (integerp (or ,mem ,(car (cdr-safe x))))
+                               (not (natnump (or ,mem ,(car (cdr-safe x))))))
+                          (error "Wrong negative index '%s': natnump, %s"
+                                 (substring (symbol-name ,var) 1)
+                                 (or ,mem ,(car (cdr-safe x))))
+                        (or ,mem ,(car (cdr-safe x)))))))
            kwords)
      ,@(append
         (and (not (eq other-keys t))
@@ -112,6 +119,49 @@ cl-test
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
+;; Throw an error when :start or :end are > sequence length,
+;; or if :start > :end.
+;; If CL-SEQ2 is nil, then return (length cl-seq1), otherwise
+;; return (cons (length cl-seq1) (length cl-seq2)).
+(defun cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
+  (let ((len1 (length cl-seq1))
+        (len2 (and cl-seq2 (length cl-seq2)))
+        (kwds (list :start1 :start2 :start :end1 :end2 :end))
+        alist)
+    (while cl-keys
+      (when (and (memq (car cl-keys) kwds)
+                 (string-match ":\\(start\\|end\\)\\([1-2]?\\)\\'"
+                               (symbol-name (car cl-keys))))
+        (delq (car cl-keys) kwds) ; Ignore succesive equal keys.
+        (let* ((idx (match-string 2 (symbol-name (car cl-keys))))
+               (len (if (equal idx "2") len2 len1)))
+          (when (integerp (cadr cl-keys))
+            (push (cons (car cl-keys) (cadr cl-keys)) alist)
+            (when (> (cadr cl-keys) len)
+              (error "Wrong bounding indices '%s', %s > (length %s), %s"
+                     (substring (symbol-name (car cl-keys)) 1)
+                     (cadr cl-keys)
+                     (concat "cl-seq" idx)
+                     len)))))
+      (setq cl-keys (cddr cl-keys)))
+    ;; Check :start value > :end value.
+    (mapc (lambda (x)
+            (and-let* ((start (alist-get (car x) alist))
+                       (end (alist-get (cdr x) alist))
+                       (bad-indices (> start end)))
+              (error "Bad bounding indices '%s', '%s': %d, %d"
+                     (substring (symbol-name (car x)) 1)
+                     (substring (symbol-name (cdr x)) 1)
+                     start
+                     end)))
+          (list (cons :start :end)
+                (cons :start1 :end1)
+                (cons :start2 :end2)))
+    ;; Return sequence lengths.
+    (if len2
+        (cons len1 len2)
+      len1)))
+
 ;;;###autoload
 (defun cl-reduce (cl-func cl-seq &rest cl-keys)
   "Reduce two-argument FUNCTION across SEQ.
@@ -128,6 +178,7 @@ cl-reduce
 
 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+    (cl--check-bound-indices cl-seq nil cl-keys)
     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
     (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
@@ -149,18 +200,19 @@ cl-fill
 \nKeywords supported:  :start :end
 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start 0) :end) ()
-    (if (listp cl-seq)
-	(let ((p (nthcdr cl-start cl-seq))
-	      (n (and cl-end (- cl-end cl-start))))
-	  (while (and p (or (null n) (>= (cl-decf n) 0)))
-	    (setcar p cl-item)
-	    (setq p (cdr p))))
-      (or cl-end (setq cl-end (length cl-seq)))
-      (if (and (= cl-start 0) (= cl-end (length cl-seq)))
-	  (fillarray cl-seq cl-item)
-	(while (< cl-start cl-end)
-	  (aset cl-seq cl-start cl-item)
-	  (setq cl-start (1+ cl-start)))))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (if (listp cl-seq)
+          (let ((p (nthcdr cl-start cl-seq))
+                (n (and cl-end (- cl-end cl-start))))
+            (while (and p (or (null n) (>= (cl-decf n) 0)))
+              (setcar p cl-item)
+              (setq p (cdr p))))
+        (or cl-end (setq cl-end len))
+        (if (and (= cl-start 0) (= cl-end len))
+            (fillarray cl-seq cl-item)
+          (while (< cl-start cl-end)
+            (aset cl-seq cl-start cl-item)
+            (setq cl-start (1+ cl-start))))))
     cl-seq))
 
 ;;;###autoload
@@ -170,44 +222,47 @@ cl-replace
 \nKeywords supported:  :start1 :end1 :start2 :end2
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(setf (elt cl-seq1 (+ cl-start1 cl-n))
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (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 (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)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
+    (let*  ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+            (len1 (car lens))
+            (len2 (cdr lens)))
+      (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
+          (or (= cl-start1 cl-start2)
+              (let* ((cl-len len1)
+                     (cl-n (min (- (or cl-end1 cl-len) cl-start1)
+                                (- (or cl-end2 cl-len) cl-start2))))
+                (while (>= (setq cl-n (1- cl-n)) 0)
+                  (setf (elt cl-seq1 (+ cl-start1 cl-n))
+                        (elt cl-seq2 (+ cl-start2 cl-n))))))
+        (if (listp cl-seq1)
+            (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
+                  (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
+              (if (listp cl-seq2)
+                  (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
+                        (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 (if (null cl-n1)
+                                  (or cl-end2 len2)
+                                (min (or cl-end2 len2)
+                                     (+ 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)))))
+          (setq cl-end1 (min (or cl-end1 len1)
+                             (+ cl-start1 (- (or cl-end2 len2)
+                                             cl-start2))))
+          (if (listp cl-seq2)
+              (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
+                (while (< cl-start1 cl-end1)
+                  (aset cl-seq1 cl-start1 (car cl-p2))
+                  (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
+            (while (< cl-start1 cl-end1)
+              (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
+              (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))))
     cl-seq1))
 
 ;;;###autoload
@@ -219,7 +274,7 @@ cl-remove
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
         (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
@@ -283,7 +338,7 @@ cl-delete
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
       (if (listp cl-seq)
@@ -356,39 +411,40 @@ cl--delete-duplicates
           ;; We need to parse :if, otherwise `cl-if' is unbound.
           (:test :test-not :key (:start 0) :end :from-end :if)
 	  ()
-	(if cl-from-end
-	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
-	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	      (while (> cl-end 1)
-		(setq cl-i 0)
-		(while (setq cl-i (cl--position (cl--check-key (car cl-p))
-                                                (cdr cl-p) cl-i (1- cl-end)))
-		  (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				    cl-p (nthcdr cl-start cl-seq) cl-copy nil))
-		  (let ((cl-tail (nthcdr cl-i cl-p)))
-		    (setcdr cl-tail (cdr (cdr cl-tail))))
-		  (setq cl-end (1- cl-end)))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)
-		      cl-start (1+ cl-start)))
-	      cl-seq)
-	  (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	  (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
-		      (cl--position (cl--check-key (car cl-seq))
-                                    (cdr cl-seq) 0 (1- cl-end)))
-	    (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
-	  (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
-			(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
-	    (while (and (cdr (cdr cl-p)) (> cl-end 1))
-	      (if (cl--position (cl--check-key (car (cdr cl-p)))
-                                (cdr (cdr cl-p)) 0 (1- cl-end))
-		  (progn
-		    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				      cl-p (nthcdr (1- cl-start) cl-seq)
-				      cl-copy nil))
-		    (setcdr cl-p (cdr (cdr cl-p))))
-		(setq cl-p (cdr cl-p)))
-	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
-	    cl-seq)))
+        (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+          (if cl-from-end
+              (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
+                (setq cl-end (- (or cl-end len) cl-start))
+                (while (> cl-end 1)
+                  (setq cl-i 0)
+                  (while (setq cl-i (cl--position (cl--check-key (car cl-p))
+                                                  (cdr cl-p) cl-i (1- cl-end)))
+                    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                      cl-p (nthcdr cl-start cl-seq) cl-copy nil))
+                    (let ((cl-tail (nthcdr cl-i cl-p)))
+                      (setcdr cl-tail (cdr (cdr cl-tail))))
+                    (setq cl-end (1- cl-end)))
+                  (setq cl-p (cdr cl-p) cl-end (1- cl-end)
+                        cl-start (1+ cl-start)))
+                cl-seq)
+            (setq cl-end (- (or cl-end len) cl-start))
+            (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
+                        (cl--position (cl--check-key (car cl-seq))
+                                      (cdr cl-seq) 0 (1- cl-end)))
+              (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
+            (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
+                          (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
+              (while (and (cdr (cdr cl-p)) (> cl-end 1))
+                (if (cl--position (cl--check-key (car (cdr cl-p)))
+                                  (cdr (cdr cl-p)) 0 (1- cl-end))
+                    (progn
+                      (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                        cl-p (nthcdr (1- cl-start) cl-seq)
+                                        cl-copy nil))
+                      (setcdr cl-p (cdr (cdr cl-p))))
+                  (setq cl-p (cdr cl-p)))
+                (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
+              cl-seq))))
     (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
 
@@ -400,21 +456,22 @@ cl-substitute
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (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 (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))
-	  (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))))))
+                               (:start 0) :end :from-end) ()
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (if (or (eq cl-old cl-new)
+              (<= (or cl-count (setq cl-from-end nil
+                                     cl-count len)) 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))
+            (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)))))))
 
 ;;;###autoload
 (defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
@@ -442,7 +499,7 @@ 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) ()
-    (let ((len (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
       (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)))
@@ -518,7 +575,8 @@ cl-position
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not
 			(:start 0) :end :from-end) ()
-    (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys)))
+      (cl--position cl-item cl-seq cl-start (or cl-end len) cl-from-end))))
 
 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
   (if (listp cl-seq)
@@ -562,8 +620,9 @@ cl-count
 \nKeywords supported:  :test :test-not :key :start :end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
-    (let ((cl-count 0) cl-x)
-      (or cl-end (setq cl-end (length cl-seq)))
+    (let ((len (cl--check-bound-indices cl-seq nil cl-keys))
+          (cl-count 0) cl-x)
+      (or cl-end (setq cl-end len))
       (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
       (while (< cl-start cl-end)
 	(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
@@ -593,28 +652,31 @@ cl-mismatch
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl--check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl--check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+           (len1 (car lens))
+           (len2 (cdr lens)))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if cl-from-end
+          (progn
+            (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                        (cl--check-match (elt cl-seq1 (1- cl-end1))
+                                         (elt cl-seq2 (1- cl-end2))))
+              (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
+            (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+                 (1- cl-end1)))
+        (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+              (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+          (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                      (cl--check-match (if cl-p1 (car cl-p1)
+                                         (aref cl-seq1 cl-start1))
+                                       (if cl-p2 (car cl-p2)
+                                         (aref cl-seq2 cl-start2))))
+            (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+                  cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+          (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+               cl-start1))))))
 
 ;;;###autoload
 (defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
@@ -624,24 +686,27 @@ cl-search
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if (>= cl-start1 cl-end1)
-	(if cl-from-end cl-end2 cl-start2)
-      (let* ((cl-len (- cl-end1 cl-start1))
-	     (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
-	     (cl-if nil) cl-pos)
-	(setq cl-end2 (- cl-end2 (1- cl-len)))
-	(while (and (< cl-start2 cl-end2)
-		    (setq cl-pos (cl--position cl-first cl-seq2
-                                               cl-start2 cl-end2 cl-from-end))
-		    (apply 'cl-mismatch cl-seq1 cl-seq2
-			   :start1 (1+ cl-start1) :end1 cl-end1
-			   :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
-			   :from-end nil cl-keys))
-	  (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
-	(and (< cl-start2 cl-end2) cl-pos)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys))
+           (len1 (car lens))
+           (len2 (cdr lens)))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if (>= cl-start1 cl-end1)
+          (if cl-from-end cl-end2 cl-start2)
+        (let* ((cl-len (- cl-end1 cl-start1))
+               (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
+               (cl-if nil) cl-pos)
+          (setq cl-end2 (- cl-end2 (1- cl-len)))
+          (while (and (< cl-start2 cl-end2)
+                      (setq cl-pos (cl--position cl-first cl-seq2
+                                                 cl-start2 cl-end2 cl-from-end))
+                      (apply 'cl-mismatch cl-seq1 cl-seq2
+                             :start1 (1+ cl-start1) :end1 cl-end1
+                             :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
+                             :from-end nil cl-keys))
+            (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
+          (and (< cl-start2 cl-end2) cl-pos))))))
 
 ;;;###autoload
 (defun cl-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 61e3d72033..9c6738048a 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -302,6 +302,101 @@ cl-seq--with-side-effects
     (should (equal '(2 8) (last (cl-replace list list2) 2)))
     (should (equal '(1 1) (last (cl-fill list 1) 2)))))
 
+(ert-deftest cl-seq-check-bounds ()
+  (let ((lst (list 1 2 3))
+        (lst2 (list 'a 'b 'c))
+        ;; t means pass, nil means fails.
+        (tests '("((lambda (x y) (cl-reduce #'max x :start 1)) . t)"
+                 "((lambda (x y) (cl-reduce #'max x :start -1)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 4)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-fill x 'b :start 3)) . t)"
+                 "((lambda (x y) (cl-fill x 'b :start 4)))"
+                 "((lambda (x y) (cl-fill x 'b :start -1)))"
+                 "((lambda (x y) (cl-fill x 'b :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-replace x y :start1 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start2 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start1 4)))"
+                 "((lambda (x y) (cl-replace x y :start2 4)))"
+                 "((lambda (x y) (cl-replace x y :start1 -1)))"
+                 "((lambda (x y) (cl-replace x y :start2 -1)))"
+                 "((lambda (x y) (cl-replace x y :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-replace x y :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove nil x :start 4)))"
+                 "((lambda (x y) (cl-remove nil x :start -1)))"
+                 "((lambda (x y) (cl-remove nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete nil x :start 4)))"
+                 "((lambda (x y) (cl-delete nil x :start -1)))"
+                 "((lambda (x y) (cl-delete nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-delete-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-delete-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-position 2 x :start 4)))"
+                 "((lambda (x y) (cl-position 2 x :start -1)))"
+                 "((lambda (x y) (cl-position 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-count 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-count 2 x :start 4)))"
+                 "((lambda (x y) (cl-count 2 x :start -1)))"
+                 "((lambda (x y) (cl-count 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 3)) . t)"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 4)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 4 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 -1 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-search x x :start1 3 :start2 3)) . t)"
+                 "((lambda (x y) (cl-search x x :start1 4 :start2 4)))"
+                 "((lambda (x y) (cl-search x x :start1 -1 :start2 3)))"
+                 "((lambda (x y) (cl-search x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-search x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-search x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-subseq x -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -2 -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -4)))"
+                 "((lambda (x y) (cl-subseq x 2 1)))")))
+    (dolist (limit '("start" "end"))
+      (dolist (x tests)
+        (let ((form
+               (car
+                (read-from-string
+                 (cond ((string-match ":start\\([1-2]?\\) \\([0-9-]+\\) :end\\([1-2]?\\)" x)
+                        x)
+                       ((string= limit "start") x)
+                       (t
+                        (replace-regexp-in-string "start" limit x)))))))
+          (if (cdr form)
+              (should (funcall (car form) lst lst2))
+            (should-error (funcall (car form) lst lst2))))))))
+
 
 (provide 'cl-seq-tests)
 ;;; cl-seq-tests.el ends here
-- 
2.11.0

From 72e9692cbc02150d9ef6c97011bdb55460686df4 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Sun, 5 Feb 2017 23:41:11 +0900
Subject: [PATCH 2/2] * lisp/edmacro.el (edmacro-format-keys): Prevent :end
 index out-of-range.

---
 lisp/edmacro.el | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 5fefc3102d..c3608829c0 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -560,10 +560,11 @@ edmacro-format-keys
 	(if prefix
 	    (setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
 	(unless (string-match " " desc)
-	  (let ((times 1) (pos bind-len))
+	  (let ((times 1) (pos bind-len)
+	        (rest-mac-len (length rest-mac)))
 	    (while (not (cl-mismatch rest-mac rest-mac
-				     :start1 0 :end1 bind-len
-				     :start2 pos :end2 (+ bind-len pos)))
+				     :start1 0 :end1 (min bind-len rest-mac-len)
+				     :start2 pos :end2 (min (+ bind-len pos) rest-mac-len)))
 	      (cl-incf times)
 	      (cl-incf pos bind-len))
 	    (when (> times 1)
-- 
2.11.0


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
 of 2017-02-05
Repository revision: 148100d98319499f0ac6f57b8be08cbd14884a5c



^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: [PATCH v2] Bound index checks in cl-seq functions
  2017-02-05  7:11   ` [PATCH v2] " Tino Calancha
  2017-02-05 14:56     ` [PATCH v3] " Tino Calancha
@ 2017-02-05 16:11     ` Clément Pit-Claudel
  2017-02-06  7:00       ` [PATCH v4] " Tino Calancha
  1 sibling, 1 reply; 14+ messages in thread
From: Clément Pit-Claudel @ 2017-02-05 16:11 UTC (permalink / raw)
  To: Tino Calancha, Noam Postavsky; +Cc: Philipp Stephani, Emacs developers

On 2017-02-05 02:11, Tino Calancha wrote:
> II) `cl--check-bound-indices' returns on success the sequence[s]
>     length[s], so that callers don't need to recompute them.

This sounds like a good idea, performance wise.  But maybe it would be even better to disable these checks when (cl-declaim (optimize (safety 0))) is set?

Clément.



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: [PATCH v4] Bound index checks in cl-seq functions
  2017-02-05 16:11     ` [PATCH v2] " Clément Pit-Claudel
@ 2017-02-06  7:00       ` Tino Calancha
  2017-02-06  7:15         ` Clément Pit-Claudel
  0 siblings, 1 reply; 14+ messages in thread
From: Tino Calancha @ 2017-02-06  7:00 UTC (permalink / raw)
  To: Clément Pit-Claudel
  Cc: Philipp Stephani, Noam Postavsky, Emacs developers, Tino Calancha

Clément Pit-Claudel <cpitclaudel@gmail.com> writes:

> On 2017-02-05 02:11, Tino Calancha wrote:
>> II) `cl--check-bound-indices' returns on success the sequence[s]
>>     length[s], so that callers don't need to recompute them.
>
> This sounds like a good idea, performance wise.  But maybe it would be
> even better to disable these checks when (cl-declaim (optimize (safety
> 0))) is set?
Yes, that sounds right.
The new patch disables those checks in that case (safety = 0).
I got ~0.92 s without checks and ~ 1.10 with checks
when i ran the following toy:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; start
;; -*- lexical-binding: t; -*-

(require 'cl-lib)

(cl-declaim (optimize (safety 0))) ; (test) ~ 0.92
;(cl-declaim (optimize (safety 1))) ; (test) ~ 1.10
       
(defun test ()
  (let ((lst (nreverse (cons 'a (number-sequence 1 1000000)))))
    (benchmark-run 10
      (cl-position 'a lst))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end

Following is the updated patch:

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
From a57cc0105e315382715edba1baa9b814b947675d Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Mon, 6 Feb 2017 15:20:51 +0900
Subject: [PATCH 1/2] Check for out-of-range indices in cl-seq function

Throw and error if the user inputs out of range indices
or if :start value is higher than :end value.
Suppress these checks if 'cl--optimize-safety' 0.
* lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords):
Check for negative indices.
(cl--check-bound-indices): New defun; check for indices > seq length,
or start index > end index.
(cl-reduce, cl-fill, cl-replace, cl-remove, cl-delete)
(cl--delete-duplicates, cl-substitute, cl-nsubstitute, cl-position)
(cl-count, cl-mismatch, cl-search): Use it.
* doc/misc/cl.texi (Sequence Basics): Update manual.
; * etc/NEWS: Announce the change.
* test/lisp/emacs-lisp/cl-seq-tests.el (cl-seq-check-bounds): New test.
---
 doc/misc/cl.texi                     |   4 +-
 etc/NEWS                             |   4 +
 lisp/emacs-lisp/cl-seq.el            | 379 +++++++++++++++++++++--------------
 test/lisp/emacs-lisp/cl-seq-tests.el |  95 +++++++++
 4 files changed, 335 insertions(+), 147 deletions(-)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 8baa0bd88c..6f387f5cbb 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3247,7 +3247,9 @@ Sequence Basics
 (exclusive) are affected by the operation.  The @var{end} argument
 may be passed @code{nil} to signify the length of the sequence;
 otherwise, both @var{start} and @var{end} must be integers, with
-@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.
+@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}.  Emacs
+signals an error when this condition is not true, except for
+@code{cl-subseq} which allows negative indices.
 If the function takes two sequence arguments, the limits are
 defined by keywords @code{:start1} and @code{:end1} for the first,
 and @code{:start2} and @code{:end2} for the second.
diff --git a/etc/NEWS b/etc/NEWS
index 4d8ae091a7..19dd5d9995 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -706,6 +706,10 @@ processes on exit.
 * Incompatible Lisp Changes in Emacs 26.1
 
 +++
+** CL sequence functions now throw errors when the input indices
+are out of range, or if :start index is higher than :end index.
+
++++
 ** Resizing a frame no longer runs 'window-configuration-change-hook'.
 Put your function on 'window-size-change-functions' instead.
 
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 67ff1a00bd..4ea9ebb063 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -42,6 +42,9 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
+
+(defvar cl--optimize-safety)
 
 ;; Keyword parsing.
 ;; This is special-cased here so that we can compile
@@ -59,7 +62,14 @@ cl--parsing-keywords
                    (setq mem `(and ,mem (setq cl-if ,mem) t)))
                (list (intern
                       (format "cl-%s" (substring (symbol-name var) 1)))
-                     (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+                     `(if (and (not (zerop cl--optimize-safety))
+                               (string-match ":\\(start\\|end\\)" (symbol-name ,var))
+                               (integerp (or ,mem ,(car (cdr-safe x))))
+                               (not (natnump (or ,mem ,(car (cdr-safe x))))))
+                          (error "Wrong negative index '%s': natnump, %s"
+                                 (substring (symbol-name ,var) 1)
+                                 (or ,mem ,(car (cdr-safe x))))
+                        (or ,mem ,(car (cdr-safe x)))))))
            kwords)
      ,@(append
         (and (not (eq other-keys t))
@@ -112,6 +122,49 @@ cl-test
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
+;; Throw an error when :start or :end are > sequence length,
+;; or if :start > :end.
+;; If CL-SEQ2 is nil, then return (length cl-seq1), otherwise
+;; return (cons (length cl-seq1) (length cl-seq2)).
+(defun cl--check-bound-indices (cl-seq1 cl-seq2 cl-keys)
+  (let ((len1 (length cl-seq1))
+        (len2 (and cl-seq2 (length cl-seq2)))
+        (kwds (list :start1 :start2 :start :end1 :end2 :end))
+        alist)
+    (while cl-keys
+      (when (and (memq (car cl-keys) kwds)
+                 (string-match ":\\(start\\|end\\)\\([1-2]?\\)\\'"
+                               (symbol-name (car cl-keys))))
+        (delq (car cl-keys) kwds) ; Ignore succesive equal keys.
+        (let* ((idx (match-string 2 (symbol-name (car cl-keys))))
+               (len (if (equal idx "2") len2 len1)))
+          (when (integerp (cadr cl-keys))
+            (push (cons (car cl-keys) (cadr cl-keys)) alist)
+            (when (> (cadr cl-keys) len)
+              (error "Wrong bounding indices '%s', %s > (length %s), %s"
+                     (substring (symbol-name (car cl-keys)) 1)
+                     (cadr cl-keys)
+                     (concat "cl-seq" idx)
+                     len)))))
+      (setq cl-keys (cddr cl-keys)))
+    ;; Check :start value > :end value.
+    (mapc (lambda (x)
+            (and-let* ((start (alist-get (car x) alist))
+                       (end (alist-get (cdr x) alist))
+                       (bad-indices (> start end)))
+              (error "Bad bounding indices '%s', '%s': %d, %d"
+                     (substring (symbol-name (car x)) 1)
+                     (substring (symbol-name (cdr x)) 1)
+                     start
+                     end)))
+          (list (cons :start :end)
+                (cons :start1 :end1)
+                (cons :start2 :end2)))
+    ;; Return sequence lengths.
+    (if len2
+        (cons len1 len2)
+      len1)))
+
 ;;;###autoload
 (defun cl-reduce (cl-func cl-seq &rest cl-keys)
   "Reduce two-argument FUNCTION across SEQ.
@@ -128,6 +181,7 @@ cl-reduce
 
 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+    (or (zerop cl--optimize-safety) (cl--check-bound-indices cl-seq nil cl-keys))
     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
     (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
@@ -149,18 +203,21 @@ cl-fill
 \nKeywords supported:  :start :end
 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start 0) :end) ()
-    (if (listp cl-seq)
-	(let ((p (nthcdr cl-start cl-seq))
-	      (n (and cl-end (- cl-end cl-start))))
-	  (while (and p (or (null n) (>= (cl-decf n) 0)))
-	    (setcar p cl-item)
-	    (setq p (cdr p))))
-      (or cl-end (setq cl-end (length cl-seq)))
-      (if (and (= cl-start 0) (= cl-end (length cl-seq)))
-	  (fillarray cl-seq cl-item)
-	(while (< cl-start cl-end)
-	  (aset cl-seq cl-start cl-item)
-	  (setq cl-start (1+ cl-start)))))
+    (let ((len (if (zerop cl--optimize-safety)
+                   (or cl-end (length cl-seq))
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
+      (if (listp cl-seq)
+          (let ((p (nthcdr cl-start cl-seq))
+                (n (and cl-end (- cl-end cl-start))))
+            (while (and p (or (null n) (>= (cl-decf n) 0)))
+              (setcar p cl-item)
+              (setq p (cdr p))))
+        (or cl-end (setq cl-end len))
+        (if (and (= cl-start 0) (= cl-end len))
+            (fillarray cl-seq cl-item)
+          (while (< cl-start cl-end)
+            (aset cl-seq cl-start cl-item)
+            (setq cl-start (1+ cl-start))))))
     cl-seq))
 
 ;;;###autoload
@@ -170,44 +227,48 @@ cl-replace
 \nKeywords supported:  :start1 :end1 :start2 :end2
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(setf (elt cl-seq1 (+ cl-start1 cl-n))
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (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 (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)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
+    (let*  ((lens (and (not (zerop cl--optimize-safety))
+                       (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)))
+            (len1 (if lens (car lens) (or cl-end1 (length cl-seq1))))
+            (len2 (if lens (cdr lens) (or cl-end2 (length cl-seq2)))))
+      (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
+          (or (= cl-start1 cl-start2)
+              (let* ((cl-len len1)
+                     (cl-n (min (- (or cl-end1 cl-len) cl-start1)
+                                (- (or cl-end2 cl-len) cl-start2))))
+                (while (>= (setq cl-n (1- cl-n)) 0)
+                  (setf (elt cl-seq1 (+ cl-start1 cl-n))
+                        (elt cl-seq2 (+ cl-start2 cl-n))))))
+        (if (listp cl-seq1)
+            (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
+                  (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
+              (if (listp cl-seq2)
+                  (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
+                        (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 (if (null cl-n1)
+                                  (or cl-end2 len2)
+                                (min (or cl-end2 len2)
+                                     (+ 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)))))
+          (setq cl-end1 (min (or cl-end1 len1)
+                             (+ cl-start1 (- (or cl-end2 len2)
+                                             cl-start2))))
+          (if (listp cl-seq2)
+              (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
+                (while (< cl-start1 cl-end1)
+                  (aset cl-seq1 cl-start1 (car cl-p2))
+                  (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
+            (while (< cl-start1 cl-end1)
+              (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
+              (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))))
     cl-seq1))
 
 ;;;###autoload
@@ -219,7 +280,9 @@ cl-remove
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (if (zerop cl--optimize-safety)
+                   (length cl-seq)
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
         (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
@@ -283,7 +346,9 @@ cl-delete
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
 			(:start 0) :end) ()
-    (let ((len (length cl-seq)))
+    (let ((len (if (zerop cl--optimize-safety)
+                   (length cl-seq)
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
       (if (<= (or cl-count (setq cl-count len)) 0)
 	cl-seq
       (if (listp cl-seq)
@@ -356,39 +421,42 @@ cl--delete-duplicates
           ;; We need to parse :if, otherwise `cl-if' is unbound.
           (:test :test-not :key (:start 0) :end :from-end :if)
 	  ()
-	(if cl-from-end
-	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
-	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	      (while (> cl-end 1)
-		(setq cl-i 0)
-		(while (setq cl-i (cl--position (cl--check-key (car cl-p))
-                                                (cdr cl-p) cl-i (1- cl-end)))
-		  (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				    cl-p (nthcdr cl-start cl-seq) cl-copy nil))
-		  (let ((cl-tail (nthcdr cl-i cl-p)))
-		    (setcdr cl-tail (cdr (cdr cl-tail))))
-		  (setq cl-end (1- cl-end)))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)
-		      cl-start (1+ cl-start)))
-	      cl-seq)
-	  (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	  (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
-		      (cl--position (cl--check-key (car cl-seq))
-                                    (cdr cl-seq) 0 (1- cl-end)))
-	    (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
-	  (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
-			(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
-	    (while (and (cdr (cdr cl-p)) (> cl-end 1))
-	      (if (cl--position (cl--check-key (car (cdr cl-p)))
-                                (cdr (cdr cl-p)) 0 (1- cl-end))
-		  (progn
-		    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				      cl-p (nthcdr (1- cl-start) cl-seq)
-				      cl-copy nil))
-		    (setcdr cl-p (cdr (cdr cl-p))))
-		(setq cl-p (cdr cl-p)))
-	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
-	    cl-seq)))
+        (let ((len (if (zerop cl--optimize-safety)
+                   (or cl-end (length cl-seq))
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
+          (if cl-from-end
+              (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
+                (setq cl-end (- (or cl-end len) cl-start))
+                (while (> cl-end 1)
+                  (setq cl-i 0)
+                  (while (setq cl-i (cl--position (cl--check-key (car cl-p))
+                                                  (cdr cl-p) cl-i (1- cl-end)))
+                    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                      cl-p (nthcdr cl-start cl-seq) cl-copy nil))
+                    (let ((cl-tail (nthcdr cl-i cl-p)))
+                      (setcdr cl-tail (cdr (cdr cl-tail))))
+                    (setq cl-end (1- cl-end)))
+                  (setq cl-p (cdr cl-p) cl-end (1- cl-end)
+                        cl-start (1+ cl-start)))
+                cl-seq)
+            (setq cl-end (- (or cl-end len) cl-start))
+            (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
+                        (cl--position (cl--check-key (car cl-seq))
+                                      (cdr cl-seq) 0 (1- cl-end)))
+              (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
+            (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
+                          (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
+              (while (and (cdr (cdr cl-p)) (> cl-end 1))
+                (if (cl--position (cl--check-key (car (cdr cl-p)))
+                                  (cdr (cdr cl-p)) 0 (1- cl-end))
+                    (progn
+                      (if cl-copy (setq cl-seq (copy-sequence cl-seq)
+                                        cl-p (nthcdr (1- cl-start) cl-seq)
+                                        cl-copy nil))
+                      (setcdr cl-p (cdr (cdr cl-p))))
+                  (setq cl-p (cdr cl-p)))
+                (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
+              cl-seq))))
     (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
 
@@ -400,21 +468,24 @@ cl-substitute
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (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 (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))
-	  (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))))))
+                               (:start 0) :end :from-end) ()
+    (let ((len (if (zerop cl--optimize-safety)
+                   (length cl-seq)
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
+      (if (or (eq cl-old cl-new)
+              (<= (or cl-count (setq cl-from-end nil
+                                     cl-count len)) 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))
+            (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)))))))
 
 ;;;###autoload
 (defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
@@ -442,7 +513,9 @@ 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) ()
-    (let ((len (length cl-seq)))
+    (let ((len (if (zerop cl--optimize-safety)
+                   (length cl-seq)
+                 (cl--check-bound-indices cl-seq nil cl-keys))))
       (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)))
@@ -517,8 +590,11 @@ cl-position
 \nKeywords supported:  :test :test-not :key :start :end :from-end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not
-			(:start 0) :end :from-end) ()
-    (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
+                               (:start 0) :end :from-end) ()
+    (let ((end (if (not (zerop cl--optimize-safety))
+                   (cl--check-bound-indices cl-seq nil cl-keys)
+                 cl-end)))
+      (cl--position cl-item cl-seq cl-start end cl-from-end))))
 
 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
   (if (listp cl-seq)
@@ -562,8 +638,11 @@ cl-count
 \nKeywords supported:  :test :test-not :key :start :end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
-    (let ((cl-count 0) cl-x)
-      (or cl-end (setq cl-end (length cl-seq)))
+    (let ((len (if (zerop cl--optimize-safety)
+                   (or cl-end (length cl-seq))
+                 (cl--check-bound-indices cl-seq nil cl-keys)))
+          (cl-count 0) cl-x)
+      (or cl-end (setq cl-end len))
       (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
       (while (< cl-start cl-end)
 	(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
@@ -593,28 +672,32 @@ cl-mismatch
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl--check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl--check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (and (not (zerop cl--optimize-safety))
+                       (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)))
+            (len1 (if lens (car lens) (or cl-end1 (length cl-seq1))))
+            (len2 (if lens (cdr lens) (or cl-end2 (length cl-seq2)))))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if cl-from-end
+          (progn
+            (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                        (cl--check-match (elt cl-seq1 (1- cl-end1))
+                                         (elt cl-seq2 (1- cl-end2))))
+              (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
+            (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+                 (1- cl-end1)))
+        (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+              (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+          (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+                      (cl--check-match (if cl-p1 (car cl-p1)
+                                         (aref cl-seq1 cl-start1))
+                                       (if cl-p2 (car cl-p2)
+                                         (aref cl-seq2 cl-start2))))
+            (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+                  cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+          (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+               cl-start1))))))
 
 ;;;###autoload
 (defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
@@ -624,24 +707,28 @@ cl-search
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if (>= cl-start1 cl-end1)
-	(if cl-from-end cl-end2 cl-start2)
-      (let* ((cl-len (- cl-end1 cl-start1))
-	     (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
-	     (cl-if nil) cl-pos)
-	(setq cl-end2 (- cl-end2 (1- cl-len)))
-	(while (and (< cl-start2 cl-end2)
-		    (setq cl-pos (cl--position cl-first cl-seq2
-                                               cl-start2 cl-end2 cl-from-end))
-		    (apply 'cl-mismatch cl-seq1 cl-seq2
-			   :start1 (1+ cl-start1) :end1 cl-end1
-			   :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
-			   :from-end nil cl-keys))
-	  (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
-	(and (< cl-start2 cl-end2) cl-pos)))))
+                               (:start1 0) :end1 (:start2 0) :end2) ()
+    (let* ((lens (and (not (zerop cl--optimize-safety))
+                       (cl--check-bound-indices cl-seq1 cl-seq2 cl-keys)))
+            (len1 (if lens (car lens) (or cl-end1 (length cl-seq1))))
+            (len2 (if lens (cdr lens) (or cl-end2 (length cl-seq2)))))
+      (or cl-end1 (setq cl-end1 len1))
+      (or cl-end2 (setq cl-end2 len2))
+      (if (>= cl-start1 cl-end1)
+          (if cl-from-end cl-end2 cl-start2)
+        (let* ((cl-len (- cl-end1 cl-start1))
+               (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
+               (cl-if nil) cl-pos)
+          (setq cl-end2 (- cl-end2 (1- cl-len)))
+          (while (and (< cl-start2 cl-end2)
+                      (setq cl-pos (cl--position cl-first cl-seq2
+                                                 cl-start2 cl-end2 cl-from-end))
+                      (apply 'cl-mismatch cl-seq1 cl-seq2
+                             :start1 (1+ cl-start1) :end1 cl-end1
+                             :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
+                             :from-end nil cl-keys))
+            (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
+          (and (< cl-start2 cl-end2) cl-pos))))))
 
 ;;;###autoload
 (defun cl-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 61e3d72033..9c6738048a 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -302,6 +302,101 @@ cl-seq--with-side-effects
     (should (equal '(2 8) (last (cl-replace list list2) 2)))
     (should (equal '(1 1) (last (cl-fill list 1) 2)))))
 
+(ert-deftest cl-seq-check-bounds ()
+  (let ((lst (list 1 2 3))
+        (lst2 (list 'a 'b 'c))
+        ;; t means pass, nil means fails.
+        (tests '("((lambda (x y) (cl-reduce #'max x :start 1)) . t)"
+                 "((lambda (x y) (cl-reduce #'max x :start -1)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 4)))"
+                 "((lambda (x y) (cl-reduce #'max x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-fill x 'b :start 3)) . t)"
+                 "((lambda (x y) (cl-fill x 'b :start 4)))"
+                 "((lambda (x y) (cl-fill x 'b :start -1)))"
+                 "((lambda (x y) (cl-fill x 'b :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-replace x y :start1 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start2 3)) . t)"
+                 "((lambda (x y) (cl-replace x y :start1 4)))"
+                 "((lambda (x y) (cl-replace x y :start2 4)))"
+                 "((lambda (x y) (cl-replace x y :start1 -1)))"
+                 "((lambda (x y) (cl-replace x y :start2 -1)))"
+                 "((lambda (x y) (cl-replace x y :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-replace x y :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove nil x :start 4)))"
+                 "((lambda (x y) (cl-remove nil x :start -1)))"
+                 "((lambda (x y) (cl-remove nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete nil x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete nil x :start 4)))"
+                 "((lambda (x y) (cl-delete nil x :start -1)))"
+                 "((lambda (x y) (cl-delete nil x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-delete-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-delete-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-delete-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-delete-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-remove-duplicates x :start 3)) . t)"
+                 "((lambda (x y) (cl-remove-duplicates x :start 4)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start -1)))"
+                 "((lambda (x y) (cl-remove-duplicates x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-substitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 4)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start -1)))"
+                 "((lambda (x y) (cl-nsubstitute 'foo 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-position 2 x :start 4)))"
+                 "((lambda (x y) (cl-position 2 x :start -1)))"
+                 "((lambda (x y) (cl-position 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-count 2 x :start 3)) . t)"
+                 "((lambda (x y) (cl-count 2 x :start 4)))"
+                 "((lambda (x y) (cl-count 2 x :start -1)))"
+                 "((lambda (x y) (cl-count 2 x :start 2 :end 1)))"
+                 ;;
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 3)) . t)"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 4)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 4 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 -1 :start2 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-mismatch x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-mismatch x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-search x x :start1 3 :start2 3)) . t)"
+                 "((lambda (x y) (cl-search x x :start1 4 :start2 4)))"
+                 "((lambda (x y) (cl-search x x :start1 -1 :start2 3)))"
+                 "((lambda (x y) (cl-search x x :start1 1 :start2 -1)))"
+                 "((lambda (x y) (cl-search x x :start1 2 :end1 1)))"
+                 "((lambda (x y) (cl-search x x :start2 2 :end2 1)))"
+                 ;;
+                 "((lambda (x y) (cl-subseq x -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -2 -1)) . t)"
+                 "((lambda (x y) (cl-subseq x -4)))"
+                 "((lambda (x y) (cl-subseq x 2 1)))")))
+    (dolist (limit '("start" "end"))
+      (dolist (x tests)
+        (let ((form
+               (car
+                (read-from-string
+                 (cond ((string-match ":start\\([1-2]?\\) \\([0-9-]+\\) :end\\([1-2]?\\)" x)
+                        x)
+                       ((string= limit "start") x)
+                       (t
+                        (replace-regexp-in-string "start" limit x)))))))
+          (if (cdr form)
+              (should (funcall (car form) lst lst2))
+            (should-error (funcall (car form) lst lst2))))))))
+
 
 (provide 'cl-seq-tests)
 ;;; cl-seq-tests.el ends here
-- 
2.11.0

From be0427570b987e942c934ab8ee841dc326a1a0be Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Mon, 6 Feb 2017 15:21:03 +0900
Subject: [PATCH 2/2] * lisp/edmacro.el (edmacro-format-keys): Prevent :end
 index out-of-range.

---
 lisp/edmacro.el | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 5fefc3102d..c3608829c0 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -560,10 +560,11 @@ edmacro-format-keys
 	(if prefix
 	    (setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
 	(unless (string-match " " desc)
-	  (let ((times 1) (pos bind-len))
+	  (let ((times 1) (pos bind-len)
+	        (rest-mac-len (length rest-mac)))
 	    (while (not (cl-mismatch rest-mac rest-mac
-				     :start1 0 :end1 bind-len
-				     :start2 pos :end2 (+ bind-len pos)))
+				     :start1 0 :end1 (min bind-len rest-mac-len)
+				     :start2 pos :end2 (min (+ bind-len pos) rest-mac-len)))
 	      (cl-incf times)
 	      (cl-incf pos bind-len))
 	    (when (> times 1)
-- 
2.11.0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
 of 2017-02-06
Repository revision: d45dbccc5d2360818e70bbb0bc816c62c8cf6cbe



^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: [PATCH v4] Bound index checks in cl-seq functions
  2017-02-06  7:00       ` [PATCH v4] " Tino Calancha
@ 2017-02-06  7:15         ` Clément Pit-Claudel
  0 siblings, 0 replies; 14+ messages in thread
From: Clément Pit-Claudel @ 2017-02-06  7:15 UTC (permalink / raw)
  To: Tino Calancha; +Cc: Philipp Stephani, Emacs developers, Noam Postavsky

On 2017-02-06 02:00, Tino Calancha wrote:
> Clément Pit-Claudel <cpitclaudel@gmail.com> writes:
>> On 2017-02-05 02:11, Tino Calancha wrote:
>>> II) `cl--check-bound-indices' returns on success the sequence[s]
>>>     length[s], so that callers don't need to recompute them.
>> This sounds like a good idea, performance wise.  But maybe it would be
>> even better to disable these checks when (cl-declaim (optimize (safety
>> 0))) is set?
> Yes, that sounds right.
> The new patch disables those checks in that case (safety = 0).
> I got ~0.92 s without checks and ~ 1.10 with checks
> when i ran the following toy:

Great, thanks! :)



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: [PATCH v4] Bound index checks in cl-seq functions
  2017-02-04 16:40 [PATCH] Bound index checks in cl-seq functions Tino Calancha
  2017-02-04 20:42 ` Philipp Stephani
  2017-02-04 20:51 ` Noam Postavsky
@ 2017-02-10  7:43 ` Tino Calancha
  2017-03-03  4:47   ` Tino Calancha
  2017-02-12 21:26 ` [PATCH] " Johan Bockgård
  3 siblings, 1 reply; 14+ messages in thread
From: Tino Calancha @ 2017-02-10  7:43 UTC (permalink / raw)
  To: John Wiegley, Eli Zaretskii
  Cc: Noam Postavsky, Philipp Stephani, tino.calancha,
	Clément Pit-Claudel, Emacs developers

Tino Calancha <tino.calancha@gmail.com> writes:

> Consider following evaluations:
>
> (cl-position 2 (list 1 2 3) :start -999)
> => -998
> (cl-position 2 (list 1 2 3) :start 999)
> => nil
> (cl-position 2 (list 1 2 3) :start 1 :end 0)
> => nil
>
> *) In the first two, the indices are out of range.
> *) In the 3rd, the start index is higher than the end index.
>
> Guy L. Steele recommends to throw an error in those cases:
> http://www.lispworks.com/documentation/HyperSpec/Issues/iss332_w.htm
>
> We have partially done the job, at least for `cl-subseq':
> (cl-subseq (list 1 2 3) 999)
> ; Signal: "Bad bounding indices: 999, nil"
>
> (cl-subseq (list 1 2 3) -999)
> ; Signal: "Bad bounding indices: -999, nil"
>
> (cl-subseq (list 1 2 3) -1)
> => (3) ; This is OK as documented in the docstring.
>
> See:
> https://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00182.html
>
> It would be nice if all the sequence functions in cl-seq.el
> throw errors in those situations.
Dear maintainers,

do you agree with pushing to master the patch v4 for this thread ?
Here:
https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00191.html

Any further suggestion/comment or something to address?

Thanks,
Tino



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: [PATCH] Bound index checks in cl-seq functions
  2017-02-04 16:40 [PATCH] Bound index checks in cl-seq functions Tino Calancha
                   ` (2 preceding siblings ...)
  2017-02-10  7:43 ` Tino Calancha
@ 2017-02-12 21:26 ` Johan Bockgård
  3 siblings, 0 replies; 14+ messages in thread
From: Johan Bockgård @ 2017-02-12 21:26 UTC (permalink / raw)
  To: Tino Calancha; +Cc: Emacs developers

Tino Calancha <tino.calancha@gmail.com> writes:

> Guy L. Steele recommends to throw an error in those cases:
> http://www.lispworks.com/documentation/HyperSpec/Issues/iss332_w.htm

FWIW, the phrase "is an error" means that the consequences are
undefined—it does not mean that an error must be signaled.



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: Bound index checks in cl-seq functions
  2017-02-10  7:43 ` Tino Calancha
@ 2017-03-03  4:47   ` Tino Calancha
  2017-03-03 13:52     ` Eli Zaretskii
  0 siblings, 1 reply; 14+ messages in thread
From: Tino Calancha @ 2017-03-03  4:47 UTC (permalink / raw)
  To: John Wiegley, Eli Zaretskii; +Cc: tino.calancha, Emacs developers

Tino Calancha <tino.calancha@gmail.com> writes:

> Tino Calancha <tino.calancha@gmail.com> writes:
>
>> Consider following evaluations:
>>
>> (cl-position 2 (list 1 2 3) :start -999)
>> => -998
>> (cl-position 2 (list 1 2 3) :start 999)
>> => nil
>> (cl-position 2 (list 1 2 3) :start 1 :end 0)
>> => nil
>>
>> *) In the first two, the indices are out of range.
>> *) In the 3rd, the start index is higher than the end index.
>>
>> Guy L. Steele recommends to throw an error in those cases:
>> http://www.lispworks.com/documentation/HyperSpec/Issues/iss332_w.htm
>>
>> We have partially done the job, at least for `cl-subseq':
>> (cl-subseq (list 1 2 3) 999)
>> ; Signal: "Bad bounding indices: 999, nil"
>>
>> (cl-subseq (list 1 2 3) -999)
>> ; Signal: "Bad bounding indices: -999, nil"
>>
>> (cl-subseq (list 1 2 3) -1)
>> => (3) ; This is OK as documented in the docstring.
>>
>> See:
>> https://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00182.html
>>
>> It would be nice if all the sequence functions in cl-seq.el
>> throw errors in those situations.
> Dear maintainers,
>
> do you agree with pushing to master the patch v4 for this thread ?
> Here:
> https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00191.html
>
> Any further suggestion/comment or something to address?
Dear John and Eli,

i am curious if you have any opinion on this thread.  Currently just
`cl-subseq' performs the bounding check index.  I don't see a
clear reason why just this function do it.
Are you in favour or against doing those checks in other functions
handling sequences?

Regards,
Tino



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: Bound index checks in cl-seq functions
  2017-03-03  4:47   ` Tino Calancha
@ 2017-03-03 13:52     ` Eli Zaretskii
  2017-04-14 22:01       ` John Wiegley
  0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2017-03-03 13:52 UTC (permalink / raw)
  To: Tino Calancha; +Cc: jwiegley, emacs-devel

> From: Tino Calancha <tino.calancha@gmail.com>
> Cc: Emacs developers <emacs-devel@gnu.org>, tino.calancha@gmail.com
> Date: Fri, 03 Mar 2017 13:47:45 +0900
> 
> i am curious if you have any opinion on this thread.  Currently just
> `cl-subseq' performs the bounding check index.  I don't see a
> clear reason why just this function do it.
> Are you in favour or against doing those checks in other functions
> handling sequences?

I don't have any firm opinions on this.  I do note, however, that your
motivation for signaling an error was contested.  So I wonder whether
the cause for this is strong enough to make that change.  But I'm
willing to defer to people who use these features more than I do.



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: Bound index checks in cl-seq functions
  2017-03-03 13:52     ` Eli Zaretskii
@ 2017-04-14 22:01       ` John Wiegley
  2017-04-25 11:14         ` Tino Calancha
  0 siblings, 1 reply; 14+ messages in thread
From: John Wiegley @ 2017-04-14 22:01 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: emacs-devel, Tino Calancha

>>>>> Eli Zaretskii <eliz@gnu.org> writes:

>> i am curious if you have any opinion on this thread.  Currently just
>> `cl-subseq' performs the bounding check index.  I don't see a
>> clear reason why just this function do it.
>> Are you in favour or against doing those checks in other functions
>> handling sequences?

> I don't have any firm opinions on this. I do note, however, that your
> motivation for signaling an error was contested. So I wonder whether the
> cause for this is strong enough to make that change. But I'm willing to
> defer to people who use these features more than I do.

I also don't have a strong opinion. Bounds checking is usually helpful, if it
would help those who are using these functions. Otherwise, I wouldn't make the
change "just to make the change", even though it sounds like a good idea.

-- 
John Wiegley                  GPG fingerprint = 4710 CF98 AF9B 327B B80F
http://newartisans.com                          60E1 46C4 BD1A 7AC1 4BA2



^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: Bound index checks in cl-seq functions
  2017-04-14 22:01       ` John Wiegley
@ 2017-04-25 11:14         ` Tino Calancha
  0 siblings, 0 replies; 14+ messages in thread
From: Tino Calancha @ 2017-04-25 11:14 UTC (permalink / raw)
  To: John Wiegley; +Cc: Eli Zaretskii, emacs-devel, Tino Calancha



On Fri, 14 Apr 2017, John Wiegley wrote:

>>>>>> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> i am curious if you have any opinion on this thread.  Currently just
>>> `cl-subseq' performs the bounding check index.  I don't see a
>>> clear reason why just this function do it.
>>> Are you in favour or against doing those checks in other functions
>>> handling sequences?
>
>> I don't have any firm opinions on this. I do note, however, that your
>> motivation for signaling an error was contested. So I wonder whether the
>> cause for this is strong enough to make that change. But I'm willing to
>> defer to people who use these features more than I do.
>
> I also don't have a strong opinion. Bounds checking is usually helpful, if it
> would help those who are using these functions. Otherwise, I wouldn't make the
> change "just to make the change", even though it sounds like a good idea.
Thank you.
I am fine with not adding this patch.



^ permalink raw reply	[flat|nested] 14+ messages in thread

end of thread, other threads:[~2017-04-25 11:14 UTC | newest]

Thread overview: 14+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-02-04 16:40 [PATCH] Bound index checks in cl-seq functions Tino Calancha
2017-02-04 20:42 ` Philipp Stephani
2017-02-04 20:51 ` Noam Postavsky
2017-02-05  7:11   ` [PATCH v2] " Tino Calancha
2017-02-05 14:56     ` [PATCH v3] " Tino Calancha
2017-02-05 16:11     ` [PATCH v2] " Clément Pit-Claudel
2017-02-06  7:00       ` [PATCH v4] " Tino Calancha
2017-02-06  7:15         ` Clément Pit-Claudel
2017-02-10  7:43 ` Tino Calancha
2017-03-03  4:47   ` Tino Calancha
2017-03-03 13:52     ` Eli Zaretskii
2017-04-14 22:01       ` John Wiegley
2017-04-25 11:14         ` Tino Calancha
2017-02-12 21:26 ` [PATCH] " Johan Bockgård

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.