better debug name for secondary GF dispatch functions

 Fixes lp#503081

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index c1e5fc4..efbd482 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -1414,7 +1414,7 @@
                         (make-dfun-lambda-list nargs applyp)
                         (make-fast-method-call-lambda-list nargs applyp))))
       (multiple-value-bind (cfunction constants)
-          (get-fun1 `(lambda
+          (get-fun1 `(named-lambda (gf-dispatch ,name)
                       ,arglist
                       ,@(unless function-p
                           `((declare (ignore .pv. .next-method-call.))))

diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index e64e664..7f6d1bc 100644 (file)
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -751,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")