[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 4895ca16f7: Ensure that we don't call print-unreadable-function f
From: |
Lars Ingebrigtsen |
Subject: |
master 4895ca16f7: Ensure that we don't call print-unreadable-function from " prin1" |
Date: |
Thu, 28 Jul 2022 06:24:09 -0400 (EDT) |
branch: master
commit 4895ca16f76aa0ec044212a2b96ef8646cf4d0ed
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Ensure that we don't call print-unreadable-function from " prin1"
* src/print.c (PRINTPREPARE): Bind the current buffer so that we
can retrieve it later.
(print_vectorlike): Use it (bug#56773).
(syms_of_print): New internal `print--unreadable-callback-buffer'
variable.
---
src/print.c | 19 +++++++++++++++++++
test/lisp/subr-tests.el | 10 ++++++++++
test/src/print-tests.el | 1 -
3 files changed, 29 insertions(+), 1 deletion(-)
diff --git a/src/print.c b/src/print.c
index 384a639b31..48c945d08a 100644
--- a/src/print.c
+++ b/src/print.c
@@ -105,6 +105,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
= !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
Lisp_Object original = printcharfun;
\
record_unwind_current_buffer (); \
+ specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ()); \
if (NILP (printcharfun)) printcharfun = Qt; \
if (BUFFERP (printcharfun)) \
{ \
@@ -1655,6 +1656,17 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
infinite recursion in the function called. */
Lisp_Object func = Vprint_unreadable_function;
specbind (Qprint_unreadable_function, Qnil);
+
+ /* If we're being called from `prin1-to-string' or the like,
+ we're now in the secret " prin1" buffer. This can lead to
+ problems if, for instance, the callback function switches a
+ window to this buffer -- this will make Emacs segfault. */
+ if (!NILP (Vprint__unreadable_callback_buffer)
+ && Fbuffer_live_p (Vprint__unreadable_callback_buffer))
+ {
+ record_unwind_current_buffer ();
+ set_buffer_internal (XBUFFER (Vprint__unreadable_callback_buffer));
+ }
Lisp_Object result = CALLN (Ffuncall, func, obj,
escapeflag? Qt: Qnil);
unbind_to (count, Qnil);
@@ -2913,6 +2925,13 @@ be printed. */);
Vprint_unreadable_function = Qnil;
DEFSYM (Qprint_unreadable_function, "print-unreadable-function");
+ DEFVAR_LISP ("print--unreadable-callback-buffer",
+ Vprint__unreadable_callback_buffer,
+ doc: /* Dynamically bound to indicate current buffer. */);
+ Vprint__unreadable_callback_buffer = Qnil;
+ DEFSYM (Qprint__unreadable_callback_buffer,
+ "print--unreadable-callback-buffer");
+
defsubr (&Sflush_standard_output);
/* Initialized in print_create_variable_mapping. */
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 20f81d1ddc..1d85631a4b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1122,5 +1122,15 @@ final or penultimate step during initialization."))
(should (equal (butlast l n)
(subr-tests--butlast-ref l n))))))
+(ert-deftest test-print-unreadable-function-buffer ()
+ (with-temp-buffer
+ (let ((current (current-buffer))
+ callback-buffer)
+ (let ((print-unreadable-function
+ (lambda (_object _escape)
+ (setq callback-buffer (current-buffer)))))
+ (prin1-to-string (make-marker)))
+ (should (eq current callback-buffer)))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index f818b4d471..91187d9f45 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -529,6 +529,5 @@ otherwise, use a different charset."
(should (equal (% (- (length numbers) loopback-index) loop)
0)))))))))))
-
(provide 'print-tests)
;;; print-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 4895ca16f7: Ensure that we don't call print-unreadable-function from " prin1",
Lars Ingebrigtsen <=