From e6eb554b95327549992c3684910921db9181ffb6 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 2 Aug 2020 16:01:47 +0200 Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20generate=20duplicate=20symbols?= =?utf8?q?=20for=20secondary=20CL=20methods=20(Bug#42671)?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * 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 4e8423eb5b1..c67681b0960 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 a565e8f6dcb..7627829e034 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 41811c9dc07..89b1f293743 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 -- 2.39.2