From 7c16e6bf7a5559ffd81ea0816c5a44989709f51d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 5 Aug 2006 10:56:58 +0000 Subject: [PATCH] 0.9.15.11: No-one has told me that I'm missing something, so ... don't declare the types of temporaries used for keyword argument processing. (It caused a pointless extra typecheck in safe code, and additionally gave a confusing error message when the user passed a bogus argument) ... test cases, both implicit (with DEFSTRUCT) and explicit. --- NEWS | 3 +++ src/compiler/ir1tran-lambda.lisp | 7 +------ tests/compiler.impure.lisp | 29 ++++++++++++++++++++++++++--- version.lisp-expr | 2 +- 4 files changed, 31 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index 88cc61e..ddbcf78 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,9 @@ changes in sbcl-0.9.16 relative to sbcl-0.9.15: as specified by AMOP. * optimization: faster LOGCOUNT implementation on x86 and x86-64 (thanks to Lutz Euler) + * bug fix: improved the handling of type declarations and the + detection of violations for keyword arguments with non-constant + defaults. changes in sbcl-0.9.15 relative to sbcl-0.9.14: * added support for the ucs-2 external format. (contributed by Ivan diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index c2ae9ae..88f6aba 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -661,12 +661,7 @@ (n-val (make-symbol (format nil "~A-DEFAULTING-TEMP" (leaf-source-name key)))) - (key-type (leaf-type key)) - (val-temp (make-lambda-var - :%source-name n-val - :type (if hairy-default - (type-union key-type (specifier-type 'null)) - key-type)))) + (val-temp (make-lambda-var :%source-name n-val))) (main-vars val-temp) (bind-vars key) (cond ((or hairy-default supplied-p) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 33af05f..5ec5e1c 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1229,9 +1229,9 @@ (list (funcall #'target-fun 1 4) (funcall 'target-fun 1 4)))) (test-target-fun-called #'caller-fun-3 (list -3 5)) -;; Reported by NIIMI Satoshi -;; Subject: [Sbcl-devel] compilation error with optimization -;; Date: Sun, 09 Apr 2006 17:36:05 +0900 +;;; Reported by NIIMI Satoshi +;;; Subject: [Sbcl-devel] compilation error with optimization +;;; Date: Sun, 09 Apr 2006 17:36:05 +0900 (defun test-minimal-debug-info-for-unstored-but-used-parameter (n a) (declare (optimize (speed 3) (debug 1))) @@ -1239,4 +1239,27 @@ 0 (test-minimal-debug-info-for-unstored-but-used-parameter (1- n) a))) +;;; &KEY arguments with non-constant defaults. +(declaim (notinline opaque-identity)) +(defun opaque-identity (x) x) +(defstruct tricky-defaults + (fun #'identity :type function) + (num (opaque-identity 3) :type fixnum)) +(macrolet ((frob (form expected-expected-type) + `(handler-case ,form + (type-error (c) (assert (eq (type-error-expected-type c) + ',expected-expected-type))) + (:no-error (&rest vals) (error "~S returned values: ~S" ',form vals))))) + (frob (make-tricky-defaults :fun 3) function) + (frob (make-tricky-defaults :num #'identity) fixnum)) + +(let ((fun (compile nil '(lambda (&key (key (opaque-identity 3))) + (declare (optimize safety) (type integer key)) + key)))) + (assert (= (funcall fun) 3)) + (assert (= (funcall fun :key 17) 17)) + (handler-case (funcall fun :key t) + (type-error (c) (assert (eq (type-error-expected-type c) 'integer))) + (:no-error (&rest vals) (error "no error")))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 31c52f2..cacd653 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".) -"0.9.15.10" +"0.9.15.11" -- 1.7.10.4