Commit e6eb554b authored by Philipp Stephani's avatar Philipp Stephani

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.
parent 418ea25b
......@@ -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
......
......@@ -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))
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment