mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
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:
parent
c64b2bf113
commit
6b19eb53c5
2 changed files with 17 additions and 10 deletions
23
src/print.c
23
src/print.c
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue