Fix Edebug spec for cl-macrolet (bug#29919)

Add an Edebug matching function for cl-macrolet which keeps track of
its bindings and treats them as macros without Edebug specs when found
in the body of the expression.
* lisp/emacs-lisp/edebug.el (edebug--cl-macrolet-defs): New variable.
(edebug-list-form-args): Use it.
(edebug--current-cl-macrolet-defs): New variable.
(edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name)
(edebug-match-cl-macrolet-body): New functions.
* lisp/emacs-lisp/cl-macs.el (cl-macrolet): Use cl-macrolet-expr
for Edebug spec.
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-macrolet):
New test.
* test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
(edebug-test-code-use-cl-macrolet): New function.

4 files changed, 66 insertions, 4 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 011965acb54..d0d1c3b156a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2083,10 +2083,7 @@ This is like `cl-flet', but for macros instead of functions.
 
 \(fn ((NAME ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1)
-           (debug
-            ((&rest (&define name (&rest arg) cl-declarations-or-string
-                             def-body))
-             cl-declarations body)))
+           (debug (cl-macrolet-expr)))
   (if (cdr bindings)
       `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
     (if (null bindings) (macroexp-progn body)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e759c5b5b24..f0c0db182ed 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1198,6 +1198,8 @@ purpose by adding an entry to this alist, and setting
 (defvar edebug-inside-func)  ;; whether code is inside function context.
 ;; Currently def-form sets this to nil; def-body sets it to t.
 
+(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
+
 (defun edebug-interactive-p-name ()
   ;; Return a unique symbol for the variable used to store the
   ;; status of interactive-p for this function.
@@ -1463,6 +1465,11 @@ expressions; a `progn' form will be returned enclosing these forms."
   ;; Helper for edebug-list-form
   (let ((spec (get-edebug-spec head)))
     (cond
+     ;; Treat cl-macrolet bindings like macros with no spec.
+     ((member head edebug--cl-macrolet-defs)
+      (if edebug-eval-macro-args
+          (edebug-forms cursor)
+        (edebug-sexps cursor)))
      (spec
       (cond
        ((consp spec)
@@ -1651,6 +1658,9 @@ expressions; a `progn' form will be returned enclosing these forms."
                 ;; (function . edebug-match-function)
                 (lambda-expr . edebug-match-lambda-expr)
                 (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)
+                (cl-macrolet-body . edebug-match-cl-macrolet-body)
                 (&not . edebug-match-&not)
                 (&key . edebug-match-&key)
                 (place . edebug-match-place)
@@ -1954,6 +1964,43 @@ expressions; a `progn' form will be returned enclosing these forms."
     (edebug-move-cursor cursor)
     (list args)))
 
+(defvar edebug--cl-macrolet-defs nil
+  "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
+(defvar edebug--current-cl-macrolet-defs nil
+  "List of symbols found within the bindings of the current `cl-macrolet' form.")
+
+(defun edebug-match-cl-macrolet-expr (cursor)
+  "Match a `cl-macrolet' form at CURSOR."
+  (let (edebug--current-cl-macrolet-defs)
+    (edebug-match cursor
+                  '((&rest (&define cl-macrolet-name cl-macro-list
+                                    cl-declarations-or-string
+                                    def-body))
+                    cl-declarations cl-macrolet-body))))
+
+(defun edebug-match-cl-macrolet-name (cursor)
+  "Match the name in a `cl-macrolet' binding at CURSOR.
+Collect the names in `edebug--cl-macrolet-defs' where they
+will be checked by `edebug-list-form-args' and treated as
+macros without a spec."
+  (let ((name (edebug-top-element-required cursor "Expected name")))
+    (when (not (symbolp name))
+      (edebug-no-match cursor "Bad name:" name))
+    ;; Change edebug-def-name to avoid conflicts with
+    ;; names at global scope.
+    (setq edebug-def-name (gensym "edebug-anon"))
+    (edebug-move-cursor cursor)
+    (push name edebug--current-cl-macrolet-defs)
+    (list name)))
+
+(defun edebug-match-cl-macrolet-body (cursor)
+  "Match the body of a `cl-macrolet' expression at CURSOR.
+Put the definitions collected in `edebug--current-cl-macrolet-defs'
+into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
+  (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
+                                         edebug--cl-macrolet-defs)))
+    (edebug-match-body cursor)))
+
 (defun edebug-match-arg (cursor)
   ;; set the def-args bound in edebug-defining-form
   (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index e86c2f1c1e7..f3fc78d4e12 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -130,5 +130,12 @@
   (let ((two 2) (three 3))
     (cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!))))
 
+(defun edebug-test-code-use-cl-macrolet (x)
+  (cl-macrolet ((wrap (func &rest args)
+                      `(format "The result of applying %s to %s is %S"
+                               ',func!func! ',args
+                               ,(cons func args))))
+    (wrap + 1 x)))
+
 (provide 'edebug-test-code)
 ;;; edebug-test-code.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 85f6bd47db2..7d780edf285 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -913,5 +913,16 @@ test and possibly others should be updated."
     "g"
     (should (equal edebug-tests-@-result 5)))))
 
+(ert-deftest edebug-tests-cl-macrolet ()
+  "Edebug can instrument `cl-macrolet' expressions. (Bug#29919)"
+  (edebug-tests-with-normal-env
+   (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)
+   (edebug-tests-run-kbd-macro
+    "@ SPC SPC"
+    (edebug-tests-should-be-at "use-cl-macrolet" "func")
+    (edebug-tests-should-match-result-in-messages "+")
+    "g"
+    (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11")))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here