mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

Ensure that we don't call print-unreadable-function from " prin1"

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2022-07-28 12:23:53 +02:00
parent 22a5f02234
commit 4895ca16f7
3 changed files with 29 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/print.c
View file

@ -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. */

10
test/lisp/subr-tests.el
View file

@ -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

1
test/src/print-tests.el
View file

@ -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