From 522e3c15853279bf2a0ed1759c5b0ba3c9e0b7be Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 09:19:00 -0500 Subject: Operate on frame list instead of printed backtrace * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function, prints the given backtrace frames. (debugger-setup-buffer): Use it instead of editing the backtrace buffer text. --- lisp/emacs-lisp/debug.el | 90 +++++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 39 deletions(-) (limited to 'lisp/emacs-lisp/debug.el') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 83456fc31a2..62e413bd8d0 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -264,6 +264,40 @@ first will be printed into the backtrace buffer." (setq debug-on-next-call debugger-step-after-exit) debugger-value))) + +(defun debugger-insert-backtrace (frames do-xrefs) + "Format and insert the backtrace FRAMES at point. +Make functions into cross-reference buttons if DO-XREFS is non-nil." + (let ((standard-output (current-buffer)) + (eval-buffers eval-buffer-list)) + (require 'help-mode) ; Define `help-function-def' button type. + (pcase-dolist (`(,evald ,fun ,args ,flags) frames) + (insert (if (plist-get flags :debug-on-exit) + "* " " ")) + (let ((fun-file (and do-xrefs (symbol-file fun 'defun))) + (fun-pt (point))) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (prin1 fun) + (if args (prin1 args) (princ "()"))) + (t + (prin1 (cons fun args)) + (cl-incf fun-pt))) + (when fun-file + (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) + :type 'help-function-def + 'help-args (list fun fun-file)))) + ;; After any frame that uses eval-buffer, insert a line that + ;; states the buffer position it's reading at. + (when (and eval-buffers (memq fun '(eval-buffer eval-region))) + (insert (format " ; Reading at buffer position %d" + ;; This will get the wrong result if there are + ;; two nested eval-region calls for the same + ;; buffer. That's not a very useful case. + (with-current-buffer (pop eval-buffers) + (point))))) + (insert "\n")))) + (defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already." @@ -271,27 +305,20 @@ That buffer should be current already." (erase-buffer) (set-buffer-multibyte t) ;Why was it nil ? -stef (setq buffer-undo-list t) - (let ((standard-output (current-buffer)) - (print-escape-newlines t) - (print-level 8) - (print-length 50)) - ;; FIXME the debugger could pass a custom callback to mapbacktrace - ;; instead of manipulating printed results. - (mapbacktrace #'backtrace--print-frame 'debug)) - (goto-char (point-min)) - (delete-region (point) - (progn - (forward-line (if (eq (car args) 'debug) - ;; Remove debug--implement-debug-on-entry - ;; and the advice's `apply' frame. - 3 - 1)) - (point))) (insert "Debugger entered") - ;; lambda is for debug-on-call when a function call is next. - ;; debug is for debug-on-entry function called. - (let ((pos (point))) + (let ((frames (nthcdr + ;; Remove debug--implement-debug-on-entry and the + ;; advice's `apply' frame. + (if (eq (car args) 'debug) 3 1) + (backtrace-frames 'debug))) + (print-escape-newlines t) + (print-escape-control-characters t) + (print-level 8) + (print-length 50) + (pos (point))) (pcase (car args) + ;; lambda is for debug-on-call when a function call is next. + ;; debug is for debug-on-entry function called. ((or `lambda `debug) (insert "--entering a function:\n") (setq pos (1- (point)))) @@ -301,10 +328,8 @@ That buffer should be current already." (setq pos (point)) (setq debugger-value (nth 1 args)) (prin1 debugger-value (current-buffer)) - (insert ?\n) - (delete-char 1) - (insert ? ) - (beginning-of-line)) + (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) + (insert ?\n)) ;; Watchpoint triggered. ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) (insert @@ -341,23 +366,10 @@ That buffer should be current already." (cdr args) args) (current-buffer)) (insert ?\n))) + (debugger-insert-backtrace frames t) ;; Place point on "stack frame 0" (bug#15101). - (goto-char pos)) - ;; After any frame that uses eval-buffer, - ;; insert a line that states the buffer position it's reading at. - (save-excursion - (let ((tem eval-buffer-list)) - (while (and tem - (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t)) - (end-of-line) - (insert (format " ; Reading at buffer position %d" - ;; This will get the wrong result - ;; if there are two nested eval-region calls - ;; for the same buffer. That's not a very useful case. - (with-current-buffer (car tem) - (point)))) - (pop tem)))) - (debugger-make-xrefs)) + (goto-char pos))) + (defun debugger-make-xrefs (&optional buffer) "Attach cross-references to function names in the `*Backtrace*' buffer." -- cgit v1.2.3 From ead545824e511ab18d18b5223eab80e1f4fe3d64 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 -------------------------------- lisp/emacs-lisp/ert.el | 85 +++++++++++++++++---------------------- test/lisp/emacs-lisp/ert-tests.el | 8 +--- 3 files changed, 38 insertions(+), 126 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. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 2c49a634e35..7edc40188e1 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -670,48 +670,12 @@ and is displayed in front of the value of MESSAGE-FORM." (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. @@ -750,7 +714,19 @@ run. ARGS are the arguments to `debugger'." ((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 @@ -1409,8 +1385,9 @@ Returns the stats object." (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)) @@ -1828,12 +1805,23 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'." 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. @@ -2420,8 +2408,7 @@ To be used in the ERT results buffer." ;; 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)) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index fc5790c3659..317838b250f 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -367,12 +367,8 @@ This macro is used to test if macroexpansion in `should' works." (test (make-ert-test :body test-body)) (result (ert-run-test test))) (should (ert-test-failed-p result)) - (with-temp-buffer - (ert--print-backtrace (ert-test-failed-backtrace result)) - (goto-char (point-min)) - (end-of-line) - (let ((first-line (buffer-substring-no-properties (point-min) (point)))) - (should (equal first-line (format " %S()" test-body))))))) + (should (eq (nth 1 (car (ert-test-failed-backtrace result))) + 'signal)))) (ert-deftest ert-test-messages () :tags '(:causes-redisplay) -- cgit v1.2.3 From 0ae28c71c739dfecbe94a5ff6786e81021d2d1cf Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 28 Jun 2017 07:23:47 -0400 Subject: Hide byte code in backtraces (Bug#6991) * lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom, defaulting to `cl-print'. (debugger-insert-backtrace, debugger-setup-buffer): Use it instead of `prin1'. * etc/NEWS: Announce it. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/debug.el | 26 ++++++++++++++++++-------- 2 files changed, 23 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp/debug.el') diff --git a/etc/NEWS b/etc/NEWS index 5e10ca9cb62..319b40f5d1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -320,6 +320,11 @@ questions, with a handy way to display help texts. all call stack frames in a Lisp backtrace buffer as lists. Both debug.el and edebug.el have been updated to heed to this variable. +--- +** Values in call stack frames are now displayed using 'cl-prin1'. +The old behaviour of using 'prin1' can be restored by customizing the +new option 'debugger-print-function'. + +++ ** The new variable 'x-ctrl-keysym' has been added to the existing roster of X keysyms. It can be used in combination with another diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 7db0f91b746..726005af9b1 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -49,6 +49,12 @@ the middle is discarded, and just the beginning and end are displayed." :group 'debugger :version "21.1") +(defcustom debugger-print-function #'cl-prin1 + "Function used to print values in the debugger backtraces." + :type 'function + :options '(cl-prin1 prin1) + :version "26.1") + (defcustom debugger-bury-or-kill 'bury "What to do with the debugger buffer when exiting `debug'. The value affects the behavior of operations on any window @@ -265,10 +271,13 @@ first will be printed into the backtrace buffer." debugger-value))) +(defvar cl-print-compiled-button) + (defun debugger-insert-backtrace (frames do-xrefs) "Format and insert the backtrace FRAMES at point. Make functions into cross-reference buttons if DO-XREFS is non-nil." (let ((standard-output (current-buffer)) + (cl-print-compiled-button t) (eval-buffers eval-buffer-list)) (require 'help-mode) ; Define `help-function-def' button type. (pcase-dolist (`(,evald ,fun ,args ,flags) frames) @@ -278,10 +287,10 @@ Make functions into cross-reference buttons if DO-XREFS is non-nil." (fun-pt (point))) (cond ((and evald (not debugger-stack-frame-as-list)) - (prin1 fun) - (if args (prin1 args) (princ "()"))) + (funcall debugger-print-function fun) + (if args (funcall debugger-print-function args) (princ "()"))) (t - (prin1 (cons fun args)) + (funcall debugger-print-function (cons fun args)) (cl-incf fun-pt))) (when fun-file (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) @@ -327,7 +336,7 @@ That buffer should be current already." (insert "--returning value: ") (setq pos (point)) (setq debugger-value (nth 1 args)) - (prin1 debugger-value (current-buffer)) + (funcall debugger-print-function debugger-value (current-buffer)) (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) (insert ?\n)) ;; Watchpoint triggered. @@ -352,7 +361,7 @@ That buffer should be current already." (`error (insert "--Lisp error: ") (setq pos (point)) - (prin1 (nth 1 args) (current-buffer)) + (funcall debugger-print-function (nth 1 args) (current-buffer)) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. (`t @@ -362,9 +371,10 @@ That buffer should be current already." (_ (insert ": ") (setq pos (point)) - (prin1 (if (eq (car args) 'nil) - (cdr args) args) - (current-buffer)) + (funcall debugger-print-function + (if (eq (car args) 'nil) + (cdr args) args) + (current-buffer)) (insert ?\n))) (debugger-insert-backtrace frames t) ;; Place point on "stack frame 0" (bug#15101). -- cgit v1.2.3 From 7618d29db36396fbd736672cadaca641186c1dc5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 30 Jun 2017 18:01:01 -0400 Subject: * lisp/emacs-lisp/debug.el (debugger-list-functions): Remove obsolete msg --- lisp/emacs-lisp/debug.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp/debug.el') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 726005af9b1..b836e823c73 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -817,9 +817,13 @@ To specify a nil argument interactively, exit with an empty minibuffer." 'type 'help-function 'help-args (list fun)) (terpri)) - (terpri) - (princ "Note: if you have redefined a function, then it may no longer\n") - (princ "be set to debug on entry, even if it is in the list.")))))) + ;; Now that debug--function-list uses advice-member-p, its + ;; output should be reliable (except for bugs and the exceptional + ;; case where some other advice ends up overriding ours). + ;;(terpri) + ;;(princ "Note: if you have redefined a function, then it may no longer\n") + ;;(princ "be set to debug on entry, even if it is in the list.") + ))))) (defun debug--implement-debug-watch (symbol newval op where) "Conditionally call the debugger. -- cgit v1.2.3 From 9a65b5779629d4f0f88d568ff164629e82db5ba8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 1 Jul 2017 20:54:41 -0400 Subject: * lisp/emacs-lisp/cl-print.el (cl-print-compiled-button): t by default. * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): * lisp/help-fns.el (describe-variable): No need to let-bind `cl-print-compiled-button' to t anymore. --- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/debug.el | 3 --- lisp/help-fns.el | 5 +---- 3 files changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp/debug.el') diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 824d0b7b4f5..e9ca0412848 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -90,7 +90,7 @@ call other entry points instead, such as `cl-prin1'." - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") -(defvar cl-print-compiled-button nil +(defvar cl-print-compiled-button t "Control how to print byte-compiled functions into buffers. When the stream is a buffer, make the bytecode part of the output into a button whose action shows the function's disassembly.") diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index b836e823c73..2b8782590c4 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -271,13 +271,10 @@ first will be printed into the backtrace buffer." debugger-value))) -(defvar cl-print-compiled-button) - (defun debugger-insert-backtrace (frames do-xrefs) "Format and insert the backtrace FRAMES at point. Make functions into cross-reference buttons if DO-XREFS is non-nil." (let ((standard-output (current-buffer)) - (cl-print-compiled-button t) (eval-buffers eval-buffer-list)) (require 'help-mode) ; Define `help-function-def' button type. (pcase-dolist (`(,evald ,fun ,args ,flags) frames) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d7c31f9e2b8..32324ae3bcb 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -776,8 +776,6 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." version package)))))) output)) -(defvar cl-print-compiled-button) - ;;;###autoload (defun describe-variable (variable &optional buffer frame) "Display the full documentation of VARIABLE (a symbol). @@ -858,8 +856,7 @@ it is displayed along with the global value." (print-rep (let ((rep (let ((print-quoted t) - (print-circle t) - (cl-print-compiled-button t)) + (print-circle t)) (cl-prin1-to-string val)))) (if (and (symbolp val) (not (booleanp val))) (format-message "`%s'" rep) -- cgit v1.2.3