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