tests/backtrace.impure.lisp

   1 ;;;; This file is for testing backtraces, using test machinery which
   2 ;;;; might have side effects (e.g. executing DEFUN).
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; While most of SBCL is derived from the CMU CL system, the test
   8 ;;;; files (like this one) were written from scratch after the fork
   9 ;;;; from CMU CL.
  10 ;;;;
  11 ;;;; This software is in the public domain and is provided with
  12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  13 ;;;; more information.
  14
  15 (cl:in-package :cl-user)
  16
  17 ;;; The following objects should be EQUALP to the respective markers
  18 ;;; produced by the backtrace machinery.
  19
  20 (defvar *unused-argument*
  21   (sb-debug::make-unprintable-object "unused argument"))
  22
  23 (defvar *unavailable-argument*
  24   (sb-debug::make-unprintable-object "unavailable argument"))
  25
  26 (defvar *unavailable-more*
  27   (sb-debug::make-unprintable-object "more unavailable arguments"))
  28
  29 (defvar *unavailable-lambda-list*
  30   (sb-debug::make-unprintable-object "unavailable lambda list"))
  31
  32 ;;; TEST-FUNCTION is called and has to signal an error at which point
  33 ;;; the backtrace will be captured.
  34 ;;;
  35 ;;; If DETAILS is true, the returned backtrace description is of the
  36 ;;; form:
  37 ;;;
  38 ;;;   (((NAME1 . ARGS1) INFO1)
  39 ;;;    ((NAME2 . ARGS2) INFO2)
  40 ;;;    ...)
  41 ;;;
  42 ;;; Otherwise it is of the form
  43 ;;;
  44 ;;;   ((NAME1 . ARGS1)
  45 ;;;    (NAME2 . ARGS2)
  46 ;;;    ...)
  47 ;;;
  48 (defun call-with-backtrace (cont test-function &key details)
  49   (flet ((capture-it (condition)
  50            (let (backtrace)
  51              (sb-debug::map-backtrace
  52               (lambda (frame)
  53                 (multiple-value-bind (name args info)
  54                     (sb-debug::frame-call frame)
  55                   (push (if details
  56                             (list (cons name args) info)
  57                             (cons name args))
  58                         backtrace))))
  59              (funcall cont (nreverse backtrace) condition))))
  60     (handler-bind ((error #'capture-it))
  61       (funcall test-function))))
  62
  63 ;;; Check the backtrace FRAMES against the list of frame
  64 ;;; specifications EXPECTED signaling an error if they do not match.
  65 ;;;
  66 ;;; If DETAILS is true, EXPECTED is a list with elements of the form
  67 ;;;
  68 ;;;   ((FUNCTION ARGS) INFO)
  69 ;;;
  70 ;;; Otherwise elements are of the form
  71 ;;;
  72 ;;;   (FUNCTION ARGS)
  73 ;;;
  74 ;;; ARGS is a list of expected argument values, but can also contain
  75 ;;; the following symbols
  76 ;;;
  77 ;;;   &REST The corresponding frame in FRAMES can contain an arbitrary
  78 ;;;         number of arguments starting at the corresponding
  79 ;;;         position.
  80 ;;;
  81 ;;;   ?     The corresponding frame in FRAMES can have an arbitrary
  82 ;;;         argument at the corresponding position.
  83 (defun check-backtrace (frames expected &key details)
  84   (labels ((args-equal (want actual)
  85              (cond ((eq want *unavailable-lambda-list*)
  86                     (equalp want actual))
  87                    ((eq '&rest (car want))
  88                     t)
  89                    ((endp want)
  90                     (endp actual))
  91                    ((or (eq '? (car want)) (equal (car want) (car actual)))
  92                     (args-equal (cdr want) (cdr actual)))
  93                    ((typep (car want) 'sb-impl::unprintable-object)
  94                     (equalp (car want) (car actual)))
  95                    (t
  96                     nil)))
  97            (fail (datum &rest arguments)
  98              (return-from check-backtrace
  99                (values nil (apply #'sb-kernel:coerce-to-condition
 100                                   datum 'simple-error 'error arguments)))))
 101     (mapc (lambda (frame spec)
 102             (unless (cond
 103                       ((not spec)
 104                        t)
 105                       (details
 106                        (and (args-equal (car spec)
 107                                         (car frame))
 108                             (equal (cdr spec) (cdr frame))))
 109                       (t
 110                        (and (equal (car spec) (car frame))
 111                             (args-equal (cdr spec) (cdr frame)))))
 112               (fail "~@<Unexpected frame during ~
 113                     ~:[non-detailed~:;detailed~] check: wanted ~S, got ~
 114                     ~S~@:>"
 115                     details spec frame)))
 116           frames expected))
 117   t)
 118
 119 ;;; Check for backtraces generally being correct.  Ensure that the
 120 ;;; actual backtrace finishes (doesn't signal any errors on its own),
 121 ;;; and that it contains the frames we expect, doesn't contain any
 122 ;;; "bogus stack frame"s, and contains the appropriate toplevel call
 123 ;;; and hasn't been cut off anywhere.
 124 ;;;
 125 ;;; See CHECK-BACKTRACE for an explanation of the structure
 126 ;;; EXPECTED-FRAMES.
 127 (defun verify-backtrace (test-function expected-frames &key details)
 128   (labels ((find-frame (function-name frames)
 129              (member function-name frames
 130                      :key (if details #'caar #'car)
 131                      :test #'equal))
 132            (fail (datum &rest arguments)
 133              (return-from verify-backtrace
 134                (values nil (apply #'sb-kernel:coerce-to-condition
 135                                   datum 'simple-error 'error arguments)))))
 136     (call-with-backtrace
 137      (lambda (backtrace condition)
 138        (declare (ignore condition))
 139        (let* ((test-function-name (if details
 140                                       (caaar expected-frames)
 141                                       (caar expected-frames)))
 142               (frames (or (find-frame test-function-name backtrace)
 143                           (fail "~@<~S (expected name ~S) not found in ~
 144                                 backtrace:~@:_~S~@:>"
 145                                 test-function test-function-name backtrace))))
 146          ;; Check that we have all the frames we wanted.
 147          (multiple-value-bind (successp condition)
 148              (check-backtrace frames expected-frames :details details)
 149            (unless successp (fail condition)))
 150          ;; Make sure the backtrace isn't stunted in any way.
 151          ;; (Depends on running in the main thread.) FIXME: On Windows
 152          ;; we get two extra foreign frames below regular frames.
 153          (unless (find-frame 'sb-impl::toplevel-init frames)
 154            (fail "~@<Backtrace stunted:~@:_~S~@:>" backtrace)))
 155        (return-from verify-backtrace t))
 156      test-function :details details)))
 157
 158 (defun assert-backtrace (test-function expected-frames &key details)
 159   (multiple-value-bind (successp condition)
 160       (verify-backtrace test-function expected-frames :details details)
 161     (or successp (error condition))))
 162
 163 (defvar *p* (namestring *load-truename*))
 164
 165 (defvar *undefined-function-frame*
 166   '("undefined function"))
 167
 168 (defun oops ()
 169   (error "oops"))
 170
 171 ;;; Test for "undefined function" (undefined_tramp) working properly.
 172 ;;; Try it with and without tail call elimination, since they can have
 173 ;;; different effects.  (Specifically, if undefined_tramp is incorrect
 174 ;;; a stunted stack can result from the tail call variant.)
 175 (flet ((optimized ()
 176          (declare (optimize (speed 2) (debug 1))) ; tail call elimination
 177          (#:undefined-function 42))
 178        (not-optimized ()
 179          (declare (optimize (speed 1) (debug 3))) ; no tail call elimination
 180          (#:undefined-function 42))
 181        (test (fun)
 182          (declare (optimize (speed 1) (debug 3))) ; no tail call elimination
 183          (funcall fun)))
 184
 185   (with-test (:name (:backtrace :undefined-function :bug-346)
 186                     :skipped-on :interpreter
 187                     ;; Failures on SPARC, and probably HPPA are due to
 188                     ;; not having a full and valid stack frame for the
 189                     ;; undefined function frame.  See PPC
 190                     ;; undefined_tramp for details.
 191                     :fails-on '(or :sparc))
 192     (assert-backtrace
 193      (lambda () (test #'optimized))
 194      (list (append *undefined-function-frame* '(42))
 195            (list `(flet test :in ,*p*) #'optimized))))
 196
 197   ;; bug 353: This test fails at least most of the time for x86/linux
 198   ;; ca. 0.8.20.16. -- WHN
 199   (with-test (:name (:backtrace :undefined-function :bug-353)
 200               :skipped-on :interpreter)
 201     (assert-backtrace
 202      (lambda () (test #'not-optimized))
 203      (list (append *undefined-function-frame* '(42))
 204            (list `(flet not-optimized :in ,*p*))
 205            (list `(flet test :in ,*p*) #'not-optimized)))))
 206
 207 (with-test (:name (:backtrace :interrupted-condition-wait)
 208                   :skipped-on '(not :sb-thread))
 209   (let ((m (sb-thread:make-mutex))
 210         (q (sb-thread:make-waitqueue)))
 211     (assert-backtrace
 212      (lambda ()
 213        (sb-thread:with-mutex (m)
 214          (handler-bind ((timeout (lambda (condition)
 215                                    (declare (ignore condition))
 216                                    (error "foo"))))
 217            (with-timeout 0.1
 218              (sb-thread:condition-wait q m)))))
 219      `((sb-thread:condition-wait ,q ,m :timeout nil)))))
 220
 221 ;;; Division by zero was a common error on PPC. It depended on the
 222 ;;; return function either being before INTEGER-/-INTEGER in memory,
 223 ;;; or more than MOST-POSITIVE-FIXNUM bytes ahead. It also depends on
 224 ;;; INTEGER-/-INTEGER calling SIGNED-TRUNCATE. I believe Raymond Toy
 225 ;;; says that the Sparc backend (at least for CMUCL) inlines this, so
 226 ;;; if SBCL does the same this test is probably not good for the
 227 ;;; Sparc.
 228 ;;;
 229 ;;; Disabling tail call elimination on this will probably ensure that
 230 ;;; the return value (to the flet or the enclosing top level form) is
 231 ;;; more than MOST-POSITIVE-FIXNUM with the current spaces on OS X.
 232 ;;; Enabling it might catch other problems, so do it anyway.
 233 (flet ((optimized ()
 234          (declare (optimize (speed 2) (debug 1))) ; tail call elimination
 235          (/ 42 0))
 236        (not-optimized ()
 237          (declare (optimize (speed 1) (debug 3))) ; no tail call elimination
 238          (/ 42 0))
 239        (test (fun)
 240          (declare (optimize (speed 1) (debug 3))) ; no tail call elimination
 241          (funcall fun)))
 242
 243   (with-test (:name (:backtrace :divide-by-zero :bug-346)
 244                     :skipped-on :interpreter)
 245     (assert-backtrace (lambda () (test #'optimized))
 246                       `((/ 42 &rest)
 247                         ((flet test :in ,*p*) ,#'optimized))))
 248
 249   (with-test (:name (:backtrace :divide-by-zero :bug-356)
 250                     :skipped-on :interpreter)
 251     (assert-backtrace (lambda () (test #'not-optimized))
 252                       `((/ 42 &rest)
 253                         ((flet not-optimized :in ,*p*))
 254                         ((flet test :in ,*p*) ,#'not-optimized)))))
 255
 256 (defun throw-test ()
 257   (throw 'no-such-tag t))
 258 (with-test (:name (:backtrace :throw :no-such-tag)
 259                   :fails-on '(and :sparc :linux))
 260   (assert-backtrace #'throw-test '((throw-test))))
 261
 262 (funcall (checked-compile
 263           '(lambda ()
 264             (defun bug-308926 (x)
 265               (let ((v "foo"))
 266                 (flet ((bar (z)
 267                          (oops v z)
 268                          (oops z v)))
 269                   (bar x)
 270                   (bar v)))))
 271           :allow-style-warnings t))
 272 (with-test (:name (:backtrace :bug-308926) :skipped-on :interpreter)
 273   (assert-backtrace (lambda () (bug-308926 13))
 274                     '(((flet bar :in bug-308926) 13)
 275                       (bug-308926 &rest t))))
 276
 277 ;;; Test backtrace through assembly routines
 278 ;;; :bug-800343
 279 (macrolet ((test (predicate fun
 280                             &optional (two-arg
 281                                        (find-symbol (format nil "TWO-ARG-~A" fun)
 282                                                     "SB-KERNEL")))
 283              (let ((test-name (make-symbol (format nil "TEST-~A" fun))))
 284                `(flet ((,test-name (x y)
 285                          ;; make sure it's not in tail position
 286                          (list (,fun x y))))
 287                   (with-test (:name (:backtrace :bug-800343 ,fun)
 288                               :skipped-on :interpreter)
 289                     (assert-backtrace
 290                      (lambda ()
 291                        (eval `(funcall ,#',test-name 42 t)))
 292                      '((,two-arg 42 t)
 293                        #+(or x86 x86-64)
 294                        ,@(and predicate
 295                               `((,(find-symbol (format nil "GENERIC-~A" fun) "SB-VM"))))
 296                        ((flet ,test-name :in ,*p*) 42 t)))))))
 297            (test-predicates (&rest functions)
 298              `(progn ,@(mapcar (lambda (function)
 299                                  `(test t ,@(sb-int:ensure-list function)))
 300                                functions)))
 301            (test-functions (&rest functions)
 302              `(progn ,@(mapcar (lambda (function)
 303                                  `(test nil ,@(sb-int:ensure-list function)))
 304                                functions))))
 305   (test-predicates = < >)
 306   (test-functions + - * /
 307                   gcd lcm
 308                   (logand sb-kernel:two-arg-and)
 309                   (logior sb-kernel:two-arg-ior)
 310                   (logxor sb-kernel:two-arg-xor)))
 311
 312 ;;; test entry point handling in backtraces
 313
 314 (with-test (:name (:backtrace :xep-too-many-arguments)
 315             :skipped-on :interpreter)
 316   ;; CHECKED-COMPILE avoids STYLE-WARNING noise.
 317   (assert-backtrace (checked-compile '(lambda () (oops 1 2 3 4 5 6))
 318                                      :allow-style-warnings t)
 319                     '((oops ? ? ? ? ? ?))))
 320
 321 (defmacro defbt (n ll &body body)
 322   ;; WTF is this? This is a way to make these tests not depend so much on the
 323   ;; details of LOAD/EVAL. Around 1.0.57 we changed %SIMPLE-EVAL to be
 324   ;; slightly smarter, which meant that things which used to have xeps
 325   ;; suddently had tl-xeps, etc. This takes care of that.
 326   `(funcall
 327     (checked-compile
 328      '(lambda ()
 329         (progn
 330           ;; normal debug info
 331           (defun ,(intern (format nil "BT.~A.1" n)) ,ll
 332             ,@body)
 333           ;; no arguments saved
 334           (defun ,(intern (format nil "BT.~A.2" n)) ,ll
 335             (declare (optimize (debug 1) (speed 3)))
 336             ,@body)
 337           ;; no lambda-list saved
 338           (defun ,(intern (format nil "BT.~A.3" n)) ,ll
 339             (declare (optimize (debug 0)))
 340             ,@body)))
 341      :allow-style-warnings t)))
 342
 343 (defbt 1 (&key key)
 344   (list key))
 345
 346 (defbt 2 (x)
 347   (list x))
 348
 349 (defbt 3 (&key (key (oops)))
 350   (list key))
 351
 352 ;;; ERROR instead of OOPS so that tail call elimination doesn't happen
 353 (defbt 4 (&optional opt)
 354   (list (error "error")))
 355
 356 (defbt 5 (&optional (opt (oops)))
 357   (list opt))
 358
 359 (defbt 6 (&optional (opt nil opt-p))
 360   (declare (ignore opt))
 361   (list (error "error ~A" opt-p))) ; use OPT-P
 362
 363 (defbt 7 (&key (key nil key-p))
 364   (declare (ignore key))
 365   (list (error "error ~A" key-p))) ; use KEY-P
 366
 367 (defun bug-354 (x)
 368   (error "XEPs in backtraces: ~S" x))
 369
 370 (with-test (:name (:backtrace :bug-354))
 371   (assert (not (verify-backtrace (lambda () (bug-354 354))
 372                                  '((bug-354 354)
 373                                    (((bug-354 &rest) (:tl :external)) 354)))))
 374   (assert-backtrace (lambda () (bug-354 354)) '((bug-354 354))))
 375
 376 ;;; FIXME: This test really should be broken into smaller pieces
 377 (with-test (:name (:backtrace :tl-xep))
 378   (assert-backtrace #'namestring '(((namestring) (:external))) :details t)
 379   (assert-backtrace #'namestring '((namestring))))
 380
 381 (with-test (:name (:backtrace :more-processor))
 382   ;; CHECKED-COMPILE avoids STYLE-WARNING noise.
 383   (assert-backtrace (checked-compile '(lambda () (bt.1.1 :key))
 384                                      :allow-style-warnings t)
 385                     '(((bt.1.1 :key) (:more)))
 386                     :details t)
 387   (assert-backtrace (checked-compile '(lambda () (bt.1.2 :key))
 388                                      :allow-style-warnings t)
 389                     '(((bt.1.2 ?) (:more)))
 390                     :details t)
 391   (assert-backtrace (lambda () (bt.1.3 :key))
 392                     `(((bt.1.3  ,*unavailable-more*) (:more)))
 393                     :details t)
 394   (assert-backtrace (checked-compile '(lambda () (bt.1.1 :key))
 395                                      :allow-style-warnings t)
 396                     '((bt.1.1 :key)))
 397   (assert-backtrace (checked-compile '(lambda () (bt.1.2 :key))
 398                                      :allow-style-warnings t)
 399                     '((bt.1.2 &rest)))
 400   (assert-backtrace (lambda () (bt.1.3 :key))
 401                     '((bt.1.3 &rest))))
 402
 403 (with-test (:name (:backtrace :xep))
 404   (assert-backtrace #'bt.2.1 '(((bt.2.1) (:external))) :details t)
 405   (assert-backtrace #'bt.2.2 '(((bt.2.2) (:external))) :details t)
 406   (assert-backtrace #'bt.2.3 `(((bt.2.3) (:external))) :details t)
 407   (assert-backtrace #'bt.2.1 '((bt.2.1)))
 408   (assert-backtrace #'bt.2.2 '((bt.2.2)))
 409   (assert-backtrace #'bt.2.3 `((bt.2.3))))
 410
 411 ;;; This test is somewhat deceptively named. Due to confusion in debug
 412 ;;; naming these functions used to have sb-c::varargs-entry debug
 413 ;;; names for their main lambda.
 414 (with-test (:name (:backtrace :varargs-entry))
 415   (assert-backtrace #'bt.3.1 '((bt.3.1 :key nil)))
 416   (assert-backtrace #'bt.3.2 '((bt.3.2 :key ?)))
 417   (assert-backtrace #'bt.3.3 `((bt.3.3 :key ,*unavailable-argument*)))
 418   (assert-backtrace #'bt.3.1 '((bt.3.1 :key nil)))
 419   (assert-backtrace #'bt.3.2 '((bt.3.2 :key ?)))
 420   (assert-backtrace #'bt.3.3 `((bt.3.3 :key ,*unavailable-argument*))))
 421
 422 ;;; This test is somewhat deceptively named. Due to confusion in debug naming
 423 ;;; these functions used to have sb-c::hairy-args-processor debug names for
 424 ;;; their main lambda.
 425 (with-test (:name (:backtrace :hairy-args-processor))
 426   (assert-backtrace #'bt.4.1 '((bt.4.1 ?)))
 427   (assert-backtrace #'bt.4.2 '((bt.4.2 ?)))
 428   (assert-backtrace #'bt.4.3 `((bt.4.3 ,*unused-argument*)))
 429   (assert-backtrace #'bt.4.1 '((bt.4.1 ?)))
 430   (assert-backtrace #'bt.4.2 '((bt.4.2 ?)))
 431   (assert-backtrace #'bt.4.3 `((bt.4.3 ,*unused-argument*))))
 432
 433 (with-test (:name (:backtrace :optional-processor))
 434   (assert-backtrace #'bt.5.1 '(((bt.5.1) (:optional))) :details t)
 435   (assert-backtrace #'bt.5.2 '(((bt.5.2) (:optional))) :details t)
 436   (assert-backtrace #'bt.5.3 `(((bt.5.3) (:optional)))
 437                     :details t)
 438   (assert-backtrace #'bt.5.1 '((bt.5.1)))
 439   (assert-backtrace #'bt.5.2 '((bt.5.2)))
 440   (assert-backtrace #'bt.5.3 `((bt.5.3))))
 441
 442 (with-test (:name (:backtrace :unused-optinoal-with-supplied-p :bug-1498644))
 443   (assert-backtrace (lambda () (bt.6.1 :opt))
 444                     `(((bt.6.1 ,*unused-argument*) ()))
 445                     :details t)
 446   (assert-backtrace (lambda () (bt.6.2 :opt))
 447                     `(((bt.6.2 ,*unused-argument*) ()))
 448                     :details t)
 449   (assert-backtrace (lambda () (bt.6.3 :opt))
 450                     `(((bt.6.3 ,*unused-argument*) ()))
 451                     :details t)
 452   (assert-backtrace (lambda () (bt.6.1 :opt))
 453                     `((bt.6.1 ,*unused-argument*)))
 454   (assert-backtrace (lambda () (bt.6.2 :opt))
 455                     `((bt.6.2 ,*unused-argument*)))
 456   (assert-backtrace (lambda () (bt.6.3 :opt))
 457                     `((bt.6.3 ,*unused-argument*))))
 458
 459 (with-test (:name (:backtrace :unused-key-with-supplied-p))
 460   (assert-backtrace (lambda () (bt.7.1 :key :value))
 461                     `(((bt.7.1 :key ,*unused-argument*) ()))
 462                     :details t)
 463   (assert-backtrace (lambda () (bt.7.2 :key :value))
 464                     `(((bt.7.2 :key ,*unused-argument*) ()))
 465                     :details t)
 466   (assert-backtrace (lambda () (bt.7.3 :key :value))
 467                     `(((bt.7.3 :key ,*unused-argument*) ()))
 468                     :details t)
 469   (assert-backtrace (lambda () (bt.7.1 :key :value))
 470                     `((bt.7.1 :key ,*unused-argument*)))
 471   (assert-backtrace (lambda () (bt.7.2 :key :value))
 472                     `((bt.7.2 :key ,*unused-argument*)))
 473   (assert-backtrace (lambda () (bt.7.3 :key :value))
 474                     `((bt.7.3 :key ,*unused-argument*))))
 475
 476 (defvar *compile-nil-error*
 477   (checked-compile '(lambda (x)
 478                       (cons (when x (error "oops")) nil))))
 479 (defvar *compile-nil-non-tc*
 480   (checked-compile '(lambda (y)
 481                       (cons (funcall *compile-nil-error* y) nil))))
 482 (with-test (:name (:backtrace compile nil))
 483   (assert-backtrace (lambda () (funcall *compile-nil-non-tc* 13))
 484                     `(((lambda (x) :in ,*p*) 13)
 485                       ((lambda (y) :in ,*p*) 13))))
 486
 487 (with-test (:name (:backtrace :clos-slot-typecheckfun-named))
 488   (assert-backtrace
 489    (checked-compile
 490     `(lambda ()
 491        (locally (declare (optimize safety))
 492          (defclass clos-typecheck-test ()
 493            ((slot :type fixnum)))
 494          (setf (slot-value (make-instance 'clos-typecheck-test) 'slot) t))))
 495    '(((sb-pcl::slot-typecheck fixnum) t))))
 496
 497 (with-test (:name (:backtrace :clos-emf-named))
 498   (assert-backtrace
 499    (checked-compile
 500     `(lambda ()
 501        (progn
 502          (defgeneric clos-emf-named-test (x)
 503            (:method ((x symbol)) x)
 504            (:method :before (x) (assert x)))
 505          (clos-emf-named-test nil)))
 506     :allow-style-warnings t)
 507    '(((sb-pcl::emf clos-emf-named-test) ? ? nil))))
 508
 509 (with-test (:name (:backtrace :bug-310173))
 510   (flet ((make-fun (n)
 511            (let* ((names '(a b))
 512                   (req (loop repeat n collect (pop names))))
 513              (checked-compile
 514               `(lambda (,@req &rest rest)
 515                  (let ((* *)) ; no tail-call
 516                    (apply '/ ,@req rest)))))))
 517     (assert-backtrace (lambda ()
 518                         (funcall (make-fun 0) 10 11 0))
 519                       `((sb-kernel:two-arg-/ 10/11 0)
 520                         (/ 10 11 0)
 521                         ((lambda (&rest rest) :in ,*p*) 10 11 0)))
 522     (assert-backtrace (lambda ()
 523                         (funcall (make-fun 1) 10 11 0))
 524                       `((sb-kernel:two-arg-/ 10/11 0)
 525                         (/ 10 11 0)
 526                         ((lambda (a &rest rest) :in ,*p*) 10 11 0)))
 527     (assert-backtrace (lambda ()
 528                         (funcall (make-fun 2) 10 11 0))
 529                       `((sb-kernel:two-arg-/ 10/11 0)
 530                         (/ 10 11 0)
 531                         ((lambda (a b &rest rest) :in ,*p*) 10 11 0)))))
 532
 533 (defgeneric gf-dispatch-test/gf (x y)
 534   (:method (x y)
 535     (+ x y)))
 536 (defun gf-dispatch-test/f (z)
 537   (gf-dispatch-test/gf z))
 538 (with-test (:name (:backtrace :gf-dispatch))
 539   ;; Fill the cache
 540   (gf-dispatch-test/gf 1 1)
 541   ;; Wrong argument count
 542   (assert-backtrace (lambda () (gf-dispatch-test/f 42))
 543                     '(((sb-pcl::gf-dispatch gf-dispatch-test/gf) 42))))
 544
 545 (with-test (:name (:backtrace :local-tail-call))
 546   (assert-backtrace
 547    (lambda () (funcall (compile nil `(sb-int:named-lambda test ()
 548                                        (signal 'error)
 549                                        (flet ((tail ()))
 550                                          (declare (notinline tail))
 551                                          (tail))))))
 552    '((test))))
 553
 554 (defun fact (n) (if (zerop n) (error "nope") (* n (fact (1- n)))))
 555
 556 #+sb-fasteval
 557 (with-test (:name (:backtrace :interpreted-factorial)
 558             :skipped-on '(not :interpreter))
 559   (assert-backtrace
 560    (lambda () (fact 5))
 561    '((fact 0)
 562      (sb-interpreter::2-arg-* &rest)
 563      (fact 1)
 564      (sb-interpreter::2-arg-* &rest)
 565      (fact 2)
 566      (sb-interpreter::2-arg-* &rest)
 567      (fact 3)
 568      (sb-interpreter::2-arg-* &rest)
 569      (fact 4)
 570      (sb-interpreter::2-arg-* &rest)
 571      (fact 5))))
 572
 573 (with-test (:name :deleted-args)
 574   (let ((fun (checked-compile `(lambda (&rest ignore)
 575                                  (declare (ignore ignore))
 576                                  (error "x")))))
 577     (assert (typep (block nil
 578                      (handler-bind ((error
 579                                       (lambda (c)
 580                                         (return (values c
 581                                                         (sb-debug:list-backtrace))))))
 582                        (funcall fun)))
 583                    'simple-error))))