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.

diff --git a/NEWS b/NEWS
index 6946f85..1c07af4 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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.43.48"
+"1.0.43.49"