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:
parent
418ea25bbf
commit
e6eb554b95
3 changed files with 36 additions and 3 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue