aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2017-12-15 23:20:25 -0500
committerNoam Postavsky2017-12-15 23:41:20 -0500
commit777fe9466168d935e9055c7592b943cd4d2d2ff9 (patch)
tree7ca50e3ebaa3c76da75f129ed8019324b6375267
parentad17db7964a1022fb0f646b35a00ffc5fb70ec30 (diff)
downloademacs-777fe9466168d935e9055c7592b943cd4d2d2ff9.tar.gz
emacs-777fe9466168d935e9055c7592b943cd4d2d2ff9.zip
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.
-rw-r--r--lisp/emacs-lisp/cl-macs.el38
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el31
2 files changed, 11 insertions, 58 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6aed060cb50..5535100d4ae 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -281,13 +281,8 @@ FORM is of the form (ARGS . BODY)."
281 (or (not optional) 281 (or (not optional)
282 ;; Optional args whose default is nil are simple. 282 ;; Optional args whose default is nil are simple.
283 (null (nth 1 (assq (car args) (cdr cl--bind-defs))))) 283 (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
284 (not (and (eq (car args) '&optional) 284 (not (and (eq (car args) '&optional) (setq optional t)
285 (progn 285 (car cl--bind-defs))))
286 (when (memq (cadr args)
287 '(nil &rest &body &key &aux))
288 (error "Variable missing after &optional"))
289 (setq optional t)
290 (car cl--bind-defs)))))
291 (push (pop args) simple-args)) 286 (push (pop args) simple-args))
292 (when optional 287 (when optional
293 (if args (push '&optional args)) 288 (if args (push '&optional args))
@@ -539,17 +534,14 @@ its argument list allows full Common Lisp conventions."
539 arglist)))) 534 arglist))))
540 535
541(defun cl--do-&aux (args) 536(defun cl--do-&aux (args)
542 (when (eq (car args) '&aux) 537 (while (and (eq (car args) '&aux) (pop args))
543 (pop args) 538 (while (and args (not (memq (car args) cl--lambda-list-keywords)))
544 (when (null args) 539 (if (consp (car args))
545 (error "Variable missing after &aux"))) 540 (if (and cl--bind-enquote (cl-cadar args))
546 (while (and args (not (memq (car args) cl--lambda-list-keywords))) 541 (cl--do-arglist (caar args)
547 (if (consp (car args)) 542 `',(cadr (pop args)))
548 (if (and cl--bind-enquote (cl-cadar args)) 543 (cl--do-arglist (caar args) (cadr (pop args))))
549 (cl--do-arglist (caar args) 544 (cl--do-arglist (pop args) nil))))
550 `',(cadr (pop args)))
551 (cl--do-arglist (caar args) (cadr (pop args))))
552 (cl--do-arglist (pop args) nil)))
553 (if args (error "Malformed argument list ends with: %S" args))) 545 (if args (error "Malformed argument list ends with: %S" args)))
554 546
555(defun cl--do-arglist (args expr &optional num) ; uses cl--bind-* 547(defun cl--do-arglist (args expr &optional num) ; uses cl--bind-*
@@ -566,9 +558,6 @@ its argument list allows full Common Lisp conventions."
566 (keys nil) 558 (keys nil)
567 (laterarg nil) (exactarg nil) minarg) 559 (laterarg nil) (exactarg nil) minarg)
568 (or num (setq num 0)) 560 (or num (setq num 0))
569 (when (and restarg (or (null (cdr restarg))
570 (memq (cadr restarg) cl--lambda-list-keywords)))
571 (error "Variable missing after &rest"))
572 (setq restarg (if (listp (cadr restarg)) 561 (setq restarg (if (listp (cadr restarg))
573 (make-symbol "--cl-rest--") 562 (make-symbol "--cl-rest--")
574 (cadr restarg))) 563 (cadr restarg)))
@@ -620,12 +609,7 @@ its argument list allows full Common Lisp conventions."
620 `',cl--bind-block) 609 `',cl--bind-block)
621 (+ ,num (length ,restarg))))) 610 (+ ,num (length ,restarg)))))
622 cl--bind-forms))) 611 cl--bind-forms)))
623 (while (eq (car args) '&key) 612 (while (and (eq (car args) '&key) (pop args))
624 (pop args)
625 (when (or (null args) (memq (car args) cl--lambda-list-keywords))
626 (error "Missing variable after &key"))
627 (when keys
628 (error "Multiple occurrences of &key"))
629 (while (and args (not (memq (car args) cl--lambda-list-keywords))) 613 (while (and args (not (memq (car args) cl--lambda-list-keywords)))
630 (let ((arg (pop args))) 614 (let ((arg (pop args)))
631 (or (consp arg) (setq arg (list arg))) 615 (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 bf2e7e12759..575f170af6c 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -497,35 +497,4 @@ collection clause."
497 vconcat (vector (1+ x))) 497 vconcat (vector (1+ x)))
498 [2 3 4 5 6]))) 498 [2 3 4 5 6])))
499 499
500
501;;; cl-lib lambda list handling
502
503(ert-deftest cl-macs-bad-arglist ()
504 "Check that `cl-defun' and friends reject weird argument lists.
505See Bug#29165, and similar `eval-tests--bugs-24912-and-24913' in
506eval-tests.el."
507 (dolist (args (cl-mapcan
508 ;; For every &rest and &optional variant, check also
509 ;; the same thing with &key and &aux respectively
510 ;; instead.
511 (lambda (arglist)
512 (let ((arglists (list arglist)))
513 (when (memq '&rest arglist)
514 (push (cl-subst '&key '&rest arglist) arglists))
515 (when (memq '&optional arglist)
516 (push (cl-subst '&aux '&optional arglist) arglists))
517 arglists))
518 '((&optional) (&rest) (&optional &rest) (&rest &optional)
519 (&optional &rest _a) (&optional _a &rest)
520 (&rest _a &optional) (&rest &optional _a)
521 (&optional &optional) (&optional &optional _a)
522 (&optional _a &optional _b)
523 (&rest &rest) (&rest &rest _a)
524 (&rest _a &rest _b))))
525 (ert-info ((prin1-to-string args) :prefix "arglist: ")
526 (should-error (eval `(funcall (cl-function (lambda ,args))) t))
527 (should-error (cl--transform-lambda (cons args t)))
528 (let ((byte-compile-debug t))
529 (should-error (eval `(byte-compile (cl-function (lambda ,args))) t))))))
530
531;;; cl-macs-tests.el ends here 500;;; cl-macs-tests.el ends here