From: Christophe Rhodes <csr21@cantab.net>
Date: Wed, 9 Oct 2013 20:41:10 +0000 (+0100)
Subject: don't consider an interpreted->compiled function change interesting
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b2ed34b667665e52609cf431c00179b136be450d;p=sbcl.git

don't consider an interpreted->compiled function change interesting

fix from Douglas Katzman, lp#1042405
---

diff --git a/NEWS b/NEWS
index 35a671d..bc09d77 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@ changes relative to sbcl-1.1.12:
     includes the name of the function on x86-64.
   * bug fix: forward references to classes in fasls can now be loaded.
     (lp#746132)
+  * bug fix: don't warn on a interpreted->compiled function redefinition
+    from the same location.  (patch by Douglas Katzman, lp#1042405)
 
 changes in sbcl-1.1.12 relative to sbcl-1.1.11:
   * enhancement: Add sb-bsd-sockets:socket-shutdown, for calling
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 5fe0833..c2c2a39 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1397,13 +1397,14 @@ handled by any other handler, it will be muffled.")
   (let ((new (function-redefinition-warning-new-function warning))
         (source-location (redefinition-warning-new-location warning)))
     (or
-     ;; Compiled->Interpreted is interesting.
+     ;; compiled->interpreted is interesting.
      (and (typep old 'compiled-function)
           (typep new '(not compiled-function)))
-     ;; FIN->Regular is interesting.
-     (and (typep old 'funcallable-instance)
+     ;; fin->regular is interesting except for interpreted->compiled.
+     (and (typep old '(and funcallable-instance
+                           #!+sb-eval (not sb!eval:interpreted-function)))
           (typep new '(not funcallable-instance)))
-     ;; Different file or unknown location is interesting.
+     ;; different file or unknown location is interesting.
      (let* ((old-namestring (function-file-namestring old))
             (new-namestring
              (or (function-file-namestring new)
diff --git a/tests/full-eval.impure.lisp b/tests/full-eval.impure.lisp
index 364260c..b2eb21a 100644
--- a/tests/full-eval.impure.lisp
+++ b/tests/full-eval.impure.lisp
@@ -74,3 +74,15 @@
             (declare (enable-package-locks cl:ed))
             (cl:ed)))
         42)))))
+
+(defvar *file* #p"full-eval-temp.lisp")
+(with-test (:name (:full-eval :redefinition-warnings))
+  (with-open-file (stream *file* :direction :output :if-exists :supersede)
+    (write '(defun function-for-redefinition () nil) :stream stream))
+  (handler-bind ((warning #'error))
+    (let ((sb-ext:*evaluator-mode* :interpret))
+      (load *file*)
+      (load *file*))
+    (let ((sb-ext:*evaluator-mode* :compile))
+      (load *file*))))
+(delete-file *file*)