diff options
| author | Noam Postavsky | 2017-12-15 23:20:25 -0500 |
|---|---|---|
| committer | Noam Postavsky | 2017-12-15 23:41:20 -0500 |
| commit | 777fe9466168d935e9055c7592b943cd4d2d2ff9 (patch) | |
| tree | 7ca50e3ebaa3c76da75f129ed8019324b6375267 | |
| parent | ad17db7964a1022fb0f646b35a00ffc5fb70ec30 (diff) | |
| download | emacs-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.el | 38 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 31 |
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. | ||
| 505 | See Bug#29165, and similar `eval-tests--bugs-24912-and-24913' in | ||
| 506 | eval-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 |