From cb41e65e62328d1bd63df8477388503fa7e864bb Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 12 Oct 2010 14:42:53 +0000 Subject: [PATCH] 1.0.43.49: (SETF FDEFINITION) and (SETF SYMBOL-FUNCTION) should clear derived ftype Fixes 659220. Just call CLEAR-INFO unless the type is declared. --- NEWS | 2 ++ src/code/fdefinition.lisp | 6 ++++++ tests/compiler.impure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 4 files changed, 21 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 6946f85..1c07af4 100644 --- a/NEWS +++ b/NEWS @@ -51,6 +51,8 @@ changes relative to sbcl-1.0.43: also declared NOTINLINE. (lp#655581) * bug fix: the compiler could attempt to emit constant left shifts of greater value than n-word-bits. (lp#309063) + * bug fix: (SETF SYMBOL-FUNCTION) and (SETF FDEFINITION) clear derived + type information for the function being set. (lp#659220) changes in sbcl-1.0.43 relative to sbcl-1.0.42: * incompatible change: FD-STREAMS no longer participate in the serve-event diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 0dd857c..a23c0e4 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -60,6 +60,10 @@ (setf (info :function :definition name) (make-fdefn name)) fdefn))) +(defun maybe-clobber-ftype (name) + (unless (eq :declared (info :function :where-from name)) + (clear-info :function :type name))) + ;;; Return the fdefinition of NAME, including any encapsulations. ;;; The compiler emits calls to this when someone tries to FUNCALL ;;; something. SETFable. @@ -69,6 +73,7 @@ (or (and fdefn (fdefn-fun fdefn)) (error 'undefined-function :name name)))) (defun (setf %coerce-name-to-fun) (function name) + (maybe-clobber-ftype name) (let ((fdefn (fdefinition-object name t))) (setf (fdefn-fun fdefn) function))) @@ -233,6 +238,7 @@ "Set NAME's global function definition." (declare (type function new-value) (optimize (safety 1))) (with-single-package-locked-error (:symbol name "setting fdefinition of ~A") + (maybe-clobber-ftype name) ;; Check for hash-table stuff. Woe onto him that mixes encapsulation ;; with this. diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 2d34a59..195a2f4 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -2006,4 +2006,16 @@ (assert derived) (assert (equal '(integer 42 42) type)))) +(test-util:with-test (:name :clear-derived-types-on-set-fdefn) + (let ((*evaluator-mode* :compile) + (*derive-function-types* t)) + (eval `(progn + (defun clear-derived-types-on-set-fdefn-1 () + "foo") + (setf (symbol-function 'clear-derived-types-on-set-fdefn-1) + (constantly "foobar")) + (defun clear-derived-types-on-set-fdefn-2 () + (length (clear-derived-types-on-set-fdefn-1))))) + (assert (= 6 (clear-derived-types-on-set-fdefn-2))))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 06e3a82..43eb94e 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.43.48" +"1.0.43.49" -- 1.7.10.4