From: Alexey Dejneka <adejneka@comail.ru>
Date: Thu, 19 Dec 2002 06:24:23 +0000 (+0000)
Subject: 0.7.10.23:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f3c33b9dccb849bedd48f82bc67102484d1ede79;p=sbcl.git

0.7.10.23:
        Fix bug 223: functional binding of a symbol is constant only
        if the symbol is in CL package.
---

diff --git a/BUGS b/BUGS
index 557e23e..1f2715d 100644
--- a/BUGS
+++ b/BUGS
@@ -1206,31 +1206,6 @@ WORKAROUND:
   arguments, but it could be tricky to check result types of PROG1, IF
   etc.
 
-223: "(SETF FDEFINITION) and #' semantics broken for wrappers"
-  Although this
-    (defun foo (x)
-      (print x))
-    (defun traced (fn)
-      (lambda (&rest rest)
-        (format t "~&about to call ~S on ~S~%" fn rest)
-        (apply fn rest)
-        (format t "~&returned from ~S~%" fn)))
-    (setf (fdefinition 'foo)
-          (traced #'foo))
-    (foo 11)
-  does what one would expect, this
-    (defun bar (x)
-      (print x))
-    (let ((bar0 #'bar))
-      (setf (fdefinition 'bar)
-    	(lambda (&rest rest)
-    	  (format t "~&about to enter BAR ~S~%" rest)
-    	  (apply bar0 rest)
-    	  (format t "~&back from BAR~%"))))
-    (bar 12)
-  recurses endlessly in sbcl-0.7.9.32. (Or it works if #' and
-  FDEFINITION are replaced by SYMBOL-FUNCTION.)
-
 228: "function-lambda-expression problems"
   in sbcl-0.7.9.6x, from the REPL:
     * (progn (declaim (inline foo)) (defun foo (x) x))
diff --git a/NEWS b/NEWS
index 581f452..5a93a5d 100644
--- a/NEWS
+++ b/NEWS
@@ -1471,6 +1471,8 @@ changes in sbcl-0.7.11 relative to sbcl-0.7.10:
   * incremented fasl file version number, because of the incompatible
     change to the DEFSTRUCT-DESCRIPTION structure, and again because
     of the new implementation of DEFINE-COMPILER-MACRO.
+  * fixed bug 223: functional binding is considered to be constant
+    only for symbols in the CL package.
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 1c878eb..d95c91e 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1299,9 +1299,11 @@
        (null (lambda-var-sets leaf)))
       (defined-fun
        (not (eq (defined-fun-inlinep leaf) :notinline)))
+      #!+(and (not sb-fluid) (not sb-xc-host))
       (global-var
        (case (global-var-kind leaf)
-	 (:global-function t))))))
+	 (:global-function (eq (symbol-package (leaf-source-name leaf))
+                               *cl-package*)))))))
 
 ;;; If we have a non-set LET var with a single use, then (if possible)
 ;;; replace the variable reference's CONT with the arg continuation.
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 293641e..8b1d32b 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -702,8 +702,7 @@
   (sets () :type list))
 
 ;;; The GLOBAL-VAR structure represents a value hung off of the symbol
-;;; NAME. We use a :CONSTANT VAR when we know that the thing is a
-;;; constant, but don't know what the value is at compile time.
+;;; NAME.
 (def!struct (global-var (:include basic-var))
   ;; kind of variable described
   (kind (missing-arg)
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 37b12fc..869cd5a 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -702,6 +702,24 @@ BUG 48c, not yet fixed:
 (do-optimizations
   (compile nil '(lambda (x) (let ((y (error ""))) (list x y)))))
 
+;;; bug 223: invalid moving of global function name referencing
+(defun bug223-int (n)
+  `(int ,n))
+
+(defun bug223-wrap ()
+  (let ((old #'bug223-int))
+    (setf (fdefinition 'bug223-int)
+          (lambda (n)
+            (assert (> n 0))
+            `(ext ,@(funcall old (1- n)))))))
+(compile 'bug223-wrap)
+
+(assert (equal (bug223-int 4) '(int 4)))
+(bug223-wrap)
+(assert (equal (bug223-int 4) '(ext int 3)))
+(bug223-wrap)
+(assert (equal (bug223-int 4) '(ext ext int 2)))
+
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
diff --git a/version.lisp-expr b/version.lisp-expr
index 05efc29..15ae2d9 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.10.22"
+"0.7.10.23"