From d8ab98843edccd233c2354d3c518c7a4b18023bd Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 2 Aug 2020 17:17:00 +0200 Subject: [PATCH] =?utf8?q?Avoid=20duplicate=20Edebug=20symbols=20when=20us?= =?utf8?q?ing=20=E2=80=98cl-flet=E2=80=99=20(Bug#41989)?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/edebug.el (edebug-match-:unique): Add a new ‘:unique’ specifier to generate unique names. * lisp/emacs-lisp/cl-macs.el (cl-flet): Use it. This requires inlining the ‘cl-defun’ specification. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-flet): New unit test. * doc/lispref/edebug.texi (Specification List): Document new ‘:unique’ construct. --- doc/lispref/edebug.texi | 10 +++++++ etc/NEWS | 4 +++ lisp/emacs-lisp/cl-macs.el | 7 ++++- lisp/emacs-lisp/edebug.el | 12 +++++++++ test/lisp/emacs-lisp/edebug-tests.el | 40 ++++++++++++++++++++++++++++ 5 files changed, 72 insertions(+), 1 deletion(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index d879f3dcadf..6404e068dae 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1438,6 +1438,16 @@ name component for the definition. You can use this to add a unique, static component to the name of the definition. It may be used more than once. +@item :unique +This construct is like @code{:name}, but generates unique names. It +does not match an argument. The element following @code{:unique} +should be a string; it is used as the prefix for an additional name +component for the definition. You can use this to add a unique, +dynamic component to the name of the definition. This is useful for +macros that can define the same symbol multiple times in different +scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may +be used more than once. + @item arg The argument, a symbol, is the name of an argument of the defining form. However, lambda-list keywords (symbols starting with @samp{&}) diff --git a/etc/NEWS b/etc/NEWS index 492d01feed0..aeba96e3811 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -260,6 +260,10 @@ To revert to the previous behaviour, unconditionally aborts the current edebug instrumentation with the supplied error message. +*** Edebug specification lists can use the new keyword ':unique', +which appends a unique suffix to the Edebug name of the current +definition. + +++ ** ElDoc diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 6c1426ce5cb..c38019d4a73 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2016,7 +2016,12 @@ info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug ((&rest [&or (&define name function-form) (cl-defun)]) + (debug ((&rest [&or (&define name :unique "cl-flet@" function-form) + (&define name :unique "cl-flet@" + cl-lambda-list + cl-declarations-or-string + [&optional ("interactive" interactive)] + def-body)]) cl-declarations body))) (let ((binds ()) (newenv macroexpand-all-environment)) (dolist (binding bindings) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7627829e034..cef97e0fb45 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1725,6 +1725,7 @@ contains a circular object." (&define . edebug-match-&define) (name . edebug-match-name) (:name . edebug-match-colon-name) + (:unique . edebug-match-:unique) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) @@ -2037,6 +2038,17 @@ contains a circular object." spec)) nil) +(defun edebug-match-:unique (_cursor spec) + "Match a `:unique PREFIX' specifier. +SPEC is the symbol name prefix for `gensym'." + (let ((suffix (gensym spec))) + (setq edebug-def-name + (if edebug-def-name + ;; Construct a new name by appending to previous name. + (intern (format "%s@%s" edebug-def-name suffix)) + suffix))) + 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"))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 89b1f293743..be9f1503795 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -960,5 +960,45 @@ primary ones (Bug#42671)." (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) +(ert-deftest edebug-tests-cl-flet () + "Check what Edebug can instrument `cl-flet' forms without name +clashes (Bug#41853)." + (with-temp-buffer + (dolist (form '((defun edebug-tests-cl-flet-1 () + (cl-flet ((inner () 0)) (message "Hi")) + (cl-flet ((inner () 1)) (inner))) + (defun edebug-tests-cl-flet-2 () + (cl-flet ((inner () 2)) (inner))))) + (print form (current-buffer))) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name))) + ;; Make generated symbols reproducible. + (gensym-counter 10000)) + (eval-buffer) + (should (equal (reverse instrumented-names) + ;; The outer definitions come after the inner + ;; ones because their body ends later. + ;; FIXME: There are twice as many inner + ;; definitions as expected due to Bug#41988. + ;; Once that bug is fixed, remove the duplicates. + ;; FIXME: We'd rather have names such as + ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000', + ;; but that requires further changes to Edebug. + '(inner@cl-flet@10000 + inner@cl-flet@10001 + inner@cl-flet@10002 + inner@cl-flet@10003 + edebug-tests-cl-flet-1 + inner@cl-flet@10004 + inner@cl-flet@10005 + edebug-tests-cl-flet-2)))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here -- 2.39.2