GNU bug report logs - #78590
31.0.50; print_object calls strout unsafely

Previous Next

Full log

View this message in rfc822 format

From: Pip Cet <pipcet <at> protonmail.com>
To: 78590 <at> debbugs.gnu.org
Subject: bug#78590: 31.0.50; print_object calls strout unsafely
Date: Mon, 26 May 2025 18:00:28 +0000

Pip Cet <pipcet <at> protonmail.com> writes:

> It's probably not worth it to come up with a complicated fix here: let's
> just use SAFE_ALLOCA_STRING, and add a comment explaining the reasons
> (GC, Lisp code modifying the string that is being printed).

OK for master?

From a8f2d405f704bbff8014cf82c7c82f4d3f85fc40 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet <at> protonmail.com>
Subject: [PATCH] Fix unsafe SDATA usage in print.c (bug#78590)

* src/print.c (print_object): Avoid unsafe SDATA usage;
create a copy of the string instead.
* test/src/print-tests.el (test-print-number-realloc):
New test.
---
 src/print.c             |  9 ++++++++-
 test/src/print-tests.el | 18 ++++++++++++++++++
 2 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/src/print.c b/src/print.c
index b17ec337f70..0c7a630702c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2282,7 +2282,14 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	}
       else if (STRINGP (num))
 	{
-	  strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun);
+	  /* Use a local copy of the string, to guard against GC
+	   * relocation and Lisp code modifying the string being
+	   * printed.  */
+	  char *ptr;
+	  USE_SAFE_ALLOCA;
+	  SAFE_ALLOCA_STRING (ptr, num);
+	  strout (ptr, SCHARS (num), SBYTES (num), printcharfun);
+	  SAFE_FREE ();
 	  goto next_obj;
 	}
     }
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index af57311135b..036248fd091 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -540,5 +540,23 @@ test-print-unreadable-function-buffer
       (should (eq callback-buffer buffer))
       (should (equal str "tata"))))
 
+(ert-deftest test-print-number-realloc ()
+  ;; Test for bug#78590.  Note that this may in rare cases crash unfixed
+  ;; Emacs versions.
+  (let ((print-circle t)
+        (print-number-table (make-hash-table))
+        (print-continuous-numbering t)
+        (str "yy")
+        (outstr ""))
+    (garbage-collect)
+    (ignore (make-string 100 ?a))
+    (puthash str (make-string 3 ?x) print-number-table)
+    (prin1 str
+           (lambda (c)
+             (setq outstr (concat outstr (string c)))
+             (garbage-collect)
+             (ignore (make-string 100 ?b))))
+    (should (equal outstr "xxx"))))
+
 (provide 'print-tests)
 ;;; print-tests.el ends here
-- 
2.48.1

Previous Next

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