From e7b1111155b3116d0c7b137e0e1d312db0f1ca80 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Mon, 13 Nov 2017 12:46:13 -0500 Subject: [PATCH] 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. --- etc/NEWS | 11 ++++++++ lisp/emacs-lisp/cl-macs.el | 38 +++++++++++++++++++-------- test/lisp/emacs-lisp/cl-macs-tests.el | 31 ++++++++++++++++++++++ 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 -- 2.39.2