Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2091/tests
Modified Files:
debug.impure.lisp
Log Message:
0.8.13.5:
Fix backtrace on ppc. (Brian Downing sbcl-devel 2004-07-19)
... use BUG to report breakdown in logic;
... some tests fail on x86, so comment them out;
... untested as yet on non-x86 non-ppc.
Index: debug.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/debug.impure.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- debug.impure.lisp 10 Oct 2003 07:33:33 -0000 1.4
+++ debug.impure.lisp 27 Jul 2004 11:16:18 -0000 1.5
@@ -58,5 +58,80 @@
(assert (eql &rest-sym '&rest))
(assert (symbolp format-args-sym)))
+;;; Check for backtraces generally being correct. Ensure that the
+;;; actual backtrace finishes (doesn't signal any errors on its own),
+;;; and that it contains the frames we expect, doesn't contain any
+;;; "bogus stack frame"s, and contains the appropriate toplevel call
+;;; and hasn't been cut off anywhere.
+(defun verify-backtrace (test-function frame-name
+ &key (key #'first) (test #'eql)
+ (allow-bogus-frames nil))
+ (let ((result nil)
+ (return-value nil))
+ (block outer-handler
+ (handler-bind
+ ((error #'(lambda (condition)
+ (let ((backtrace (ignore-errors
+ (sb-debug:backtrace-as-list))))
+ ;; Make sure we find what we're looking for.
+ (when (member frame-name backtrace
+ :key key :test test)
+ (setf result (list :error condition)))
+ ;; Make sure there's no bogus stack frames
+ ;; unless they're explicitly allowed.
+ (when (and (not allow-bogus-frames)
+ (member "bogus stack frame" backtrace
+ :key #'first :test #'equal))
+ (setf result nil))
+ ;; Make sure the backtrace isn't stunted in
+ ;; any way. (Depends on running in the main
+ ;; thread.)
+ (unless (member 'sb-impl::toplevel-init backtrace
+ :key #'first :test #'equal)
+ (setf result nil)))
+ (return-from outer-handler))))
+ (funcall test-function)))
+ (values result return-value)))
+
+;;; Test for "undefined function" (undefined_tramp) working properly.
+;;; Try it with and without tail call elimination, since they can have
+;;; different effects. (Specifically, if undefined_tramp is incorrect
+;;; a stunted stack can result from the tail call variant.)
+#-x86 ; bug 345
+(progn
+ (flet ((test-function ()
+ (declare (optimize (speed 2) (debug 1))) ; tail call elimination
+ (#:undefined-function 42)))
+ (assert (verify-backtrace #'test-function "undefined function"
+ :test #'equal)))
+
+ (flet ((test-function ()
+ (declare (optimize (speed 1) (debug 2))) ; no tail call elimination
+ (#:undefined-function 42)))
+ (assert (verify-backtrace #'test-function "undefined function"
+ :test #'equal))))
+
+;;; Division by zero was a common error on PPC. It depended on the
+;;; return function either being before INTEGER-/-INTEGER in memory,
+;;; or more than MOST-POSITIVE-FIXNUM bytes ahead. It also depends on
+;;; INTEGER-/-INTEGER calling SIGNED-TRUNCATE. I believe Raymond Toy
+;;; says that the Sparc backend (at least for CMUCL) inlines this, so
+;;; if SBCL does the same this test is probably not good for the
+;;; Sparc.
+;;;
+;;; Disabling tail call elimination on this will probably ensure that
+;;; the return value (to the flet or the enclosing top level form) is
+;;; more than MOST-POSITIVE-FIXNUM with the current spaces on OS X.
+;;; Enabling it might catch other problems, so do it anyway.
+(flet ((test-function ()
+ (declare (optimize (speed 1) (debug 2))) ; tail call elimination
+ (/ 42 0)))
+ (assert (verify-backtrace #'test-function '/)))
+
+(flet ((test-function ()
+ (declare (optimize (speed 1) (debug 2))) ; no tail call elimination
+ (/ 42 0)))
+ (assert (verify-backtrace #'test-function '/)))
+
;;; success
(quit :unix-status 104)
|