[Sbcl-commits] master: add &KEY SILENT to PARSE-LAMBDA-LIST

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  d013d00f48df21109627e5ad255c8acb9afef35b (commit)
      from  88d80e04126a9842338cd6f8bbc5e6627eaff187 (commit)

- Log -----------------------------------------------------------------
commit d013d00f48df21109627e5ad255c8acb9afef35b
Author: Nikodemus Siivola <nik...@ra...>
Date:   Tue Jun 14 12:06:28 2011 +0300

    add &KEY SILENT to PARSE-LAMBDA-LIST
    
      Passed through to PARSE-LAMBDA-LIST-LIKE, used by %SPLIT-ARGLIST in PCL.
    
      Prior to this GENERIC-FUNCTION-PRETTY-ARGLIST on functions with both
      &OPTIONAL and &KEY arguments caused a style-warning -- and inquiring about
      the lambda-list isn't the right time for that.
---
 NEWS                                |    2 ++
 src/compiler/parse-lambda-list.lisp |    6 +++---
 src/pcl/methods.lisp                |    2 +-
 tests/clos.impure.lisp              |    9 +++++++++
 4 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 1d7f30a..02b1342 100644
--- a/NEWS
+++ b/NEWS
@@ -29,6 +29,8 @@ changes relative to sbcl-1.0.49:
   * bug fix: FORMAT now handles floating point rounding correct, eg.
     (format nil "~,1F" 0.01) => "0.0" instead of "0.01" as previously.
     (lp#308961)
+  * bug fix: style warning during lambda-list introspection of generic
+    functions with both optional and key argments.
 
 changes in sbcl-1.0.49 relative to sbcl-1.0.48:
   * minor incompatible change: WITH-LOCKED-HASH-TABLE no longer disables
diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index affb94d..c906093 100644
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -38,7 +38,7 @@
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t boolean))
                 parse-lambda-list-like-thing))
-(declaim (ftype (sfunction (list)
+(declaim (ftype (sfunction (list &key (:silent boolean))
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t))
                 parse-lambda-list))
@@ -162,11 +162,11 @@
 ;;; can barf on things which're illegal as arguments in lambda lists
 ;;; even if they could conceivably be legal in not-quite-a-lambda-list
 ;;; weirdosities
-(defun parse-lambda-list (lambda-list)
+(defun parse-lambda-list (lambda-list &key silent)
   ;; Classify parameters without checking their validity individually.
   (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
                         morep more-context more-count)
-      (parse-lambda-list-like-thing lambda-list)
+      (parse-lambda-list-like-thing lambda-list :silent silent)
 
     ;; Check validity of parameters.
     (flet ((need-symbol (x why)
diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 13bc885..3c6b614 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -1717,7 +1717,7 @@
   ;; PARSE-LAMBDA-LIST to something handier.
   (multiple-value-bind (required optional restp rest keyp keys allowp
                         auxp aux morep more-context more-count)
-      (parse-lambda-list lambda-list)
+      (parse-lambda-list lambda-list :silent t)
     (declare (ignore restp keyp auxp aux morep))
     (declare (ignore more-context more-count))
     (values required optional rest keys allowp)))
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 56fb8c3..a00da1d 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1886,6 +1886,15 @@
               (check-type req integer))))
     (assert (= warnings 1))))
 
+(defgeneric generic-function-pretty-arglist-optional-and-key (req &optional opt &key key)
+  (:method (req &optional opt &key key)
+    (list req opt key)))
 
+(with-test (:name :generic-function-pretty-arglist-optional-and-key)
+  (handler-bind ((warning #'error))
+    ;; Used to signal a style-warning
+    (assert (equal '(req &optional opt &key key)
+                   (sb-pcl::generic-function-pretty-arglist
+                    #'generic-function-pretty-arglist-optional-and-key)))))
 
 ;;;; success

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


hooks/post-receive
-- 
SBCL