GNU bug report logs - #78842
Ferror_message_string sometimes fails to clear prin1-to-string-buffer

Previous Next

To reply to this bug, email your comments to 78842 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Pip Cet <pipcet <at> protonmail.com>
To: bug-gnu-emacs <at> gnu.org
Subject: Ferror_message_string sometimes fails to clear prin1-to-string-buffer
Date: Thu, 19 Jun 2025 20:02:06 +0000

This is a (hopefully) rare bug which happens to be triggered by a rather
exotic test case; see recipe below.

During ordinary operation, Ferror_message_string calls
print_error_message, then grabs the prin1-to-string buffer's contents
and erases it.

Sometimes, however, print_error_message throws an error after writing
some text ("peculiar error: error", in this case) to the buffer.

Currently, Ferror_message_string fails to erase the buffer in this case
(it doesn't catch or unwind-protect anything), so the *next* call to
prin1-to-string will return the "peculiar error: error" string before
the actual output.

This test in print-tests.el:

(print-tests--deftest error-message-string-circular ()
  (let ((err (list 'error)))
    (setcdr err err)
    (should-error (error-message-string err) :type 'circular-list)))

triggers this condition; the next prin1-to-string run after this test
will include the "peculiar error: error" string (twice, in this case,
because print-tests--deftests defines two tests, one for cl-prin1 and
one for prin1; they produce one copy each).

Recipe:

1. emacs -Q -l test/src/print-tests.el
2. M-x ert RET RET

Output:

F print-bignum
    (ert-test-failed
     ((should (equal (print-tests--prin1-to-string val) str)) :form
      (equal
       "peculiar error: errorpeculiar error: error999999999999999999999999999999999"
       "999999999999999999999999999999999")
      :value nil :explanation
      (arrays-of-different-length 75 33
				  "peculiar error: errorpeculiar error: error999999999999999999999999999999999"
				  "999999999999999999999999999999999"
				  first-mismatch-at 0)))

Is this proposed patch okay for master?  While there are additional
specpdl allocations in Ferror_message_string, there are no new
allocations in the (error STRING) case mentioned in the comment.

No changes in print_error_message, which I think is important because we
want that function to produce its output in chunks.

Should we also modify the error-message-string-circular test to check
that a subsequent prin1-to-string doesn't produce extra output?

From c317ec081667d8a53647fa6844880cc00d26b50a Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet <at> protonmail.com>
Subject: [PATCH] Avoid extra output in Vprin1_to_string_buffer

* src/print.c (erase_prin1_to_string_buffer): New.
(Ferror_message_string): Catch errors thrown in 'print_error_message'.
---
 src/print.c | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/print.c b/src/print.c
index b6ee89478c7..fdb8cc8863c 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 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
 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,13 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
+  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
-- 
2.48.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.