Avoid duplicate Edebug symbols when using ‘cl-flet’ (Bug#41989)

* 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.
This commit is contained in:
Philipp Stephani 2020-08-02 17:17:00 +02:00
parent a07ec21bf2
commit d8ab98843e
5 changed files with 72 additions and 1 deletions

View file

@ -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{&})

View file

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

View file

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

View file

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

View file

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