From d8e47f8f2ccda542b1ab60b080ebed483ae14376 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 20 Nov 2009 21:40:04 +0000 Subject: [PATCH] 1.0.32.37: declarations and symbol-macros in methods A stray backquote caused compilation warnings and run-time errors if, within a method, a symbol macro with a type declaration was given a new value with SETQ. Fixes bug #485019, reported by Iban Hatchondo --- NEWS | 3 +++ src/pcl/walk.lisp | 2 +- tests/clos.impure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 4 files changed, 17 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 1e8cfca..fdb1acf 100644 --- a/NEWS +++ b/NEWS @@ -76,6 +76,9 @@ changes relative to sbcl-1.0.32: complex and arrays that are definitely complex. (launchpad bug #309129) * bug fix: SUBTYPEP knows that the SYMBOL type is not SUBTYPEP the KEYWORD type. (reported by Levente Mészáros; launchpad bug #485972) + * bug fix: setting the value of a symbol-macro within a method in the + presence of type declarations works properly again. (reported by Iban + Hatchondo; launchpad bug #485019) changes in sbcl-1.0.32 relative to sbcl-1.0.31: * optimization: faster FIND and POSITION on strings of unknown element type diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp index 3f6d209..d56dcb5 100644 --- a/src/pcl/walk.lisp +++ b/src/pcl/walk.lisp @@ -866,7 +866,7 @@ (let* ((type (env-var-type var env)) (expanded (if (eq t type) `(setf ,(cddr symmac) ,val) - `(setf ,(cddr symmac) `(the ,type ,val)))) + `(setf ,(cddr symmac) (the ,type ,val)))) (walked (walk-form-internal expanded context env))) (if (eq expanded walked) form diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index a248cdb..46a36a8 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -1765,4 +1765,16 @@ (assert (= 42 (slot-value (make-instance 'remove-default-initargs-test) 'x)))) +(with-test (:name :bug-485019) + ;; there was a bug in WALK-SETQ, used in method body walking, in the + ;; presence of declarations on symbol macros. + (defclass bug-485019 () + ((array :initarg :array))) + (defmethod bug-485019 ((bug-485019 bug-485019)) + (with-slots (array) bug-485019 + (declare (type (or null simple-array) array)) + (setf array (make-array 4))) + bug-485019) + (bug-485019 (make-instance 'bug-485019))) + ;;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 9fdf4df..559e367 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.32.36" +"1.0.32.37" -- 1.7.10.4