From: Philipp Stephani <phst@google.com>
Date: Sun, 2 Aug 2020 14:01:47 +0000 (+0200)
Subject: Don’t generate duplicate symbols for secondary CL methods (Bug#42671)
X-Git-Tag: emacs-28.0.90~6862
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e6eb554b95327549992c3684910921db9181ffb6;p=emacs.git

Don’t generate duplicate symbols for secondary CL methods (Bug#42671)

* lisp/emacs-lisp/edebug.el
(edebug-match-cl-generic-method-qualifier): Add matcher for
‘cl-defmethod’ qualifier.

* lisp/emacs-lisp/cl-generic.el (cl-defmethod): Use it.

* test/lisp/emacs-lisp/edebug-tests.el
(edebug-cl-defmethod-qualifier): New unit test.
---

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4e8423eb5b1..c67681b0960 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -432,9 +432,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
             (&define                    ; this means we are defining something
              [&or name ("setf" name :name setf)]
              ;; ^^ This is the methods symbol
-             [ &rest atom ]         ; Multiple qualifiers are allowed.
-                                    ; Like in CLOS spec, we support
-                                    ; any non-list values.
+             [ &rest cl-generic-method-qualifier ]
+             ;; Multiple qualifiers are allowed.
              cl-generic-method-args     ; arguments
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a565e8f6dcb..7627829e034 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,6 +1731,8 @@ contains a circular object."
 		;; Less frequently used:
 		;; (function . edebug-match-function)
 		(lambda-expr . edebug-match-lambda-expr)
+                (cl-generic-method-qualifier
+                 . edebug-match-cl-generic-method-qualifier)
                 (cl-generic-method-args . edebug-match-cl-generic-method-args)
                 (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
                 (cl-macrolet-name . edebug-match-cl-macrolet-name)
@@ -2035,6 +2037,16 @@ contains a circular object."
 	  spec))
   nil)
 
+(defun edebug-match-cl-generic-method-qualifier (cursor)
+  "Match a QUALIFIER for `cl-defmethod' at CURSOR."
+  (let ((args (edebug-top-element-required cursor "Expected qualifier")))
+    ;; Like in CLOS spec, we support any non-list values.
+    (unless (atom args) (edebug-no-match cursor "Atom expected"))
+    ;; Append the arguments to `edebug-def-name' (Bug#42671).
+    (setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
+    (edebug-move-cursor cursor)
+    (list args)))
+
 (defun edebug-match-cl-generic-method-args (cursor)
   (let ((args (edebug-top-element-required cursor "Expected arguments")))
     (if (not (consp args))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 41811c9dc07..89b1f293743 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -938,5 +938,27 @@ test and possibly others should be updated."
     "g"
     (should (equal edebug-tests-@-result '(0 1))))))
 
+(ert-deftest edebug-cl-defmethod-qualifier ()
+  "Check that secondary `cl-defmethod' forms don't stomp over
+primary ones (Bug#42671)."
+  (with-temp-buffer
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (defined-symbols ())
+           (edebug-new-definition-function
+            (lambda (def-name)
+              (push def-name defined-symbols)
+              (edebug-new-definition def-name))))
+      (dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number)))
+                      (cl-defmethod edebug-cl-defmethod-qualifier
+                        :around ((_ number)))))
+        (print form (current-buffer)))
+      (eval-buffer)
+      (should
+       (equal
+        defined-symbols
+        (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
+              (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here