* 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.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e313af249757b2939a87e6b267daaf551e557d15..4069db53c931cf0e332a80f3a8593d7ad7529625 100644 (file)
--- 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 13c9af9bd6d7bdcbeed4be9efdbaafbd64b23654..ed85f5a0f666cbfa7b11270e97775516ffcf1653 100644 (file)
--- 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."))