Subject: bug#75754: styled_format stack usage/GC protection

From: Pip Cet <[email-masked]>
Date: Wed, 22 Jan 2025 19:39:35 +0000

Pip Cet <[email-masked]> writes:

> (setq print-unreadable-function
>       (lambda (&rest args)
>         (garbage-collect)
>         (make-string 100 256 t)))
>
> (message "%S" (format "%S %S" [1] (symbol-function '+)))
>
> fails to print the initial "[1]" here. Changing 256 to ?A and t to nil
> produces
>
> "[1] AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
>
> GDB session confirms the bug is as I've described.

Patch:

>From caa546d3df5e6a23d36d6d60834da655bf407ba4 Mon Sep 17 00:00:00 2001
From: Pip Cet <[email-masked]>
Subject: [PATCH] Fix GC bug causing incorrect 'format' output (Bug#75754)

This fixes the correctness bug discovered in bug#75754, but not the
performance issue or excessive stack usage.

* src/editfns.c (styled_format): Allocate Lisp_Object array using
SAFE_ALLOCA_LISP, not SAFE_ALLOCA.
---
 src/editfns.c | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/editfns.c b/src/editfns.c
index 8a5fb673fe7..fa138061105 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3431,10 +3431,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
   /* Information recorded for each format spec.  */
   struct info
   {
-    /* The corresponding argument, converted to string if conversion
-       was needed.  */
-    Lisp_Object argument;
-
     /* The start and end bytepos in the output string.  */
     ptrdiff_t start, end;
 
@@ -3461,6 +3457,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
       || SIZE_MAX < alloca_size)
     memory_full (SIZE_MAX);
   info = SAFE_ALLOCA (alloca_size);
+  /* Ose argument belonging to each spec, but needs to be allocated
+     separately so GC doesn't free the strings (bug#75754).  */
+  Lisp_Object *spec_arguments;
+  SAFE_ALLOCA_LISP (spec_arguments, nspec_bound);
   /* discarded[I] is 1 if byte I of the format
      string was not copied into the output.
      It is 2 if byte I was not the first byte of its character.  */
@@ -3610,14 +3610,15 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 	  if (! (n < nargs))
 	    error ("Not enough arguments for format string");
 
-	  struct info *spec = &info[ispec++];
+	  ptrdiff_t spec_index = ispec++;
+	  struct info *spec = &info[spec_index];
 	  if (nspec < ispec)
 	    {
-	      spec->argument = args[n];
+	      spec_arguments[spec_index] = args[n];
 	      spec->intervals = false;
 	      nspec = ispec;
 	    }
-	  Lisp_Object arg = spec->argument;
+	  Lisp_Object arg = spec_arguments[spec_index];
 
 	  /* For 'S', prin1 the argument, and then treat like 's'.
 	     For 's', princ any argument that is not a string or
@@ -3630,7 +3631,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 	      if (EQ (arg, args[n]))
 		{
 		  Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
-		  spec->argument = arg = Fprin1_to_string (arg, noescape, Qnil);
+		  spec_arguments[spec_index] = arg = Fprin1_to_string (arg, noescape, Qnil);
 		  if (STRING_MULTIBYTE (arg) && ! multibyte)
 		    {
 		      multibyte = true;
@@ -3648,7 +3649,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 		      multibyte = true;
 		      goto retry;
 		    }
-		  spec->argument = arg = Fchar_to_string (arg);
+		  spec_arguments[spec_index] = arg = Fchar_to_string (arg);
 		}
 
 	      if (!EQ (arg, args[n]))
@@ -3658,7 +3659,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 
 	  if (SYMBOLP (arg))
 	    {
-	      spec->argument = arg = SYMBOL_NAME (arg);
+	      spec_arguments[spec_index] = arg = SYMBOL_NAME (arg);
 	      if (STRING_MULTIBYTE (arg) && ! multibyte)
 		{
 		  multibyte = true;
@@ -4303,9 +4304,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 	for (ptrdiff_t i = 0; i < nspec; i++)
 	  if (info[i].intervals)
 	    {
-	      len = make_fixnum (SCHARS (info[i].argument));
+	      len = make_fixnum (SCHARS (spec_arguments[i]));
 	      Lisp_Object new_len = make_fixnum (info[i].end - info[i].start);
-	      props = text_property_list (info[i].argument,
+	      props = text_property_list (spec_arguments[i],
                                           make_fixnum (0), len, Qnil);
 	      props = extend_property_ranges (props, len, new_len);
 	      /* If successive arguments have properties, be sure that
-- 
2.47.1