X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Funwind-to-frame-and-call.impure.lisp;h=c746e5b92b8159c3e3480dd03c56b32f72e203b6;hb=171fde84561e232b8af8c05b82dfe8a8f9e08340;hp=a65e3ae9e73c71d8195b1a3c968682de4e9f855f;hpb=578d987735906eb05829f0c2235a3ba9225c2bc4;p=sbcl.git diff --git a/tests/unwind-to-frame-and-call.impure.lisp b/tests/unwind-to-frame-and-call.impure.lisp index a65e3ae..c746e5b 100644 --- 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)) ;;;; 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)) +