mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-08 23:40:24 -08:00
Add backtrace-mode and use it in the debugger, ERT and Edebug
* doc/lispref/debugging.texi (Using Debugger): Remove explanation of backtrace buffer. Refer to new node. (Backtraces): New node. (Debugger Commands): Refer to new node. Remove 'v'. * doc/lispref/edebug.texi (Edebug Misc): Refer to new node. * doc/misc/ert.texi (Running Tests Interactively): Refer to new node. * lisp/emacs-lisp-backtrace.el: New file. * test/lisp/emacs-lisp/backtrace-tests.el: New file. * lisp/emacs-lisp/debug.el: (debugger-buffer-state): New cl-defstruct. (debugger--restore-buffer-state): New function. (debug): Use a debugger-buffer-state object to save and restore buffer state. Fix bug#15749 by leaving an unused buffer in debugger-mode, empty, instead of in fundamental-mode, and then when reusing a buffer, not calling debugger-mode if the buffer is already in debugger-mode. (debugger-insert-backtrace): Remove. (debugger-setup-buffer): Use backtrace-mode. (debugger--insert-header): New function. (debugger-continue, debugger-return-value): Change check for flags to use backtrace-frames. (debugger-frame-number): Determine backtrace frame number from backtrace-frames. (debugger--locals-visible-p, debugger--insert-locals) (debugger--show-locals, debugger--hide-locals) (debugger-toggle-locals): Remove. (debugger-mode-map): Make a child of backtrace-mode-map. Move navigation commands to backtrace-mode-map. Bind 'q' to debugger-quit instead of top-level. Make Help Follow menu item call backtrace-help-follow-symbol. (debugger-mode): Derive from backtrace-mode. (debug-help-follow): Remove. Move body of this function to 'backtrace-help-follow-symbol' in backtrace.el. (debugger-quit): New function. * lisp/emacs-lisp/edebug.el (edebug-unwrap-results): Remove warning in docstring about circular results. (edebug-unwrap): Use pcase. (edebug-unwrap1): New function to unwrap circular objects. (edebug-unwrap*): Use it. (edebug--frame): New cl-defstruct. (edebug-backtrace): Call the buffer *Edebug Backtrace* and use backtrace-mode. Get the frames from edebug--backtrace-frames. (edebug--backtrace-frames, edebug--unwrap-and-add-info) (edebug--symbol-not-prefixed-p): New functions. * lisp/emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-for-backtraces) (lisp-el-font-lock-keywords-for-backtraces-1) (lisp-el-font-lock-keywords-for-backtraces-2): New constants. * lisp/emacs-lisp/ert.el (ert--print-backtrace): Remove. (ert--run-test-debugger): Use backtrace-get-frames. (ert-run-tests-batch): Use backtrace-to-string. (ert-results-pop-to-backtrace-for-test-at-point): Use backtrace-mode. (ert--insert-backtrace-header): New function. * tests/lisp/emacs-lisp/ert-tests.el (ert-test--which-file): Use backtrace-frame slot accessor.
This commit is contained in:
Gemini Lasswell
parent
8a7620955b
commit
e09120d686
11 changed files with 1260 additions and 350 deletions
|
|
@ -52,6 +52,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'backtrace)
|
||||
(require 'macroexp)
|
||||
(require 'cl-lib)
|
||||
(eval-when-compile (require 'pcase))
|
||||
|
|
@ -206,8 +207,7 @@ Use this with caution since it is not debugged."
|
|||
"Non-nil if Edebug should unwrap results of expressions.
|
||||
That is, Edebug will try to remove its own instrumentation from the result.
|
||||
This is useful when debugging macros where the results of expressions
|
||||
are instrumented expressions. But don't do this when results might be
|
||||
circular or an infinite loop will result."
|
||||
are instrumented expressions."
|
||||
:type 'boolean
|
||||
:group 'edebug)
|
||||
|
||||
|
|
@ -1265,25 +1265,59 @@ purpose by adding an entry to this alist, and setting
|
|||
(defun edebug-unwrap (sexp)
|
||||
"Return the unwrapped SEXP or return it as is if it is not wrapped.
|
||||
The SEXP might be the result of wrapping a body, which is a list of
|
||||
expressions; a `progn' form will be returned enclosing these forms."
|
||||
(if (consp sexp)
|
||||
(cond
|
||||
((eq 'edebug-after (car sexp))
|
||||
(nth 3 sexp))
|
||||
((eq 'edebug-enter (car sexp))
|
||||
(macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
|
||||
(t sexp);; otherwise it is not wrapped, so just return it.
|
||||
)
|
||||
sexp))
|
||||
expressions; a `progn' form will be returned enclosing these forms.
|
||||
Does not unwrap inside vectors, records, structures, or hash tables."
|
||||
(pcase sexp
|
||||
(`(edebug-after ,_before-form ,_after-index ,form)
|
||||
form)
|
||||
(`(lambda ,args (edebug-enter ',_sym ,_arglist
|
||||
(function (lambda nil . ,body))))
|
||||
`(lambda ,args ,@body))
|
||||
(`(closure ,env ,args (edebug-enter ',_sym ,_arglist
|
||||
(function (lambda nil . ,body))))
|
||||
`(closure ,env ,args ,@body))
|
||||
(`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
|
||||
(macroexp-progn body))
|
||||
(_ sexp)))
|
||||
|
||||
(defun edebug-unwrap* (sexp)
|
||||
"Return the SEXP recursively unwrapped."
|
||||
(let ((ht (make-hash-table :test 'eq)))
|
||||
(edebug--unwrap1 sexp ht)))
|
||||
|
||||
(defun edebug--unwrap1 (sexp hash-table)
|
||||
"Unwrap SEXP using HASH-TABLE of things already unwrapped.
|
||||
HASH-TABLE contains the results of unwrapping cons cells within
|
||||
SEXP, which are reused to avoid infinite loops when SEXP is or
|
||||
contains a circular object."
|
||||
(let ((new-sexp (edebug-unwrap sexp)))
|
||||
(while (not (eq sexp new-sexp))
|
||||
(setq sexp new-sexp
|
||||
new-sexp (edebug-unwrap sexp)))
|
||||
(if (consp new-sexp)
|
||||
(mapcar #'edebug-unwrap* new-sexp)
|
||||
(let ((result (gethash new-sexp hash-table nil)))
|
||||
(unless result
|
||||
(let ((remainder new-sexp)
|
||||
current)
|
||||
(setq result (cons nil nil)
|
||||
current result)
|
||||
(while
|
||||
(progn
|
||||
(puthash remainder current hash-table)
|
||||
(setf (car current)
|
||||
(edebug--unwrap1 (car remainder) hash-table))
|
||||
(setq remainder (cdr remainder))
|
||||
(cond
|
||||
((atom remainder)
|
||||
(setf (cdr current)
|
||||
(edebug--unwrap1 remainder hash-table))
|
||||
nil)
|
||||
((gethash remainder hash-table nil)
|
||||
(setf (cdr current) (gethash remainder hash-table nil))
|
||||
nil)
|
||||
(t (setq current
|
||||
(setf (cdr current) (cons nil nil)))))))))
|
||||
result)
|
||||
new-sexp)))
|
||||
|
||||
|
||||
|
|
@ -3916,8 +3950,10 @@ Global commands prefixed by `global-edebug-prefix':
|
|||
;; (setq debugger 'debug) ; use the standard debugger
|
||||
|
||||
;; Note that debug and its utilities must be byte-compiled to work,
|
||||
;; since they depend on the backtrace looking a certain way. But
|
||||
;; edebug is not dependent on this, yet.
|
||||
;; since they depend on the backtrace looking a certain way. Edebug
|
||||
;; will work if not byte-compiled, but it will not be able correctly
|
||||
;; remove its instrumentation from backtraces unless it is
|
||||
;; byte-compiled.
|
||||
|
||||
(defun edebug (&optional arg-mode &rest args)
|
||||
"Replacement for `debug'.
|
||||
|
|
@ -3947,48 +3983,96 @@ Otherwise call `debug' normally."
|
|||
(apply #'debug arg-mode args)
|
||||
))
|
||||
|
||||
;;; Backtrace buffer
|
||||
|
||||
;; Data structure for backtrace frames with information
|
||||
;; from Edebug instrumentation found in the backtrace.
|
||||
(cl-defstruct
|
||||
(edebug--frame
|
||||
(:constructor edebug--make-frame)
|
||||
(:include backtrace-frame))
|
||||
def-name before-index after-index)
|
||||
|
||||
(defun edebug-backtrace ()
|
||||
"Display a non-working backtrace. Better than nothing..."
|
||||
"Display the current backtrace in a `backtrace-mode' window."
|
||||
(interactive)
|
||||
(if (or (not edebug-backtrace-buffer)
|
||||
(null (buffer-name edebug-backtrace-buffer)))
|
||||
(setq edebug-backtrace-buffer
|
||||
(generate-new-buffer "*Backtrace*"))
|
||||
(generate-new-buffer "*Edebug Backtrace*"))
|
||||
;; Else, could just display edebug-backtrace-buffer.
|
||||
)
|
||||
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
|
||||
(setq edebug-backtrace-buffer standard-output)
|
||||
(let ((print-escape-newlines t)
|
||||
(print-length 50) ; FIXME cf edebug-safe-prin1-to-string
|
||||
last-ok-point)
|
||||
(backtrace)
|
||||
(with-current-buffer edebug-backtrace-buffer
|
||||
(unless (derived-mode-p 'backtrace-mode)
|
||||
(backtrace-mode))
|
||||
(setq backtrace-frames (edebug--backtrace-frames)
|
||||
backtrace-view '(:do-xrefs t))
|
||||
(backtrace-print)
|
||||
(goto-char (point-min)))))
|
||||
|
||||
;; Clean up the backtrace.
|
||||
;; Not quite right for current edebug scheme.
|
||||
(set-buffer edebug-backtrace-buffer)
|
||||
(setq truncate-lines t)
|
||||
(goto-char (point-min))
|
||||
(setq last-ok-point (point))
|
||||
(if t (progn
|
||||
(defun edebug--backtrace-frames ()
|
||||
"Return backtrace frames with instrumentation removed.
|
||||
Remove frames for Edebug's functions and the lambdas in
|
||||
`edebug-enter' wrappers."
|
||||
(let* ((frames (backtrace-get-frames 'edebug-debugger
|
||||
:constructor #'edebug--make-frame))
|
||||
skip-next-lambda def-name before-index after-index
|
||||
results
|
||||
(index (length frames)))
|
||||
(dolist (frame (reverse frames))
|
||||
(let ((fun (edebug--frame-fun frame))
|
||||
(args (edebug--frame-args frame)))
|
||||
(cl-decf index)
|
||||
(when (edebug--frame-evald frame)
|
||||
(setq before-index nil
|
||||
after-index nil))
|
||||
(pcase fun
|
||||
('edebug-enter
|
||||
(setq skip-next-lambda t
|
||||
def-name (nth 0 args)))
|
||||
('edebug-after
|
||||
(setq before-index (if (consp (nth 0 args))
|
||||
(nth 1 (nth 0 args))
|
||||
(nth 0 args))
|
||||
after-index (nth 1 args)))
|
||||
((pred edebug--symbol-not-prefixed-p)
|
||||
(edebug--unwrap-and-add-info frame def-name before-index after-index)
|
||||
(setf (edebug--frame-def-name frame) (and before-index def-name))
|
||||
(setf (edebug--frame-before-index frame) before-index)
|
||||
(setf (edebug--frame-after-index frame) after-index)
|
||||
(push frame results)
|
||||
(setq before-index nil
|
||||
after-index nil))
|
||||
(`(,(or 'lambda 'closure) . ,_)
|
||||
(unless skip-next-lambda
|
||||
(edebug--unwrap-and-add-info frame def-name before-index after-index)
|
||||
(push frame results))
|
||||
(setq before-index nil
|
||||
after-index nil
|
||||
skip-next-lambda nil)))))
|
||||
results))
|
||||
|
||||
;; Delete interspersed edebug internals.
|
||||
(while (re-search-forward "^ (?edebug" nil t)
|
||||
(beginning-of-line)
|
||||
(cond
|
||||
((looking-at "^ (edebug-after")
|
||||
;; Previous lines may contain code, so just delete this line.
|
||||
(setq last-ok-point (point))
|
||||
(forward-line 1)
|
||||
(delete-region last-ok-point (point)))
|
||||
(defun edebug--symbol-not-prefixed-p (sym)
|
||||
"Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
|
||||
(and (symbolp sym)
|
||||
(not (string-prefix-p "edebug-" (symbol-name sym)))))
|
||||
|
||||
((looking-at (if debugger-stack-frame-as-list
|
||||
"^ (edebug"
|
||||
"^ edebug"))
|
||||
(forward-line 1)
|
||||
(delete-region last-ok-point (point))
|
||||
)))
|
||||
)))))
|
||||
(defun edebug--unwrap-and-add-info (frame def-name before-index after-index)
|
||||
"Update FRAME with the additional info needed by an edebug--frame.
|
||||
Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME. Also
|
||||
remove Edebug's instrumentation from the function and any
|
||||
unevaluated arguments in FRAME."
|
||||
(setf (edebug--frame-def-name frame) (and before-index def-name))
|
||||
(setf (edebug--frame-before-index frame) before-index)
|
||||
(setf (edebug--frame-after-index frame) after-index)
|
||||
(setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
|
||||
(unless (edebug--frame-evald frame)
|
||||
(let (results)
|
||||
(dolist (arg (edebug--frame-args frame))
|
||||
(push (edebug-unwrap* arg) results))
|
||||
(setf (edebug--frame-args frame) (nreverse results)))))
|
||||
|
||||
|
||||
;;; Trace display
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue