X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdebug.impure.lisp;h=1804a084e060bb5cdab12e8a316a04996bc5a7ae;hb=a3b10e4bd291d1b07cb805a58cf8fe03156bdb3b;hp=8941b59c3dcdb500450bb7a4f141a61705093970;hpb=492dce07cf27b3cbee8ce4800c938fcb884aa53e;p=sbcl.git

diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index 8941b59..1804a08 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -205,7 +205,6 @@
                   ;; the frame we expect. If we leave it out, the backtrace is
                   ;; fine -- but the test fails. I can only boggle right now.
             :fails-on `(or (and :x86 :linux)
-                           :darwin
                            :win32))
   (let ((m (sb-thread:make-mutex))
         (q (sb-thread:make-waitqueue)))
@@ -274,6 +273,44 @@
                             '(((flet bar :in bug-308926) 13)
                               (bug-308926 &rest t)))))
 
+;;; Test backtrace through assembly routines
+;;; :bug-800343
+(macrolet ((test (predicate fun
+                    &optional (two-arg
+                               (find-symbol (format nil "TWO-ARG-~A" fun)
+                                            "SB-KERNEL")))
+               (let ((test-name (make-symbol (format nil "TEST-~A" fun))))
+                 `(flet ((,test-name (x y)
+                           ;; make sure it's not in tail position
+                           (list (,fun x y))))
+                    (with-test (:name (:bug-800343 ,fun))
+                      (assert (verify-backtrace
+                               (lambda ()
+                                 (eval `(funcall ,#',test-name 42 t)))
+                               '((,two-arg 42 t)
+                                 #+(or x86 x86-64)
+                                 ,@(and predicate
+                                    '(("no debug information for frame")))
+                                 ((flet ,test-name :in ,*p*) 42 t))))))))
+             (test-predicates (&rest functions)
+               `(progn ,@(mapcar (lambda (function)
+                                   (if (consp function)
+                                       `(test t ,@function)
+                                       `(test t ,function)))
+                                 functions)))
+             (test-functions (&rest functions)
+               `(progn ,@(mapcar (lambda (function)
+                                   (if (consp function)
+                                       `(test nil ,@function)
+                                       `(test nil ,function)))
+                                 functions))))
+    (test-predicates = < >)
+    (test-functions + - * /
+                    gcd lcm
+                    (logand sb-kernel:two-arg-and)
+                    (logior sb-kernel:two-arg-ior)
+                    (logxor sb-kernel:two-arg-xor)))
+
 ;;; test entry point handling in backtraces
 
 (defun oops ()