1.0.19.24: incorrect function type canonicalization

 * If the signature has both &KEY and &OPTIONAL arguments, the
   canonicalization cannot merge &OPTIONAL into &REST. (Not that I am sure why
   we should be merging &OPTIONAL into &REST in *any* case, but this caused
   bogus warning.)

 * Add &KEY SILENT to PARSE-LAMBDA-LIST-LIKE-THING, which silences any
   style-warnings from it: we don't want SPECIFIER-TYPE to complain about the
   lambda-lists it parses.

diff --git a/NEWS b/NEWS
index d3d0066..df60f64 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,11 @@ changes in sbcl-1.0.20 relative to 1.0.19:
     (AREF (THE STRING X) Y) as being CHARACTER.
   * optimization: CLRHASH on empty hash-tables no longer does pointless
     work. (thanks to Alec Berryman)
+  * bug fix: bogus odd-number-of-keywords STYLE-WARNINGs from calls to
+    functions with an odd number of &OPTIONAL arguments, a &REST
+    argument, and one or more &KEY arguments at the call site.
+  * bug fix: STYLE-WARNINGs for functions with both &OPTIONAL and &KEY
+    arguments appeared at call sites as well.
   * bug fix: fixed #425; CLOSE drops input buffers from streams, so
     READ-LINE &co can no longer read from them afterwards. (reported
     by Damien Cassou)

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index e7b96f8..4ad4966 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -63,7 +63,7 @@
   ;; true if other &KEY arguments are allowed
   (allowp nil :type boolean))
 
-(defun canonicalize-args-type-args (required optional rest)
+(defun canonicalize-args-type-args (required optional rest &optional keyp)
   (when (eq rest *empty-type*)
     ;; or vice-versa?
     (setq rest nil))
@@ -72,19 +72,20 @@
         for opt in optional
         do (cond ((eq opt *empty-type*)
                   (return (values required (subseq optional i) rest)))
-                 ((neq opt rest)
+                 ((and (not keyp) (neq opt rest))
                   (setq last-not-rest i)))
         finally (return (values required
-                                (if last-not-rest
-                                    (subseq optional 0 (1+ last-not-rest))
-                                    nil)
+                                (cond (keyp
+                                       optional)
+                                      (last-not-rest
+                                       (subseq optional 0 (1+ last-not-rest))))
                                 rest))))
 
 (defun args-types (lambda-list-like-thing)
   (multiple-value-bind
         (required optional restp rest keyp keys allowp auxp aux
                   morep more-context more-count llk-p)
-      (parse-lambda-list-like-thing lambda-list-like-thing)
+      (parse-lambda-list-like-thing lambda-list-like-thing :silent t)
     (declare (ignore aux morep more-context more-count))
     (when auxp
       (error "&AUX in a FUNCTION or VALUES type: ~S." lambda-list-like-thing))
@@ -106,7 +107,7 @@
                    :type (single-value-specifier-type (second key))))))
              (key-info))))
       (multiple-value-bind (required optional rest)
-          (canonicalize-args-type-args required optional rest)
+          (canonicalize-args-type-args required optional rest keyp)
         (values required optional rest keyp keywords allowp llk-p)))))
 
 (defstruct (values-type

diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index 5a3eb24..affb94d 100644 (file)
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -34,7 +34,7 @@
 ;;; arg specifiers are just passed through untouched. If something is
 ;;; wrong, we use COMPILER-ERROR, aborting compilation to the last
 ;;; recovery point.
-(declaim (ftype (sfunction (list)
+(declaim (ftype (sfunction (list &key (:silent boolean))
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t boolean))
                 parse-lambda-list-like-thing))
@@ -42,7 +42,7 @@
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t))
                 parse-lambda-list))
-(defun parse-lambda-list-like-thing (list)
+(defun parse-lambda-list-like-thing (list &key silent)
   (collect ((required)
             (optional)
             (keys)
@@ -86,8 +86,9 @@
                  (compiler-error "misplaced &KEY in lambda list: ~S" list))
                #-sb-xc-host
                (when (optional)
-                 (compiler-style-warn
-                  "&OPTIONAL and &KEY found in the same lambda list: ~S" list))
+                 (unless silent
+                   (compiler-style-warn
+                    "&OPTIONAL and &KEY found in the same lambda list: ~S" list)))
                (setq keyp t
                      state :key))
               (&allow-other-keys
@@ -127,8 +128,9 @@
                   (when (and (plusp (length name))
                              (char= (char name 0) #\&))
                     ;; Should this be COMPILER-STYLE-WARN?
-                    (style-warn
-                     "suspicious variable in lambda list: ~S." arg))))
+                    (unless silent
+                      (style-warn
+                       "suspicious variable in lambda list: ~S." arg)))))
               (case state
                 (:required (required arg))
                 (:optional (optional arg))

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index a508073..c31a16f 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -935,6 +935,13 @@
 (declaim (cons *special-cons*))
 (assert (raises-error? (set '*special-cons* "nope") type-error))
 (assert (raises-error? (progv '(*special-cons*) '("no hope") (car *special-cons*)) type-error))
+
+;;; No bogus warnings for calls to functions with complex lambda-lists.
+(defun complex-function-signature (&optional x &rest y &key z1 z2)
+  (cons x y))
+(with-test (:name :complex-call-doesnt-warn)
+  (handler-bind ((warning #'error))
+    (compile nil '(lambda (x) (complex-function-signature x :z1 1 :z2 2)))))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 1e0b27a..36019b2 100644 (file)
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -396,3 +396,7 @@ ACTUAL ~D DERIVED ~D~%"
   (let ((bignum1 (+ 12 most-positive-fixnum))
         (bignum2 (- (+ 15 most-positive-fixnum) 3)))
     (assert (eval `(typep ,bignum1 '(member ,bignum2))))))
+
+(with-test (:name :opt+rest+key-canonicalization)
+  (let ((type '(function (&optional t &rest t &key (:x t) (:y t)) *)))
+    (assert (equal type (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 6110b0c..25c6c3c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.19.23"
+"1.0.19.24"