;; Place point on "stack frame 0" (bug#15101).
(goto-char pos)))
-
-(defun debugger-make-xrefs (&optional buffer)
- "Attach cross-references to function names in the `*Backtrace*' buffer."
- (interactive "b")
- (with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (setq buffer (current-buffer))
- (let ((inhibit-read-only t)
- (old-end (point-min)) (new-end (point-min)))
- ;; If we saved an old backtrace, find the common part
- ;; between the new and the old.
- ;; Compare line by line, starting from the end,
- ;; because that's the part that is likely to be unchanged.
- (if debugger-previous-backtrace
- (let (old-start new-start (all-match t))
- (goto-char (point-max))
- (with-temp-buffer
- (insert debugger-previous-backtrace)
- (while (and all-match (not (bobp)))
- (setq old-end (point))
- (forward-line -1)
- (setq old-start (point))
- (with-current-buffer buffer
- (setq new-end (point))
- (forward-line -1)
- (setq new-start (point)))
- (if (not (zerop
- (let ((case-fold-search nil))
- (compare-buffer-substrings
- (current-buffer) old-start old-end
- buffer new-start new-end))))
- (setq all-match nil))))
- ;; Now new-end is the position of the start of the
- ;; unchanged part in the current buffer, and old-end is
- ;; the position of that same text in the saved old
- ;; backtrace. But we must subtract (point-min) since strings are
- ;; indexed in origin 0.
-
- ;; Replace the unchanged part of the backtrace
- ;; with the text from debugger-previous-backtrace,
- ;; since that already has the proper xrefs.
- ;; With this optimization, we only need to scan
- ;; the changed part of the backtrace.
- (delete-region new-end (point-max))
- (goto-char (point-max))
- (insert (substring debugger-previous-backtrace
- (- old-end (point-min))))
- ;; Make the unchanged part of the backtrace inaccessible
- ;; so it won't be scanned.
- (narrow-to-region (point-min) new-end)))
-
- ;; Scan the new part of the backtrace, inserting xrefs.
- (goto-char (point-min))
- (while (progn
- (goto-char (+ (point) 2))
- (skip-syntax-forward "^w_")
- (not (eobp)))
- (let* ((beg (point))
- (end (progn (skip-syntax-forward "w_") (point)))
- (sym (intern-soft (buffer-substring-no-properties
- beg end)))
- (file (and sym (symbol-file sym 'defun))))
- (when file
- (goto-char beg)
- ;; help-xref-button needs to operate on something matched
- ;; by a regexp, so set that up for it.
- (re-search-forward "\\(\\sw\\|\\s_\\)+")
- (help-xref-button 0 'help-function-def sym file)))
- (forward-line 1))
- (widen))
- (setq debugger-previous-backtrace (buffer-string)))))
\f
(defun debugger-step-through ()
"Proceed, stepping through subexpressions of this expression.
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
-
-(defun ert--record-backtrace ()
- "Record the current backtrace (as a list) and return it."
- ;; Since the backtrace is stored in the result object, result
- ;; objects must only be printed with appropriate limits
- ;; (`print-level' and `print-length') in place. For interactive
- ;; use, the cost of ensuring this possibly outweighs the advantage
- ;; of storing the backtrace for
- ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
- ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
- ;; For batch use, however, printing the backtrace may be useful.
- (cl-loop
- ;; 6 is the number of frames our own debugger adds (when
- ;; compiled; more when interpreted). FIXME: Need to describe a
- ;; procedure for determining this constant.
- for i from 6
- for frame = (backtrace-frame i)
- while frame
- collect frame))
-
-(defun ert--print-backtrace (backtrace)
+(defun ert--print-backtrace (backtrace do-xrefs)
"Format the backtrace BACKTRACE to the current buffer."
- ;; This is essentially a reimplementation of Fbacktrace
- ;; (src/eval.c), but for a saved backtrace, not the current one.
(let ((print-escape-newlines t)
(print-level 8)
(print-length 50))
- (dolist (frame backtrace)
- (pcase-exhaustive frame
- (`(nil ,special-operator . ,arg-forms)
- ;; Special operator.
- (insert
- (format " %S\n" (cons special-operator arg-forms))))
- (`(t ,fn . ,args)
- ;; Function call.
- (insert (format " %S(" fn))
- (cl-loop for firstp = t then nil
- for arg in args do
- (unless firstp
- (insert " "))
- (insert (format "%S" arg)))
- (insert ")\n"))))))
+ (debugger-insert-backtrace backtrace do-xrefs)))
;; A container for the state of the execution of a single test and
;; environment data needed during its execution.
((quit) 'quit)
((ert-test-skipped) 'skipped)
(otherwise 'failed)))
- (backtrace (ert--record-backtrace))
+ ;; We store the backtrace in the result object for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+ ;; This means we have to limit `print-level' and
+ ;; `print-length' when printing result objects. That
+ ;; might not be worth while when we can also use
+ ;; `ert-results-rerun-test-debugging-errors-at-point',
+ ;; (i.e., when running interactively) but having the
+ ;; backtrace ready for printing is important for batch
+ ;; use.
+ ;;
+ ;; Grab the frames starting from `signal', frames below
+ ;; that are all from the debugger.
+ (backtrace (backtrace-frames 'signal))
(infos (reverse ert--infos)))
(setf (ert--test-execution-info-result info)
(cl-ecase type
(ert-test-result-with-condition
(message "Test %S backtrace:" (ert-test-name test))
(with-temp-buffer
- (ert--print-backtrace (ert-test-result-with-condition-backtrace
- result))
+ (ert--print-backtrace
+ (ert-test-result-with-condition-backtrace result)
+ nil)
(goto-char (point-min))
(while (not (eobp))
(let ((start (point))
BEGIN and END specify a region in the current buffer."
(save-excursion
- (save-restriction
- (narrow-to-region begin end)
- ;; Inhibit optimization in `debugger-make-xrefs' that would
- ;; sometimes insert unrelated backtrace info into our buffer.
- (let ((debugger-previous-backtrace nil))
- (debugger-make-xrefs)))))
+ (goto-char begin)
+ (while (progn
+ (goto-char (+ (point) 2))
+ (skip-syntax-forward "^w_")
+ (< (point) end))
+ (let* ((beg (point))
+ (end (progn (skip-syntax-forward "w_") (point)))
+ (sym (intern-soft (buffer-substring-no-properties
+ beg end)))
+ (file (and sym (symbol-file sym 'defun))))
+ (when file
+ (goto-char beg)
+ ;; help-xref-button needs to operate on something matched
+ ;; by a regexp, so set that up for it.
+ (re-search-forward "\\(\\sw\\|\\s_\\)+")
+ (help-xref-button 0 'help-function-def sym file)))
+ (forward-line 1))))
(defun ert--string-first-line (s)
"Return the first line of S, or S if it contains no newlines.
;; Use unibyte because `debugger-setup-buffer' also does so.
(set-buffer-multibyte nil)
(setq truncate-lines t)
- (ert--print-backtrace backtrace)
- (debugger-make-xrefs)
+ (ert--print-backtrace backtrace t)
(goto-char (point-min))
(insert (substitute-command-keys "Backtrace for test `"))
(ert-insert-test-name-button (ert-test-name test))
projects / emacs.git / commitdiff