better debug name for secondary GF dispatch functions

[sbcl.git] / tests / debug.impure.lisp

diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index dab0481..7f6d1bc 100644 (file)
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -177,7 +177,8 @@
                   ;; stunted, ending at _sigtramp, when we add :TIMEOUT NIL to
                   ;; 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 '(and :x86 :linux))
+            :fails-on '(or (and :x86 :linux)
+                           (and :win32 :sb-thread)))
   (let ((m (sb-thread:make-mutex))
         (q (sb-thread:make-waitqueue)))
     (assert (verify-backtrace
@@ -346,14 +347,17 @@
     (assert (verify-backtrace #'bt.2.3
                               '((bt.2.3 &rest))))))
 
+;;; This test is somewhat deceptively named. Due to confusion in debug naming
+;;; these functions used to have sb-c::varargs-entry debug names for their
+;;; main lambda.
 (with-test (:name (:backtrace :varargs-entry))
   (with-details t
     (assert (verify-backtrace #'bt.3.1
-                              '(((sb-c::varargs-entry bt.3.1) :key nil))))
+                              '((bt.3.1 :key nil))))
     (assert (verify-backtrace #'bt.3.2
-                              '(((sb-c::varargs-entry bt.3.2) :key ?))))
+                              '((bt.3.2 :key ?))))
     (assert (verify-backtrace #'bt.3.3
-                              '(((sb-c::varargs-entry bt.3.3) &rest)))))
+                              '((bt.3.3 &rest)))))
   (with-details nil
     (assert (verify-backtrace #'bt.3.1
                               '((bt.3.1 :key nil))))
@@ -362,14 +366,17 @@
     (assert (verify-backtrace #'bt.3.3
                               '((bt.3.3 &rest))))))
 
+;;; This test is somewhat deceptively named. Due to confusion in debug naming
+;;; these functions used to have sb-c::hairy-args-processor debug names for
+;;; their main lambda.
 (with-test (:name (:backtrace :hairy-args-processor))
   (with-details t
     (assert (verify-backtrace #'bt.4.1
-                              '(((sb-c::hairy-arg-processor bt.4.1) ?))))
+                              '((bt.4.1 ?))))
     (assert (verify-backtrace #'bt.4.2
-                              '(((sb-c::hairy-arg-processor bt.4.2) ?))))
+                              '((bt.4.2 ?))))
     (assert (verify-backtrace #'bt.4.3
-                              '(((sb-c::hairy-arg-processor bt.4.3) &rest)))))
+                              '((bt.4.3 &rest)))))
   (with-details nil
     (assert (verify-backtrace #'bt.4.1
                               '((bt.4.1 ?))))
@@ -744,4 +751,17 @@
       (unless (zerop (length problems))
         (error problems)))))
 
+(defgeneric gf-dispatch-test/gf (x y)
+  (:method (x y)
+    (+ x y)))
+(defun gf-dispatch-test/f (z)
+  (gf-dispatch-test/gf z))
+
+(with-test (:name :gf-dispatch-backtrace)
+  ;; Fill the cache
+  (gf-dispatch-test/gf 1 1)
+  ;; Wrong argument count
+  (assert (verify-backtrace (lambda () (gf-dispatch-test/f 42))
+                            '(((sb-pcl::gf-dispatch gf-dispatch-test/gf) 42)))))
+
 (write-line "/debug.impure.lisp done")