X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Funwind-to-frame-and-call.impure.lisp;h=a4a79151980c65091822e8ec886db985c3a9e57e;hb=41c307979e17a33e8700c1ca92ed8b3400a301b3;hp=9da24b6aa63f915a8e25eae68348784826b2f0fd;hpb=7a0f4c68d94ff6c9a54c7605b6fd3cd8125c1c8c;p=sbcl.git

diff --git a/tests/unwind-to-frame-and-call.impure.lisp b/tests/unwind-to-frame-and-call.impure.lisp
index 9da24b6..a4a7915 100644
--- a/tests/unwind-to-frame-and-call.impure.lisp
+++ b/tests/unwind-to-frame-and-call.impure.lisp
@@ -14,14 +14,14 @@
 
 ;;; The debugger doesn't have any native knowledge of the interpreter
 (when (eq sb-ext:*evaluator-mode* :interpret)
-  (sb-ext:quit :unix-status 104))
+  (sb-ext:exit :code 104))
 
 (declaim (optimize debug))
 
 (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))
 
 
 ;;;; Test that unwind cleanups are executed