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.

2 files changed, 17 insertions, 10 deletions

diff --git a/src/print.c b/src/print.c
index b6ee89478c7..138a21f18ab 100644
--- a/src/print.c
+++ b/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
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 036248fd091..ce8c095d496 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -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