[alexandria.git] updated branch master: 2b1eb40 add existence of &KEY to return-values of PARSE-ORDINARY-LAMBDA-LIST

[Nikodemus Siivola]

The branch master has been updated:
       via  2b1eb4067fb34bc501e527de75d09166a8ba9ceb (commit)
      from  107eb17cefb15e9a66b1301b970d5ca3aefc42d3 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2b1eb4067fb34bc501e527de75d09166a8ba9ceb
Author: Nikodemus Siivola <nikodemus at random-state.net>
Date:   Sat Jan 26 16:40:02 2013 +0200

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

-----------------------------------------------------------------------

Summary of changes:
 macros.lisp |    8 ++++++--
 tests.lisp  |   10 ++++++++++
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/macros.lisp b/macros.lisp
index 4450435..4dd679a 100644
--- 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
--- 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))))
-- 
Alexandria hooks/post-receive