From 2b1eb4067fb34bc501e527de75d09166a8ba9ceb Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola <nikodemus@random-state.net> Date: Sat, 26 Jan 2013 16:40:02 +0200 Subject: [PATCH] add existence of &KEY to return-values of PARSE-ORDINARY-LAMBDA-LIST --- 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)))) -- GitLab