procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

38
lisp/emacs-lisp/cl-macs.el
View file

@ -281,13 +281,8 @@ 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)
(progn
(when (memq (cadr args)
'(nil &rest &body &key &aux))
(error "Variable missing after &optional"))
(setq optional t)
(car cl--bind-defs)))))
(not (and (eq (car args) '&optional) (setq optional t)
(car cl--bind-defs))))
(push (pop args) simple-args))
(when optional
(if args (push '&optional args))
@ -539,17 +534,14 @@ its argument list allows full Common Lisp conventions."
arglist))))
(defun cl--do-&aux (args)
(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)))
(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))))
(if args (error "Malformed argument list ends with: %S" args)))
(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)
(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)))
@ -620,12 +609,7 @@ its argument list allows full Common Lisp conventions."
`',cl--bind-block)
(+ ,num (length ,restarg)))))
cl--bind-forms)))
(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 (eq (car args) '&key) (pop args))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))

31
test/lisp/emacs-lisp/cl-macs-tests.el
View file

@ -497,35 +497,4 @@ 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