[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e6eb554 1/2: Don’t generate duplicate symbols for secondary CL m
From: |
Philipp Stephani |
Subject: |
master e6eb554 1/2: Don’t generate duplicate symbols for secondary CL methods (Bug#42671) |
Date: |
Sun, 2 Aug 2020 10:25:59 -0400 (EDT) |
branch: master
commit e6eb554b95327549992c3684910921db9181ffb6
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>
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.
---
lisp/emacs-lisp/cl-generic.el | 5 ++---
lisp/emacs-lisp/edebug.el | 12 ++++++++++++
test/lisp/emacs-lisp/edebug-tests.el | 22 ++++++++++++++++++++++
3 files changed, 36 insertions(+), 3 deletions(-)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4e8423e..c67681b 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -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
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a565e8f..7627829 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -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))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index 41811c9..89b1f29 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -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