1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

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.
This commit is contained in:
Philipp Stephani 2020-08-02 16:01:47 +02:00
parent 418ea25bbf
commit e6eb554b95
3 changed files with 36 additions and 3 deletions

View file

@ -432,9 +432,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(&define ; this means we are defining something (&define ; this means we are defining something
[&or name ("setf" name :name setf)] [&or name ("setf" name :name setf)]
;; ^^ This is the methods symbol ;; ^^ This is the methods symbol
[ &rest atom ] ; Multiple qualifiers are allowed. [ &rest cl-generic-method-qualifier ]
; Like in CLOS spec, we support ;; Multiple qualifiers are allowed.
; any non-list values.
cl-generic-method-args ; arguments cl-generic-method-args ; arguments
lambda-doc ; documentation string lambda-doc ; documentation string
def-body))) ; part to be debugged def-body))) ; part to be debugged

View file

@ -1731,6 +1731,8 @@ contains a circular object."
;; Less frequently used: ;; Less frequently used:
;; (function . edebug-match-function) ;; (function . edebug-match-function)
(lambda-expr . edebug-match-lambda-expr) (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-generic-method-args . edebug-match-cl-generic-method-args)
(cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
(cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-name . edebug-match-cl-macrolet-name)
@ -2035,6 +2037,16 @@ contains a circular object."
spec)) spec))
nil) 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) (defun edebug-match-cl-generic-method-args (cursor)
(let ((args (edebug-top-element-required cursor "Expected arguments"))) (let ((args (edebug-top-element-required cursor "Expected arguments")))
(if (not (consp args)) (if (not (consp args))

View file

@ -938,5 +938,27 @@ test and possibly others should be updated."
"g" "g"
(should (equal edebug-tests-@-result '(0 1)))))) (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) (provide 'edebug-tests)
;;; edebug-tests.el ends here ;;; edebug-tests.el ends here