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.
This commit is contained in:
parent
22d463ed5c
commit
df7371b84e
4 changed files with 66 additions and 4 deletions
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
(¬ . edebug-match-¬)
|
||||
(&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")))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue