procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

5
lisp/emacs-lisp/cl-generic.el
View file

@ -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

12
lisp/emacs-lisp/edebug.el
View file

@ -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))