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
|
(&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
|
||||||
|
|
|
||||||
|
|
@ -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))
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue