>From 6a9c02ac9b1515d44d1c28c82ee4d19e231797a8 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell 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) (¬ . edebug-match-¬) (&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