From ead545824e511ab18d18b5223eab80e1f4fe3d64 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 11 Feb 2017 17:19:41 -0500
Subject: Improve ert backtrace recording

Change ert to use the new `backtrace-frames' function instead of
collecting frames one by one with `backtrace-frame'.  Additionally,
collect frames starting from `signal' instead the somewhat arbitrary
"6 from the bottom".  Skipping 6 frames would skip the expression that
actually caused the signal that triggered the debugger.  Possibly 6
was chosen because in the case of a failed test, the triggering frame
is an `ert-fail' call, which is not so interesting.  But in case of a
test throwing an error, this drops the `error' call which is too much.

* lisp/emacs-lisp/debug.el (debugger-make-xrefs): Remove.
* lisp/emacs-lisp/ert.el (ert--make-xrefs-region): Bring in relevant
code from `debugger-make-xrefs'.
(ert--print-backtrace): Add DO-XREFS parameter, delegate to
`debugger-insert-backtrace'.
(ert--run-test-debugger): Record the backtrace frames starting from
the instigating `signal' call.
(ert-run-tests-batch): Pass nil for `ert--print-backtrace's new
DO-XREFS parameter.
(ert-results-pop-to-backtrace-for-test-at-point): Pass t as DO-XREFS
to `ert--print-backtrace' and remove call to `debugger-make-xrefs'.
* test/lisp/emacs-lisp/ert-tests.el (ert-test-record-backtrace): Check
the backtrace list instead of comparing its string representation.
Expect `signal' to be the first frame.
---
 lisp/emacs-lisp/debug.el | 71 ------------------------------------------------
 1 file changed, 71 deletions(-)

(limited to 'lisp/emacs-lisp/debug.el')

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 62e413bd8d0..7db0f91b746 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -370,77 +370,6 @@ That buffer should be current already."
     ;; 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)))))
 
 (defun debugger-step-through ()
   "Proceed, stepping through subexpressions of this expression.
-- 
cgit v1.2.3