From: Philipp Stephani <phst@google.com>
Date: Sun, 2 Aug 2020 16:05:36 +0000 (+0200)
Subject: Add a workaround for Bug#42672
X-Git-Tag: emacs-28.0.90~6857
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3e0c3479b24e1978d30bbcc00faac7bdd6bdd170;p=emacs.git

Add a workaround for Bug#42672

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Work around Bug#42672
by uniquifying inline method names.

* test/lisp/emacs-lisp/cl-generic-tests.el
(cl-defgeneric/edebug/method): New regression test.
---

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c67681b0960..640eb6b06d4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
                      [&rest [&or
                              ("declare" &rest sexp)
                              (":argument-precedence-order" &rest sexp)
-                             (&define ":method" [&rest atom]
+                             (&define ":method"
+                                      ;; FIXME: The `:unique'
+                                      ;; construct works around
+                                      ;; Bug#42672.  We'd rather want
+                                      ;; names like those generated by
+                                      ;; `cl-defmethod', but that
+                                      ;; requires larger changes to
+                                      ;; Edebug.
+                                      :unique "cl-generic-:method@"
+                                      [&rest atom]
                                       cl-generic-method-args lambda-doc
                                       def-body)]]
                      def-body)))
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 51c9884ddc8..fc39e349523 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -24,6 +24,7 @@
 ;;; Code:
 
 (require 'cl-generic)
+(require 'edebug)
 
 ;; Don't indirectly require `cl-lib' at run-time.
 (eval-when-compile (require 'ert))
@@ -249,5 +250,40 @@
   (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
   (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods)))
 
+(ert-deftest cl-defgeneric/edebug/method ()
+  "Check that `:method' forms in `cl-defgeneric' create unique
+Edebug symbols (Bug#42672)."
+  (with-temp-buffer
+    (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_)
+                      (:method ((_ number)) 1)
+                      (:method ((_ string)) 2))
+                    (cl-defgeneric cl-defgeneric/edebug/method/2 (_)
+                      (:method ((_ number)) 3))))
+      (print form (current-buffer)))
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (instrumented-names ())
+           (edebug-new-definition-function
+            (lambda (name)
+              (when (memq name instrumented-names)
+                (error "Duplicate definition of `%s'" name))
+              (push name instrumented-names)
+              (edebug-new-definition name)))
+           ;; Make generated symbols reproducible.
+           (gensym-counter 10000))
+      (eval-buffer)
+      (should (equal (reverse instrumented-names)
+                     ;; The generic function definitions come after
+                     ;; the method definitions because their body ends
+                     ;; later.
+                     ;; FIXME: We'd rather have names such as
+                     ;; `cl-defgeneric/edebug/method/1 ((_ number))',
+                     ;; but that requires further changes to Edebug.
+                     (list (intern "cl-generic-:method@10000 ((_ number))")
+                           (intern "cl-generic-:method@10001 ((_ string))")
+                           'cl-defgeneric/edebug/method/1
+                           (intern "cl-generic-:method@10002 ((_ number))")
+                           'cl-defgeneric/edebug/method/2))))))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here