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.

diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index d879f3dcadf5cd97837e465ccda7555cf82b9e9c..6404e068daeef33c4e7e53d535bc841685389d48 100644 (file)
--- 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 492d01feed0b7f764cba4445b76177dc95673d4c..aeba96e3811636efa1f66b96630f75de19750921 100644 (file)
--- 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 6c1426ce5cb4b37cf99c168784303700de7ca929..c38019d4a736aadc22c472a762f1ae09f92c72d8 100644 (file)
--- 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 7627829e034ac4fb215509b1feae858e43b0133d..cef97e0fb45c6524a1aa0c5f67e83010d4444774 100644 (file)
--- 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 89b1f293743e86018c4a04494da959c6f0df686e..be9f150379599397947df95e43a73ab3cf5965f0 100644 (file)
--- 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