1.0.31.31: SATISFIES cannot refer to local functions

 * Fix misoptimization: use SB-C::GLOBAL-FUNCTION instead of
   CL:FUNCTION. (Reported by Stanislaw Halik)

 * Also fix a typo in the COMPARE-AND-SWAP docstring. (Thanks to Larry
   Valkama.)

diff --git a/NEWS b/NEWS
index 4a68deb..b7bb2fe 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -24,6 +24,8 @@ changes relative to sbcl-1.0.31
   * bug fix: Have RUN-PROGRAM with :INPUT T only run the subprocess in a
     new process group if it doesn't need to share stdin with the sbcl
     process. (thanks to Leslie Polzer)
   * bug fix: Have RUN-PROGRAM with :INPUT T only run the subprocess in a
     new process group if it doesn't need to share stdin with the sbcl
     process. (thanks to Leslie Polzer)

+  * bug fix: SATISFIES could be misoptimized to refer to a local function.
+    (reported by Stanislaw Halik)

 
 changes in sbcl-1.0.31 relative to sbcl-1.0.30:
   * improvement: stack allocation is should now be possible in all nested
 
 changes in sbcl-1.0.31 relative to sbcl-1.0.30:
   * improvement: stack allocation is should now be possible in all nested

diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index e72769f..e2950d6 100644 (file)
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -76,7 +76,7 @@
 (defmacro compare-and-swap (place old new &environment env)
   "Atomically stores NEW in PLACE if OLD matches the current value of PLACE.
 Two values are considered to match if they are EQ. Returns the previous value
 (defmacro compare-and-swap (place old new &environment env)
   "Atomically stores NEW in PLACE if OLD matches the current value of PLACE.
 Two values are considered to match if they are EQ. Returns the previous value

-of PLACE: if the returned value if EQ to OLD, the swap was carried out.
+of PLACE: if the returned value is EQ to OLD, the swap was carried out.

 
 PLACE must be an accessor form whose CAR is one of the following:
 
 
 PLACE must be an accessor form whose CAR is one of the following:
 

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 06d7b07..4f47e17 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -238,7 +238,8 @@
            `(%typep ,object ',spec))
           (t
            (ecase (first spec)
            `(%typep ,object ',spec))
           (t
            (ecase (first spec)

-             (satisfies `(if (funcall #',(second spec) ,object) t nil))
+             (satisfies
+              `(if (funcall (global-function ,(second spec)) ,object) t nil))

              ((not and)
               (once-only ((n-obj object))
                 `(,(first spec) ,@(mapcar (lambda (x)
              ((not and)
               (once-only ((n-obj object))
                 `(,(first spec) ,@(mapcar (lambda (x)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index ecea1bd..5e9e754 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3347,3 +3347,16 @@
     (test 'simple-string "%CONCATENATE-TO-STRING")
     (test 'base-string "%CONCATENATE-TO-BASE-STRING")
     (test 'simple-base-string "%CONCATENATE-TO-BASE-STRING")))
     (test 'simple-string "%CONCATENATE-TO-STRING")
     (test 'base-string "%CONCATENATE-TO-BASE-STRING")
     (test 'simple-base-string "%CONCATENATE-TO-BASE-STRING")))

+
+(with-test (:name :satisfies-no-local-fun)
+  (let ((fun (compile nil `(lambda (arg)
+                             (labels ((local-not-global-bug (x)
+                                        t)
+                                      (bar (x)
+                                        (typep x '(satisfies local-not-global-bug))))
+                               (bar arg))))))
+    (assert (eq 'local-not-global-bug
+                (handler-case
+                    (funcall fun 42)
+                  (undefined-function (c)
+                    (cell-error-name c)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 1a7df00..ef28220 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".)
 ;;; 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.31.30"
+"1.0.31.31"