Avoid extra output in Vprin1_to_string_buffer (bug#78842)

print_error_message can throw after producing some output, so use
unwind-protect to ensure prin1-to-string-buffer is cleared.

* src/print.c (erase_prin1_to_string_buffer): New.
(Ferror_message_string): Use it to catch errors thrown in
'print_error_message'.
* test/src/print-tests.el (error-message-string-circular): Expand
test.
This commit is contained in:
Pip Cet 2025-06-28 09:33:01 +00:00
parent c64b2bf113
commit 6b19eb53c5
2 changed files with 17 additions and 10 deletions

View file

@ -1023,6 +1023,14 @@ debug_format (const char *fmt, Lisp_Object arg)
}
/* Erase the Vprin1_to_string_buffer, potentially switching to it. */
static void
erase_prin1_to_string_buffer (void)
{
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
Ferase_buffer ();
}
DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
1, 1, 0,
doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
@ -1030,9 +1038,6 @@ See Info anchor `(elisp)Definition of signal' for some details on how this
error message is constructed. */)
(Lisp_Object obj)
{
struct buffer *old = current_buffer;
Lisp_Object value;
/* If OBJ is (error STRING), just return STRING.
That is not only faster, it also avoids the need to allocate
space here when the error is due to memory full. */
@ -1042,15 +1047,15 @@ error message is constructed. */)
&& NILP (XCDR (XCDR (obj))))
return XCAR (XCDR (obj));
/* print_error_message can throw after producing some output, in which
case we need to ensure the buffer is cleared again (bug#78842). */
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_current_buffer ();
record_unwind_protect_void (erase_prin1_to_string_buffer);
print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
value = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (old);
return value;
return unbind_to (count, Fbuffer_string ());
}
/* Print an error message for the error DATA onto Lisp output stream

View file

@ -356,7 +356,9 @@ otherwise, use a different charset."
(print-tests--deftest error-message-string-circular ()
(let ((err (list 'error)))
(setcdr err err)
(should-error (error-message-string err) :type 'circular-list)))
(should-error (error-message-string err) :type 'circular-list)
;; check that prin1-to-string-buffer is cleared (bug#78842)
(should (equal "37.0" (prin1-to-string 37.0)))))
(print-tests--deftest print-hash-table-test ()
(should