add existence of &KEY to return-values of PARSE-ORDINARY-LAMBDA-LIST

diff --git a/macros.lisp b/macros.lisp
index 4450435..4dd679a 100644 (file)
--- a/macros.lisp
+++ b/macros.lisp
@@ -112,6 +112,8 @@ arguments when given."
 
    (name init).
 
+7. Existence of &KEY in the lambda-list.
+
 Signals a PROGRAM-ERROR is the lambda-list is malformed."
   (let ((state :required)
         (allow-other-keys nil)
@@ -120,6 +122,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
         (optional nil)
         (rest nil)
         (keys nil)
+        (keyp nil)
         (aux nil))
     (labels ((fail (elt)
                (simple-program-error "Misplaced ~S in ordinary lambda-list:~%  ~S"
@@ -148,7 +151,8 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
           (&key
            (if (member state '(:required &optional :after-rest))
                (setf state elt)
-               (fail elt)))
+               (fail elt))
+           (setf keyp t))
           (&allow-other-keys
            (if (eq state '&key)
                (setf allow-other-keys t
@@ -229,7 +233,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
              (t
               (simple-program-error "Invalid ordinary lambda-list:~%  ~S" lambda-list)))))))
     (values (nreverse required) (nreverse optional) rest (nreverse keys)
-            allow-other-keys (nreverse aux))))
+            allow-other-keys (nreverse aux) keyp)))
 
 ;;;; DESTRUCTURING-*CASE
 

diff --git a/tests.lisp b/tests.lisp
index f203aad..603157b 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -1885,3 +1885,13 @@
     (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
            (iota 3 :start 0.0 :step #C(0 2)))
   t)
+
+(deftest parse-ordinary-lambda-list.1
+  (multiple-value-bind (req opt rest keys allowp aux keyp)
+      (parse-ordinary-lambda-list '(a b c &optional d &key))
+    (and (equal '(a b c) req)
+         (equal '((d nil nil)) opt)
+         (equal '() keys)
+         (not allowp)
+         (not aux)
+         (eq t keyp))))