X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fdebug.impure.lisp;h=b9709f2b5cb792e71363592da45ce7172df1d0a8;hb=5ec5d0e068ab2b6435e0c841d686a95dbd58cbc4;hp=6ff1481e931b66ea1f958f884ad7bc0af3413503;hpb=175c318c892b0627b36fa3c4db66f59680242204;p=sbcl.git diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 6ff1481..b9709f2 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -139,7 +139,8 @@ (declare (optimize (speed 1) (debug 2))) ; no tail call elimination (funcall fun))) - (with-test (:fails-on '(or :alpha)) ; bug 346 + (with-test (:name (:undefined-function :bug-346) + :fails-on '(or :alpha)) ; bug 346 (assert (verify-backtrace (lambda () (test #'optimized)) (list *undefined-function-frame* @@ -147,7 +148,8 @@ ;; bug 353: This test fails at least most of the time for x86/linux ;; ca. 0.8.20.16. -- WHN - (with-test (:fails-on '(or (and :x86 :linux) :alpha)) + (with-test (:name (:undefined-function :bug-356) + :fails-on '(or (and :x86 :linux) :alpha)) (assert (verify-backtrace (lambda () (test #'not-optimized)) (list *undefined-function-frame* @@ -175,17 +177,23 @@ (test (fun) (declare (optimize (speed 1) (debug 2))) ; no tail call elimination (funcall fun))) - (with-test (:fails-on '(or :alpha)) ; bug 346 + (with-test (:name (:divide-by-zero :bug-346) + :fails-on '(or :alpha)) ; bug 346 (assert (verify-backtrace (lambda () (test #'optimized)) (list '(/ 42 &rest) (list '(flet test) #'optimized))))) - (with-test (:fails-on '(or :alpha)) ; bug 346 + (with-test (:name (:divide-by-zero :bug-356) + :fails-on '(or :alpha)) ; bug 356 (assert (verify-backtrace (lambda () (test #'not-optimized)) (list '(/ 42 &rest) '((flet not-optimized)) (list '(flet test) #'not-optimized)))))) -(with-test (:fails-on '(or (and :x86 :linux) :alpha)) +(with-test (:name (:throw :no-such-tag) + :fails-on '(or + (and :x86 (or :linux :freebsd sunos)) + :alpha + :mips)) (progn (defun throw-test () (throw 'no-such-tag t)) @@ -226,7 +234,9 @@ (defbt 5 (&optional (opt (oops))) (list opt)) -(with-test (:fails-on '(and :x86 :linux)) +;;; FIXME: This test really should be broken into smaller pieces +(with-test (:name (:backtrace :misc) + :fails-on '(and :x86 (or :linux :sunos))) (macrolet ((with-details (bool &body body) `(let ((sb-debug:*show-entry-point-details* ,bool)) ,@body))) @@ -330,6 +340,11 @@ (defun trace-this () 'ok) +(defun trace-fact (n) + (if (zerop n) + 1 + (* n (trace-fact (1- n))))) + (let ((out (with-output-to-string (*trace-output*) (trace trace-this) (assert (eq 'ok (trace-this))) @@ -337,8 +352,13 @@ (assert (search "TRACE-THIS" out)) (assert (search "returned OK" out))) -(with-test (:fails-on '(and :ppc :darwin)) - ;;; bug 379 +;;; bug 379 +;;; This is not a WITH-TEST :FAILS-ON PPC DARWIN since there are +;;; suspicions that the breakpoint trace might corrupt the whole image +;;; on that platform. +#-(and (or ppc x86) darwin) +(with-test (:name (trace :encapsulate nil) + :fails-on '(or :ppc :sparc :mips)) (let ((out (with-output-to-string (*trace-output*) (trace trace-this :encapsulate nil) (assert (eq 'ok (trace-this))) @@ -346,6 +366,17 @@ (assert (search "TRACE-THIS" out)) (assert (search "returned OK" out)))) +#-(and (or ppc x86) darwin) +(with-test (:name (trace-recursive :encapsulate nil) + :fails-on '(or :ppc :sparc :mips)) + (let ((out (with-output-to-string (*trace-output*) + (trace trace-fact :encapsulate nil) + (assert (= 120 (trace-fact 5))) + (untrace)))) + (assert (search "TRACE-FACT" out)) + (assert (search "returned 1" out)) + (assert (search "returned 120" out)))) + ;;;; test infinite error protection (defmacro nest-errors (n-levels error-form)