[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master cea0bca: * lisp/emacs-lisp/cl-macs.el: Fix &key wit
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] master cea0bca: * lisp/emacs-lisp/cl-macs.el: Fix &key with no key arg |
Date: |
Mon, 27 Nov 2017 12:45:22 -0500 (EST) |
branch: master
commit cea0bca54f1fa3635591e24eba1017742b04abd0
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* lisp/emacs-lisp/cl-macs.el: Fix &key with no key arg
* test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-empty-keyargs): New test.
* lisp/emacs-lisp/cl-macs.el (cl--do-arglist): Fix it.
---
lisp/emacs-lisp/cl-macs.el | 44 ++++++++++++++++++++++--------------
test/lisp/emacs-lisp/cl-lib-tests.el | 4 ++++
2 files changed, 31 insertions(+), 17 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e313af2..4069db5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -555,7 +555,7 @@ its argument list allows full Common Lisp conventions."
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((restarg (memq '&rest args))
(safety (if (cl--compiling-file) cl--optimize-safety 3))
- (keys nil)
+ (keys t)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
(setq restarg (if (listp (cadr restarg))
@@ -610,6 +610,7 @@ its argument list allows full Common Lisp conventions."
(+ ,num (length ,restarg)))))
cl--bind-forms)))
(while (and (eq (car args) '&key) (pop args))
+ (unless (listp keys) (setq keys nil))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
@@ -648,23 +649,32 @@ its argument list allows full Common Lisp conventions."
`'(nil ,(cl--const-expr-val def))
`(list nil ,def))))))))
(push karg keys)))))
- (setq keys (nreverse keys))
+ (when (consp keys) (setq keys (nreverse keys)))
(or (and (eq (car args) '&allow-other-keys) (pop args))
- (null keys) (= safety 0)
- (let* ((var (make-symbol "--cl-keys--"))
- (allow '(:allow-other-keys))
- (check `(while ,var
- (cond
- ((memq (car ,var) ',(append keys allow))
- (setq ,var (cdr (cdr ,var))))
- ((car (cdr (memq (quote ,@allow) ,restarg)))
- (setq ,var nil))
- (t
- (error
- ,(format "Keyword argument %%s not one of %s"
- keys)
- (car ,var)))))))
- (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
+ (= safety 0)
+ (cond
+ ((eq keys t) nil) ;No &keys at all
+ ((null keys) ;A &key but no actual keys specified.
+ (push `(when ,restarg
+ (error ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,restarg)))
+ cl--bind-forms))
+ (t
+ (let* ((var (make-symbol "--cl-keys--"))
+ (allow '(:allow-other-keys))
+ (check `(while ,var
+ (cond
+ ((memq (car ,var) ',(append keys allow))
+ (setq ,var (cdr (cdr ,var))))
+ ((car (cdr (memq (quote ,@allow) ,restarg)))
+ (setq ,var nil))
+ (t
+ (error
+ ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,var)))))))
+ (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))))
(cl--do-&aux args)
nil)))
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index 13c9af9..ed85f5a 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -201,6 +201,10 @@
:b :a :a 42)
'(42 :a))))
+(ert-deftest cl-lib-empty-keyargs ()
+ (should-error (funcall (cl-function (lambda (&key) 1))
+ :b 1)))
+
(cl-defstruct (mystruct
(:constructor cl-lib--con-1 (&aux (abc 1)))
(:constructor cl-lib--con-2 (&optional def) "Constructor
docstring."))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master cea0bca: * lisp/emacs-lisp/cl-macs.el: Fix &key with no key arg,
Stefan Monnier <=