1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 22:41:06 -08:00

Partially revert "Mention new strictness for &optional, &rest..."

The changes to cl argument parsing are not backwards compatible, and
cause inconvenience when writing macros (e.g., instead of doing '&aux
,@auxargs', some more complicated conditionals would be required).
The `cl-defstruct' macro makes use of this convenience when defining
empty structs (Bug#29728).
* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda):
(cl--do-&aux, cl--do-arglist): Undo strict checking of &rest, &key,
and &aux.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-bad-arglist): Remove
test.
This commit is contained in:
Noam Postavsky 2017-12-15 23:20:25 -05:00
parent ad17db7964
commit 777fe94661
2 changed files with 11 additions and 58 deletions

View file

@ -281,13 +281,8 @@ FORM is of the form (ARGS . BODY)."
(or (not optional) (or (not optional)
;; Optional args whose default is nil are simple. ;; Optional args whose default is nil are simple.
(null (nth 1 (assq (car args) (cdr cl--bind-defs))))) (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
(not (and (eq (car args) '&optional) (not (and (eq (car args) '&optional) (setq optional t)
(progn (car cl--bind-defs))))
(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)) (push (pop args) simple-args))
(when optional (when optional
(if args (push '&optional args)) (if args (push '&optional args))
@ -539,17 +534,14 @@ its argument list allows full Common Lisp conventions."
arglist)))) arglist))))
(defun cl--do-&aux (args) (defun cl--do-&aux (args)
(when (eq (car args) '&aux) (while (and (eq (car args) '&aux) (pop args))
(pop args) (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(when (null args) (if (consp (car args))
(error "Variable missing after &aux"))) (if (and cl--bind-enquote (cl-cadar args))
(while (and args (not (memq (car args) cl--lambda-list-keywords))) (cl--do-arglist (caar args)
(if (consp (car args)) `',(cadr (pop args)))
(if (and cl--bind-enquote (cl-cadar args)) (cl--do-arglist (caar args) (cadr (pop args))))
(cl--do-arglist (caar args) (cl--do-arglist (pop args) nil))))
`',(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))) (if args (error "Malformed argument list ends with: %S" args)))
(defun cl--do-arglist (args expr &optional num) ; uses cl--bind-* (defun cl--do-arglist (args expr &optional num) ; uses cl--bind-*
@ -566,9 +558,6 @@ its argument list allows full Common Lisp conventions."
(keys nil) (keys nil)
(laterarg nil) (exactarg nil) minarg) (laterarg nil) (exactarg nil) minarg)
(or num (setq num 0)) (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)) (setq restarg (if (listp (cadr restarg))
(make-symbol "--cl-rest--") (make-symbol "--cl-rest--")
(cadr restarg))) (cadr restarg)))
@ -620,12 +609,7 @@ its argument list allows full Common Lisp conventions."
`',cl--bind-block) `',cl--bind-block)
(+ ,num (length ,restarg))))) (+ ,num (length ,restarg)))))
cl--bind-forms))) cl--bind-forms)))
(while (eq (car args) '&key) (while (and (eq (car args) '&key) (pop args))
(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))) (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args))) (let ((arg (pop args)))
(or (consp arg) (setq arg (list arg))) (or (consp arg) (setq arg (list arg)))

View file

@ -497,35 +497,4 @@ collection clause."
vconcat (vector (1+ x))) vconcat (vector (1+ x)))
[2 3 4 5 6]))) [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 ;;; cl-macs-tests.el ends here