From 61e6ba93d83266662a1e17431fab02a981ec6bc8 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 5 Aug 2008 16:29:08 +0000 Subject: [PATCH] 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. --- NEWS | 5 +++++ src/code/early-type.lisp | 15 ++++++++------- src/compiler/parse-lambda-list.lisp | 14 ++++++++------ tests/compiler.impure.lisp | 7 +++++++ tests/type.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 6 files changed, 33 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index d3d0066..df60f64 100644 --- 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 --- 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 --- 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 --- 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))))) ;;;; 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 --- 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 --- 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" -- 1.7.10.4