From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#6991: Please keep bytecode out of *Backtrace* buffers Date: Mon, 26 Jun 2017 23:56:54 -0400 Message-ID: <87bmpankvt.fsf@users.sourceforge.net> References: <8739tm9vzl.fsf@jidanni.org> <87d1hrlek2.fsf@users.sourceforge.net> <83eg27bjah.fsf@gnu.org> <87a8cvlcmk.fsf@users.sourceforge.net> <8360njb9o5.fsf@gnu.org> <877f7zksm0.fsf@users.sourceforge.net> <83oa1a9msk.fsf@gnu.org> <83vavf73ei.fsf@gnu.org> <8360ne6v1q.fsf@gnu.org> <874m2ujh2v.fsf@users.sourceforge.net> <87wpcwkuug.fsf@users.sourceforge.net> <87zidx3u5u.fsf@users.sourceforge.net> <87o9tdowbh.fsf@users.sourceforge.net> <87mv8vo1zz.fsf@users.sourceforge.net> <87h8z2oqu0.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1498535778 8533 195.159.176.226 (27 Jun 2017 03:56:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 27 Jun 2017 03:56:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) Cc: lekktu@gmail.com, johnw@gnu.org, 6991@debbugs.gnu.org, larsi@gnus.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jun 27 05:56:12 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dPhbn-0001sq-NN for geb-bug-gnu-emacs@m.gmane.org; Tue, 27 Jun 2017 05:56:12 +0200 Original-Received: from localhost ([::1]:50287 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dPhbs-0005kE-OF for geb-bug-gnu-emacs@m.gmane.org; Mon, 26 Jun 2017 23:56:16 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:44130) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dPhbj-0005ju-GN for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2017 23:56:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dPhbe-0004Xj-Hd for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2017 23:56:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:37133) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dPhbe-0004XX-BW for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2017 23:56:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dPhbd-0004uJ-T9 for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2017 23:56:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 27 Jun 2017 03:56:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 6991 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: notabug Original-Received: via spool by 6991-submit@debbugs.gnu.org id=B6991.149853572918823 (code B ref 6991); Tue, 27 Jun 2017 03:56:01 +0000 Original-Received: (at 6991) by debbugs.gnu.org; 27 Jun 2017 03:55:29 +0000 Original-Received: from localhost ([127.0.0.1]:39810 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dPhb6-0004tW-RI for submit@debbugs.gnu.org; Mon, 26 Jun 2017 23:55:29 -0400 Original-Received: from mail-it0-f66.google.com ([209.85.214.66]:33099) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dPhb4-0004tI-06 for 6991@debbugs.gnu.org; Mon, 26 Jun 2017 23:55:27 -0400 Original-Received: by mail-it0-f66.google.com with SMTP id x12so1801176itb.0 for <6991@debbugs.gnu.org>; Mon, 26 Jun 2017 20:55:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=YlCfpCm6xkODccatwjnLn90TOCyv1EqBnpGhpcMq0gA=; b=eo5WCEMxUoUwyw9K8Z7BB5JIIHloVdiGc+KM86ckSNx4MSjHbSb58m86TByPyYHfxr DGCOJqav8g2I/87CdIL19LZSzR6048ODGBCFaY5FjnT4wZpwqAJRJj66v/usgNRaNbq+ ORpLNEJo4W8ivl/V05iIXZ6KDbK6T2MAuDZx/toTxZz46B1dpmvel6ygnAeUx9NHqg/J pWKISUYtQKjiPNQr2ZF9QRufc8qUgyMyc73V2ZkZEcqLVnl7/LmSbXdW2HoG3ZRySAHJ 0PqnoPcmetuPIFNt3RymmLMlTky3W3ybsj15FGpgjRkZsuYBEz9L76fP/K+oHN0JD9wV SZ+g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=YlCfpCm6xkODccatwjnLn90TOCyv1EqBnpGhpcMq0gA=; b=riRCdhh3FSNirpIw2xn1MD5+KBIx6LwpLVxz9PDsGWQZ0Tbv4ybXLYNiC03DGthl7Y 220uWVXjDpMXuveEmE8jiqNgrFUdj3PZJXLTyEN5PQt67quKlItiHkLJ4LE4F6MnXjW2 Duibv4NTs0hhzPgjwEXDtBLl9n6k/axr4WDT/ORnT/cgH2d5o8b2G6GeU7S7olOV+MRc 8NI8iZHcsgRlp/0BzSf13XJuPrFhWP6kk9uAYlJuN+6Ashz3R7QrzcqRzrVJvD/DWzTW z9h+tb9kjF1w03aL5yHDgzJ7wpemXKuM98SFhN1oFzzwJCP0GSBqdQtEK20c1FjlAH5y REOw== X-Gm-Message-State: AKS2vOxADeaP/3Z06YSAHOfyEZ3M6N/VTSxWGALd+F64qvVO+zuO7M68 /6SNbVJnU6gE9Q== X-Received: by 10.36.116.148 with SMTP id o142mr952135itc.74.1498535720215; Mon, 26 Jun 2017 20:55:20 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id e14sm848024itc.30.2017.06.26.20.55.17 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 26 Jun 2017 20:55:18 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Mon, 26 Jun 2017 10:54:06 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:133938 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: > I wonder why we do that, tho: > the previous code didn't have a comment, so I'm left guessing that maybe > it's that we don't want to advertise as "will stop when exiting foo" > a function which we're exiting? I tried git-blame, but that code seems to have been like that since "initial revision" (1991). I think your guess sounds reasonable. Anyway, here are the updated patches. --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0001-Operate-on-frame-list-instead-of-printed-backtrace.patch Content-Description: patch >From 9ff1fc669d1239ac6e84f6fd045f18ec5483f552 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 09:19:00 -0500 Subject: [PATCH 1/6] 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 | 97 +++++++++++++++++++++++++++--------------------- 1 file changed, 55 insertions(+), 42 deletions(-) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 83456fc31a..1bb1960d07 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -264,6 +264,40 @@ (defun debug (&rest args) (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,26 +305,19 @@ (defun debugger-setup-buffer (args) (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) ((or `lambda `debug) (insert "--entering a function:\n") @@ -300,11 +327,9 @@ (defun debugger-setup-buffer (args) (insert "--returning value: ") (setq pos (point)) (setq debugger-value (nth 1 args)) - (prin1 debugger-value (current-buffer)) - (insert ?\n) - (delete-char 1) - (insert ? ) - (beginning-of-line)) + (funcall debugger-print-function debugger-value (current-buffer)) + (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) + (insert ?\n)) ;; Watchpoint triggered. ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) (insert @@ -327,7 +352,7 @@ (defun debugger-setup-buffer (args) (`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 @@ -337,27 +362,15 @@ (defun debugger-setup-buffer (args) (_ (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). - (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." -- 2.11.1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0002-Improve-ert-backtrace-recording.patch Content-Description: patch >From be573593e5051f3b18c046e9f09b37a6f629ec5d Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 17:19:41 -0500 Subject: [PATCH 2/6] 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 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(-) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 1bb1960d07..a75242aa5a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -371,77 +371,6 @@ (defun debugger-setup-buffer (args) ;; 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 2c49a634e3..7edc40188e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -670,48 +670,12 @@ (cl-defstruct (ert-test-skipped (:include ert-test-result-with-condition))) (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 @@ (defun ert--run-test-debugger (info args) ((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 @@ (defun ert-run-tests-batch (&optional selector) (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 @@ (defun ert--make-xrefs-region (begin end) 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 @@ (defun ert-results-pop-to-backtrace-for-test-at-point () ;; 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 fc5790c365..317838b250 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -367,12 +367,8 @@ (ert-deftest ert-test-record-backtrace () (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) -- 2.11.1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0003-Escape-control-characters-in-backtraces-Bug-6991.patch Content-Description: patch >From 7f67318c05006c3447e2b1074c78e10d78e5d8ec Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 18:13:54 -0500 Subject: [PATCH 3/6] Escape control characters in backtraces (Bug#6991) * src/print.c (syms_of_print): Add new variable, print-escape-control-characters. (print_object): Print control characters with octal escape codes when print-escape-control-characters is true. * lisp/subr.el (backtrace): * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Bind `print-escape-control-characters' to t. --- lisp/subr.el | 3 ++- src/print.c | 45 +++++++++++++++++++++++++++++++++------------ 2 files changed, 35 insertions(+), 13 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index d0c8517c54..a9edff6166 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4514,7 +4514,8 @@ (defun backtrace--print-frame (evald func args flags) (defun backtrace () "Print a trace of Lisp function calls currently active. Output stream used is value of `standard-output'." - (let ((print-level (or print-level 8))) + (let ((print-level (or print-level 8)) + (print-escape-control-characters t)) (mapbacktrace #'backtrace--print-frame 'backtrace))) (defun backtrace-frames (&optional base) diff --git a/src/print.c b/src/print.c index 6bf8af9ef9..50c75d7712 100644 --- a/src/print.c +++ b/src/print.c @@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else { + bool still_need_nonhex = false; /* If we just had a hex escape, and this character could be taken as part of it, output `\ ' to prevent that. */ - if (need_nonhex && c_isxdigit (c)) - print_c_string ("\\ ", printcharfun); - - if (c == '\n' && print_escape_newlines - ? (c = 'n', true) - : c == '\f' && print_escape_newlines - ? (c = 'f', true) - : c == '\"' || c == '\\') - printchar ('\\', printcharfun); - - printchar (c, printcharfun); - need_nonhex = false; + if (c_isxdigit (c)) + { + if (need_nonhex) + print_c_string ("\\ ", printcharfun); + printchar (c, printcharfun); + } + else if (c == '\n' && print_escape_newlines + ? (c = 'n', true) + : c == '\f' && print_escape_newlines + ? (c = 'f', true) + : c == '\0' && print_escape_control_characters + ? (c = '0', still_need_nonhex = true) + : c == '\"' || c == '\\') + { + printchar ('\\', printcharfun); + printchar (c, printcharfun); + } + else if (print_escape_control_characters && c_iscntrl (c)) + { + char outbuf[1 + 3 + 1]; + int len = sprintf (outbuf, "\\%03o", c + 0u); + strout (outbuf, len, len, printcharfun); + } + else + printchar (c, printcharfun); + need_nonhex = still_need_nonhex; } } printchar ('\"', printcharfun); @@ -2329,6 +2344,11 @@ syms_of_print (void) Also print formfeeds as `\\f'. */); print_escape_newlines = 0; + DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters, + doc: /* Non-nil means print control characters in strings as `\\OOO'. +\(OOO is the octal representation of the character code.)*/); + print_escape_control_characters = 0; + DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii, doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO. \(OOO is the octal representation of the character code.) @@ -2418,6 +2438,7 @@ representation) and `#N#' in place of each subsequent occurrence, DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii"); + DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters"); print_prune_charset_plist = Qnil; staticpro (&print_prune_charset_plist); -- 2.11.1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0004-Don-t-redundantly-cl-print-arglist-in-function-docst.patch Content-Description: patch >From 7d2e4c3ff2788fff7e5ee7481e4983eb185c8402 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 27 May 2017 22:40:46 -0400 Subject: [PATCH 4/6] Don't redundantly cl-print arglist in function docstring again * lisp/emacs-lisp/cl-print.el (cl-print-object): Don't print arglist part of docstring. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1): Update test accordingly. --- lisp/emacs-lisp/cl-print.el | 9 +++++---- test/lisp/emacs-lisp/cl-print-tests.el | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 89a71d1b6c..824d0b7b4f 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -105,10 +105,11 @@ (cl-defmethod cl-print-object ((object compiled-function) stream) (if args (prin1 args stream) (princ "()" stream))) - (let ((doc (documentation object 'raw))) - (when doc - (princ " " stream) - (prin1 doc stream))) + (pcase (help-split-fundoc (documentation object 'raw) object) + ;; Drop args which `help-function-arglist' already printed. + (`(,_usage . ,(and doc (guard (stringp doc)))) + (princ " " stream) + (prin1 doc stream))) (let ((inter (interactive-form object))) (when inter (princ " " stream) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index dfbe18d784..6448a1b37f 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -34,7 +34,7 @@ (ert-deftest cl-print-tests-1 () (let ((print-circle t)) (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) - (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'" + (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'" (cl-prin1-to-string (symbol-function #'caar)))))) (ert-deftest cl-print-tests-2 () -- 2.11.1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0005-Hide-byte-code-in-backtraces-Bug-6991.patch Content-Description: patch >From 593c4758cdf1c177ab103bb506321b964c28cf21 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 11 Jun 2017 09:51:38 -0400 Subject: [PATCH 5/6] Hide byte code in backtraces (Bug#6991) * lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom, defaulting to `cl-print'. (debugger-insert-backtrace): Use it. * etc/NEWS: Announce it. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/debug.el | 15 ++++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c7a5674e51..21510fe539 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 a75242aa5a..3f1b4cddb3 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -49,6 +49,12 @@ (defcustom debugger-batch-max-lines 40 :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 @@ (defun debug (&rest args) 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 @@ (defun debugger-insert-backtrace (frames do-xrefs) (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))) -- 2.11.1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0006-Escape-NUL-bytes-in-X-selections-Bug-6991.patch Content-Description: patch >From f0b87839fe2cb8279acde98877f24c5e96f7a307 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 19:47:55 -0500 Subject: [PATCH 6/6] Escape NUL bytes in X selections (Bug#6991) * lisp/term/w32-win.el (w32--set-selection): * lisp/select.el (xselect--encode-string): Replace NUL bytes with "\0". * doc/emacs/killing.texi: Document new behavior. * etc/NEWS (times): Announce it. --- doc/emacs/killing.texi | 4 ++++ etc/NEWS | 4 ++++ lisp/select.el | 3 +++ lisp/term/w32-win.el | 2 +- 4 files changed, 12 insertions(+), 1 deletion(-) diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 47de053129..0b5efd04a1 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -519,6 +519,10 @@ Clipboard data to the clipboard manager, change the variable @code{x-select-enable-clipboard-manager} to @code{nil}. + Since strings containing NUL bytes are usually truncated when passed +through the clipboard, Emacs replaces such characters with ``\0'' +before transfering them to the system's clipboard. + @vindex select-enable-primary @findex clipboard-kill-region @findex clipboard-kill-ring-save diff --git a/etc/NEWS b/etc/NEWS index 21510fe539..281bacffd0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -326,6 +326,10 @@ The old behaviour of using 'prin1' can be restored by customizing the new option 'debugger-print-function'. +++ +** NUL bytes in strings copied to the system clipboard are now +replaced with "\0". + ++++ ** The new variable 'x-ctrl-keysym' has been added to the existing roster of X keysyms. It can be used in combination with another variable of this kind to swap modifiers in Emacs. diff --git a/lisp/select.el b/lisp/select.el index 4849d7d515..579c5c7e2e 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -475,6 +475,9 @@ (defun xselect--encode-string (type str &optional can-modify) (t (error "Unknown selection type: %S" type))))) + ;; Most programs are unable to handle NUL bytes in strings. + (setq str (replace-regexp-in-string "\0" "\\0" str t t)) + (setq next-selection-coding-system nil) (cons type str)))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index fda93884c4..be895a040d 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -396,7 +396,7 @@ (declare-function w32-selection-exists-p "w32select.c") ;;; Fix interface to (X-specific) mouse.el (defun w32--set-selection (type value) (if (eq type 'CLIPBOARD) - (w32-set-clipboard-data value) + (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t)) (put 'x-selections (or type 'PRIMARY) value))) (defun w32--get-selection (&optional type data-type) -- 2.11.1 --=-=-=--