remove world-lock from around FASL loading

[sbcl.git] / tests / unwind-to-frame-and-call.impure.lisp

diff --git a/tests/unwind-to-frame-and-call.impure.lisp b/tests/unwind-to-frame-and-call.impure.lisp
index a65e3ae..c746e5b 100644 (file)
--- a/tests/unwind-to-frame-and-call.impure.lisp
+++ b/tests/unwind-to-frame-and-call.impure.lisp
@@ -20,8 +20,8 @@
 
 (defun return-from-frame (frame-name &rest values)
   (let ((frame (sb-di::top-frame)))
-    (loop until (equal (sb-debug::frame-call frame)
-                       frame-name)
+    (loop until (equal frame-name
+                       (sb-debug::frame-call frame))
           do (setf frame (sb-di::frame-down frame)))
     (assert frame)
     (assert (sb-debug::frame-has-debug-tag-p frame))
@@ -194,10 +194,10 @@
 (defun test-locals (name)
   (handler-bind ((in-a (lambda (c)
                          (declare (ignore c))
-                         (return-from-frame '(flet a) 'x 'y)))
+                         (return-from-frame `(flet a :in ,name) 'x 'y)))
                  (in-b (lambda (c)
                          (declare (ignore c))
-                         (return-from-frame '(flet b) 'z))))
+                         (return-from-frame `(flet b :in ,name) 'z))))
     (funcall name))
   ;; We're intentionally not testing for returning a different amount
   ;; of values than the local functions are normally returning. It's
@@ -249,11 +249,12 @@
 (defparameter *anon-3* (make-anon-3))
 (defparameter *anon-4* (make-anon-4))
 
-(defun test-anon (fun var-name)
+(defun test-anon (fun var-name &optional in)
   (handler-bind ((anon-condition (lambda (c)
                                    (declare (ignore c))
-                                   (return-from-frame `(lambda (,var-name))
-                                                      'x 'y))))
+                                   (return-from-frame
+                                    `(lambda (,var-name) ,@(when in `(:in ,in)))
+                                    'x 'y))))
     (let ((*foo* 'x))
       (let ((*foo* 'y))
         (assert (equal (multiple-value-list (funcall fun 1))
@@ -262,16 +263,16 @@
       (assert (eql *foo* 'x)))))
 
 (with-test (:name (:return-from-frame :anonymous :toplevel))
-  (test-anon *anon-1* 'foo))
+  (test-anon *anon-1* 'foo (namestring *load-truename*)))
 
 (with-test (:name (:return-from-frame :anonymous :toplevel-special))
-  (test-anon *anon-2* '*foo*))
+  (test-anon *anon-2* '*foo* (namestring *load-truename*)))
 
 (with-test (:name (:return-from-frame :anonymous))
-  (test-anon *anon-3* 'foo))
+  (test-anon *anon-3* 'foo 'make-anon-3))
 
 (with-test (:name (:return-from-frame :anonymous :special))
-  (test-anon *anon-4* '*foo*))
+  (test-anon *anon-4* '*foo* 'make-anon-4))
 
 \f
 ;;;; Test that unwind cleanups are executed
@@ -309,3 +310,24 @@
 
 (test-unwind 'unwind-1 '(:unwind-1))
 (test-unwind 'unwind-2 '(:unwind-2 :unwind-1))
+
+;;; Regression in 1.0.10.47 reported by James Knight
+
+(defun inner1 (tla)
+  (zerop tla))
+
+(declaim (inline inline-fun))
+(defun inline-fun (tla)
+  (or (inner1 tla)
+      (inner1 tla)))
+
+(defun foo (predicate)
+  (funcall predicate 2))
+
+(defun test ()
+  (let ((blah (foo #'inline-fun)))
+    (inline-fun 3)))
+
+(with-test (:name (:debug-instrumentation :inline/xep))
+  (test))
+