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:
parent
a07ec21bf2
commit
d8ab98843e
5 changed files with 72 additions and 1 deletions
|
@ -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{&})
|
||||
|
|
4
etc/NEWS
4
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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue