* bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated
@ 2018-05-22 19:56 Gemini Lasswell
2018-05-22 23:52 ` Noam Postavsky
0 siblings, 1 reply; 5+ messages in thread
From: Gemini Lasswell @ 2018-05-22 19:56 UTC (permalink / raw
To: 31559
[-- Attachment #1: Type: text/plain, Size: 1198 bytes --]
In Emacs 25, the backtraces produced by debug.el and ert.el
abbreviated long lists and deeply nested forms with "...". This
doesn't happen in Emacs 26.
To reproduce, evaluate these lines of code:
(defun my-func (arg) arg)
(debug-on-entry 'my-func)
(my-func (make-list 100 'a))
Result: An ellipsis appears in the list in the backtrace in
Emacs 25, and the entire list is printed in Emacs 26.
Edebug's backtraces still have ellipses, but its printing of
evaluation results no longer shows them.
The reason this is happening is that the printing of backtraces by the
debugger was switched to use cl-prin1 by the fix to bug#6991.
Edebug's results printing was switched to cl-prin1 when CL printing
was added to Emacs but its backtrace printing was left as before.
edebug.el, debug.el and ert.el all bind print-level and print-length
before printing backtraces, but CL printing does not pay any attention
to those variables, in spite of cl-prin1's docstring which says
that it does.
Here is a patch that makes cl-prin1 behave like prin1 with respect to
print-level and print-length, except for hash tables (because prin1
prints hash table items and cl-prin1 doesn't, although maybe it
should).
[-- Attachment #2: 0001-Make-CL-printing-respect-print-level-and-print-lengt.patch --]
[-- Type: text/plain, Size: 8890 bytes --]
From b9983ac73df07a5fe78760418fb3fa487b75681e Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Mon, 21 May 2018 18:05:55 -0700
Subject: [PATCH] Make CL printing respect print-level and print-length
* lisp/emacs-lisp/cl-print.el (cl-print--depth): New variable.
(cl-print-object) <cons>: Print ellipsis if printing depth greater
than 'print-level' or length of list greater than 'print-length'.
(cl-print-object) <vector>: Truncate printing with ellipsis if
vector is longer than 'print-length'.
(cl-print-object) <cl-structure-object>: Truncate printing with
ellipsis if strucure has more slots than 'print-length'.
(cl-print-object) <:around>: Bind 'cl-print--depth'.
* test/lisp/emacs-lisp/cl-print-tests.el
(cl-print-tests-3, cl-print-tests-4): New tests.
---
lisp/emacs-lisp/cl-print.el | 115 +++++++++++++++++++--------------
test/lisp/emacs-lisp/cl-print-tests.el | 25 +++++++
2 files changed, 93 insertions(+), 47 deletions(-)
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index ada5923515..55e2bf8bd4 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -40,6 +40,10 @@ cl-print-readably
(defvar cl-print--number-table nil)
(defvar cl-print--currently-printing nil)
+(defvar cl-print--depth nil
+ "Depth of recursion within cl-print functions.
+Compared to `print-level' to determine when to stop recursing.")
+
;;;###autoload
(cl-defgeneric cl-print-object (object stream)
@@ -52,33 +56,45 @@ cl-print--currently-printing
(prin1 object stream))
(cl-defmethod cl-print-object ((object cons) stream)
- (let ((car (pop object)))
- (if (and (memq car '(\, quote \` \,@ \,.))
- (consp object)
- (null (cdr object)))
- (progn
- (princ (if (eq car 'quote) '\' car) stream)
- (cl-print-object (car object) stream))
- (princ "(" stream)
- (cl-print-object car stream)
- (while (and (consp object)
- (not (cond
- (cl-print--number-table
- (numberp (gethash object cl-print--number-table)))
- ((memq object cl-print--currently-printing))
- (t (push object cl-print--currently-printing)
- nil))))
- (princ " " stream)
- (cl-print-object (pop object) stream))
- (when object
- (princ " . " stream) (cl-print-object object stream))
- (princ ")" stream))))
+ (if (and cl-print--depth (natnump print-level)
+ (> cl-print--depth print-level))
+ (princ "..." stream)
+ (let ((car (pop object))
+ (count 1))
+ (if (and (memq car '(\, quote \` \,@ \,.))
+ (consp object)
+ (null (cdr object)))
+ (progn
+ (princ (if (eq car 'quote) '\' car) stream)
+ (cl-print-object (car object) stream))
+ (princ "(" stream)
+ (cl-print-object car stream)
+ (while (and (consp object)
+ (not (cond
+ (cl-print--number-table
+ (numberp (gethash object cl-print--number-table)))
+ ((memq object cl-print--currently-printing))
+ (t (push object cl-print--currently-printing)
+ nil))))
+ (princ " " stream)
+ (if (or (not (natnump print-length)) (> print-length count))
+ (cl-print-object (pop object) stream)
+ (princ "..." stream)
+ (setq object nil))
+ (cl-incf count))
+ (when object
+ (princ " . " stream) (cl-print-object object stream))
+ (princ ")" stream)))))
(cl-defmethod cl-print-object ((object vector) stream)
(princ "[" stream)
- (dotimes (i (length object))
- (unless (zerop i) (princ " " stream))
- (cl-print-object (aref object i) stream))
+ (let ((count (length object)))
+ (dotimes (i (if (natnump print-length)
+ (min print-length count) count))
+ (unless (zerop i) (princ " " stream))
+ (cl-print-object (aref object i) stream))
+ (when (and (natnump print-length) (< print-length count))
+ (princ " ..." stream)))
(princ "]" stream))
(cl-defmethod cl-print-object ((object hash-table) stream)
@@ -180,14 +196,18 @@ cl-print-compiled-button
(cl-defmethod cl-print-object ((object cl-structure-object) stream)
(princ "#s(" stream)
(let* ((class (cl-find-class (type-of object)))
- (slots (cl--struct-class-slots class)))
+ (slots (cl--struct-class-slots class))
+ (count (length slots)))
(princ (cl--struct-class-name class) stream)
- (dotimes (i (length slots))
+ (dotimes (i (if (natnump print-length)
+ (min print-length count) count))
(let ((slot (aref slots i)))
(princ " :" stream)
(princ (cl--slot-descriptor-name slot) stream)
(princ " " stream)
- (cl-print-object (aref object (1+ i)) stream))))
+ (cl-print-object (aref object (1+ i)) stream)))
+ (when (and (natnump print-length) (< print-length count))
+ (princ " ..." stream)))
(princ ")" stream))
;;; Circularity and sharing.
@@ -198,26 +218,27 @@ cl-print-compiled-button
(cl-defmethod cl-print-object :around (object stream)
;; FIXME: Only put such an :around method on types where it's relevant.
- (cond
- (print-circle
- (let ((n (gethash object cl-print--number-table)))
- (if (not (numberp n))
- (cl-call-next-method)
- (if (> n 0)
- ;; Already printed. Just print a reference.
- (progn (princ "#" stream) (princ n stream) (princ "#" stream))
- (puthash object (- n) cl-print--number-table)
- (princ "#" stream) (princ (- n) stream) (princ "=" stream)
- (cl-call-next-method)))))
- ((let ((already-printing (memq object cl-print--currently-printing)))
- (when already-printing
- ;; Currently printing, just print reference to avoid endless
- ;; recursion.
- (princ "#" stream)
- (princ (length (cdr already-printing)) stream))))
- (t (let ((cl-print--currently-printing
- (cons object cl-print--currently-printing)))
- (cl-call-next-method)))))
+ (let ((cl-print--depth (if cl-print--depth (1+ cl-print--depth) 1)))
+ (cond
+ (print-circle
+ (let ((n (gethash object cl-print--number-table)))
+ (if (not (numberp n))
+ (cl-call-next-method)
+ (if (> n 0)
+ ;; Already printed. Just print a reference.
+ (progn (princ "#" stream) (princ n stream) (princ "#" stream))
+ (puthash object (- n) cl-print--number-table)
+ (princ "#" stream) (princ (- n) stream) (princ "=" stream)
+ (cl-call-next-method)))))
+ ((let ((already-printing (memq object cl-print--currently-printing)))
+ (when already-printing
+ ;; Currently printing, just print reference to avoid endless
+ ;; recursion.
+ (princ "#" stream)
+ (princ (length (cdr already-printing)) stream))))
+ (t (let ((cl-print--currently-printing
+ (cons object cl-print--currently-printing)))
+ (cl-call-next-method))))))
(defvar cl-print--number-index nil)
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index d986c4015d..bfce4a16ce 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -47,6 +47,31 @@
"\\`(#1=#s(foo 1 2 3) #1#)\\'"
(cl-prin1-to-string (list x x)))))))
+(cl-defstruct (cl-print-tests-struct
+ (:constructor cl-print-tests-con))
+ a b c d e)
+
+(ert-deftest cl-print-tests-3 ()
+ "CL printing observes `print-length'."
+ (let ((long-list (make-list 5 'a))
+ (long-vec (make-vector 5 'b))
+ (long-struct (cl-print-tests-con))
+ (print-length 4))
+ (should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
+ (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
+ (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
+ (cl-prin1-to-string long-struct)))))
+
+(ert-deftest cl-print-tests-4 ()
+ "CL printing observes `print-level'."
+ (let ((deep-list '(a (b (c (d (e))))))
+ (deep-struct (cl-print-tests-con))
+ (print-level 4))
+ (setf (cl-print-tests-struct-a deep-struct) deep-list)
+ (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
+ (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
+ (cl-prin1-to-string deep-struct)))))
+
(ert-deftest cl-print-circle ()
(let ((x '(#1=(a . #1#) #1#)))
(let ((print-circle nil))
--
2.16.2
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated
2018-05-22 19:56 bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated Gemini Lasswell
@ 2018-05-22 23:52 ` Noam Postavsky
2018-05-23 15:10 ` Eli Zaretskii
0 siblings, 1 reply; 5+ messages in thread
From: Noam Postavsky @ 2018-05-22 23:52 UTC (permalink / raw
To: Gemini Lasswell; +Cc: 31559
Gemini Lasswell <gazally@runbox.com> writes:
> In Emacs 25, the backtraces produced by debug.el and ert.el
> abbreviated long lists and deeply nested forms with "...". This
> doesn't happen in Emacs 26.
Oh, I've had the impression that backtrace printing was a bit slow
sometimes, and this is probably why.
> Here is a patch that makes cl-prin1 behave like prin1 with respect to
> print-level and print-length, except for hash tables (because prin1
> prints hash table items and cl-prin1 doesn't, although maybe it
> should).
Looks good to me, unfortunately it's probably a bit too late for 26.1
though.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated
2018-05-22 23:52 ` Noam Postavsky
@ 2018-05-23 15:10 ` Eli Zaretskii
2018-06-04 9:41 ` Noam Postavsky
0 siblings, 1 reply; 5+ messages in thread
From: Eli Zaretskii @ 2018-05-23 15:10 UTC (permalink / raw
To: Noam Postavsky; +Cc: 31559, gazally
> From: Noam Postavsky <npostavs@gmail.com>
> Date: Tue, 22 May 2018 19:52:40 -0400
> Cc: 31559@debbugs.gnu.org
>
> > Here is a patch that makes cl-prin1 behave like prin1 with respect to
> > print-level and print-length, except for hash tables (because prin1
> > prints hash table items and cl-prin1 doesn't, although maybe it
> > should).
>
> Looks good to me, unfortunately it's probably a bit too late for 26.1
> though.
Yes, unfortunately.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated
2018-05-23 15:10 ` Eli Zaretskii
@ 2018-06-04 9:41 ` Noam Postavsky
2018-06-04 16:05 ` Gemini Lasswell
0 siblings, 1 reply; 5+ messages in thread
From: Noam Postavsky @ 2018-06-04 9:41 UTC (permalink / raw
To: Eli Zaretskii; +Cc: 31559, gazally
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Noam Postavsky <npostavs@gmail.com>
>> Date: Tue, 22 May 2018 19:52:40 -0400
>> Cc: 31559@debbugs.gnu.org
>>
>> > Here is a patch that makes cl-prin1 behave like prin1 with respect to
>> > print-level and print-length, except for hash tables (because prin1
>> > prints hash table items and cl-prin1 doesn't, although maybe it
>> > should).
>>
>> Looks good to me, unfortunately it's probably a bit too late for 26.1
>> though.
>
> Yes, unfortunately.
But I'd say it's worth backporting to 26.2.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2018-06-04 16:05 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-05-22 19:56 bug#31559: 26.1; Debugger and ERT backtraces are not abbreviated Gemini Lasswell
2018-05-22 23:52 ` Noam Postavsky
2018-05-23 15:10 ` Eli Zaretskii
2018-06-04 9:41 ` Noam Postavsky
2018-06-04 16:05 ` Gemini Lasswell
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.