Mention new strictness for &optional, &rest in arglists (Bug#29165)

* etc/NEWS: Explain that '&optional' not followed by a variable is now
an error.
* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda, cl--do-&aux)
(cl--do-arglist): Also reject '&optional', '&rest', or '&aux' not
followed by a variable for consistency.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-bad-arglist): New
test.

3 files changed, 69 insertions, 11 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 64b53d88c83..5324a0944ea 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1462,6 +1462,17 @@ them through 'format' first.  Even that is discouraged: for ElDoc
 support, you should set 'eldoc-documentation-function' instead of
 calling 'eldoc-message' directly.
 
+---
+** Using '&rest' or '&optional' incorrectly is now an error.
+For example giving '&optional' without a following variable, or
+passing '&optional' multiple times:
+
+    (defun foo (&optional &rest x))
+    (defun bar (&optional &optional x))
+
+Previously, Emacs would just ignore the extra keyword, or give
+incorrect results in certain cases.
+
 
 * Lisp Changes in Emacs 26.1
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 5535100d4ae..6aed060cb50 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -281,8 +281,13 @@ FORM is of the form (ARGS . BODY)."
                   (or (not optional)
                       ;; Optional args whose default is nil are simple.
                       (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
-                  (not (and (eq (car args) '&optional) (setq optional t)
-                            (car cl--bind-defs))))
+                  (not (and (eq (car args) '&optional)
+                            (progn
+                              (when (memq (cadr args)
+                                          '(nil &rest &body &key &aux))
+                                (error "Variable missing after &optional"))
+                              (setq optional t)
+                              (car cl--bind-defs)))))
         (push (pop args) simple-args))
       (when optional
         (if args (push '&optional args))
@@ -534,14 +539,17 @@ its argument list allows full Common Lisp conventions."
               arglist))))
 
 (defun cl--do-&aux (args)
-  (while (and (eq (car args) '&aux) (pop args))
-    (while (and args (not (memq (car args) cl--lambda-list-keywords)))
-      (if (consp (car args))
-          (if (and cl--bind-enquote (cl-cadar args))
-              (cl--do-arglist (caar args)
-                              `',(cadr (pop args)))
-            (cl--do-arglist (caar args) (cadr (pop args))))
-        (cl--do-arglist (pop args) nil))))
+  (when (eq (car args) '&aux)
+    (pop args)
+    (when (null args)
+      (error "Variable missing after &aux")))
+  (while (and args (not (memq (car args) cl--lambda-list-keywords)))
+    (if (consp (car args))
+        (if (and cl--bind-enquote (cl-cadar args))
+            (cl--do-arglist (caar args)
+                            `',(cadr (pop args)))
+          (cl--do-arglist (caar args) (cadr (pop args))))
+      (cl--do-arglist (pop args) nil)))
   (if args (error "Malformed argument list ends with: %S" args)))
 
 (defun cl--do-arglist (args expr &optional num)   ; uses cl--bind-*
@@ -558,6 +566,9 @@ its argument list allows full Common Lisp conventions."
           (keys nil)
           (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
+      (when (and restarg (or (null (cdr restarg))
+                             (memq (cadr restarg) cl--lambda-list-keywords)))
+        (error "Variable missing after &rest"))
       (setq restarg (if (listp (cadr restarg))
                         (make-symbol "--cl-rest--")
                       (cadr restarg)))
@@ -609,7 +620,12 @@ its argument list allows full Common Lisp conventions."
                                       `',cl--bind-block)
                                 (+ ,num (length ,restarg)))))
                   cl--bind-forms)))
-      (while (and (eq (car args) '&key) (pop args))
+      (while (eq (car args) '&key)
+        (pop args)
+        (when (or (null args) (memq (car args) cl--lambda-list-keywords))
+          (error "Missing variable after &key"))
+        (when keys
+          (error "Multiple occurrences of &key"))
         (while (and args (not (memq (car args) cl--lambda-list-keywords)))
           (let ((arg (pop args)))
             (or (consp arg) (setq arg (list arg)))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 575f170af6c..bf2e7e12759 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -497,4 +497,35 @@ collection clause."
                           vconcat (vector (1+ x)))
                  [2 3 4 5 6])))
 
+
+;;; cl-lib lambda list handling
+
+(ert-deftest cl-macs-bad-arglist ()
+  "Check that `cl-defun' and friends reject weird argument lists.
+See Bug#29165, and similar `eval-tests--bugs-24912-and-24913' in
+eval-tests.el."
+  (dolist (args (cl-mapcan
+                 ;; For every &rest and &optional variant, check also
+                 ;; the same thing with &key and &aux respectively
+                 ;; instead.
+                 (lambda (arglist)
+                   (let ((arglists (list arglist)))
+                     (when (memq '&rest arglist)
+                       (push (cl-subst '&key '&rest arglist) arglists))
+                     (when (memq '&optional arglist)
+                       (push (cl-subst '&aux '&optional arglist) arglists))
+                     arglists))
+                 '((&optional) (&rest) (&optional &rest) (&rest &optional)
+                   (&optional &rest _a) (&optional _a &rest)
+                   (&rest _a &optional) (&rest &optional _a)
+                   (&optional &optional) (&optional &optional _a)
+                   (&optional _a &optional _b)
+                   (&rest &rest) (&rest &rest _a)
+                   (&rest _a &rest _b))))
+    (ert-info ((prin1-to-string args) :prefix "arglist: ")
+      (should-error (eval `(funcall (cl-function (lambda ,args))) t))
+      (should-error (cl--transform-lambda (cons args t)))
+      (let ((byte-compile-debug t))
+        (should-error (eval `(byte-compile (cl-function (lambda ,args))) t))))))
+
 ;;; cl-macs-tests.el ends here