Subject: bug#29919: 26.0.90; Incorrect Edebug spec for cl-macrolet

From: Gemini Lasswell <[email-masked]>
Date: Tue, 24 Jul 2018 16:20:42 -0700

Gemini Lasswell <[email-masked]> writes:

> Edebug gives an error when trying to instrument a function which uses
> cl-macrolet to define a macro with an argument list containing &rest.
>
> Looks to me like the problem is that the Edebug spec is using (&rest arg)
> when it should be using cl-macro-list, assuming that cl-macrolet
> supports full CL argument lists.

That was one of the problems, and the other problem was that Edebug
would wrap all the arguments to the temporary macros, even those that
are not evaluated, causing breakage. I solved that in the attached patch
by writing Edebug match functions for cl-macrolet which treat the
temporary macros like normal macros without Edebug specs, which means
none of their arguments get wrapped. This fixes the breakage but means
you can't Edebug through those of the arguments which do get evaluated.
To do that we'd have to add the ability to have (declare (debug ...))
forms in the temporary macro bodies so that they could have temporary
Edebug specs, which would mean changing cl-macrolet itself instead of
just its Edebug spec.

Kaushal, I was able to step through org-export-data with this patch in
place.  Let me know if you are able to give it a try.

>From 6a9c02ac9b1515d44d1c28c82ee4d19e231797a8 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <[email-masked]>
Date: Tue, 24 Jul 2018 09:07:18 -0700
Subject: [PATCH] Fix Edebug spec for cl-macrolet (bug#29919)

Add an Edebug matching function for cl-macrolet which collects the
symbols used in the bindings.  When those symbols are found in the
body of the expression, they are treated as macros without Edebug
specs.
* 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.
---
 lisp/emacs-lisp/cl-macs.el                         |  5 +--
 lisp/emacs-lisp/edebug.el                          | 47 ++++++++++++++++++++++
 .../edebug-resources/edebug-test-code.el           |  7 ++++
 test/lisp/emacs-lisp/edebug-tests.el               | 11 +++++
 4 files changed, 66 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 011965acb5..d0d1c3b156 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2083,10 +2083,7 @@ cl-macrolet
 
 \(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 e759c5b5b2..f0c0db182e 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1198,6 +1198,8 @@ edebug-def-interactive
 (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 @@ edebug-list-form-args
   ;; 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 @@ edebug-match-specs
 		;; (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 @@ edebug-match-cl-generic-method-args
     (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 e86c2f1c1e..f3fc78d4e1 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 @@ edebug-test-code-use-destructuring-bind
   (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 85f6bd47db..7d780edf28 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -913,5 +913,16 @@ edebug-tests-setup-code-file
     "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
-- 
2.16.4