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: 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

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
-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:
 

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)
-             (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)

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")))
+
+(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".)
-"1.0.31.30"
+"1.0.31.31"