Fix crash when sending Gnus message (Bug#39207)

* src/alloc.c (resize_string_data): The string must be multibyte.
When not bothering to reallocate, do bother to change the byte count.
* test/src/alloc-tests.el (aset-nbytes-change) New test.

diff --git a/src/alloc.c b/src/alloc.c
index 99d5ca149d54016d58339cf6d698b75949a47947..a35b48cfb22307acebf2235a49e509719d0472a3 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1889,7 +1889,7 @@ allocate_string_data (struct Lisp_String *s,
   tally_consing (needed);
 }
 
-/* Reallocate the data for STRING when a single character is replaced.
+/* Reallocate multibyte STRING data when a single character is replaced.
    The character is at byte offset CIDX_BYTE in the string.
    The character being replaced is CLEN bytes long,
    and the character that will replace it is NEW_CLEN bytes long.
@@ -1900,6 +1900,7 @@ unsigned char *
 resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
                    int clen, int new_clen)
 {
+  eassume (STRING_MULTIBYTE (string));
   sdata *old_sdata = SDATA_OF_STRING (XSTRING (string));
   ptrdiff_t nchars = SCHARS (string);
   ptrdiff_t nbytes = SBYTES (string);
@@ -1911,6 +1912,7 @@ resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
     {
       /* No need to reallocate, as the size change falls within the
         alignment slop.  */
+      XSTRING (string)->u.s.size_byte = new_nbytes;
       new_charaddr = data + cidx_byte;
       memmove (new_charaddr + new_clen, new_charaddr + clen,
               nbytes - (cidx_byte + (clen - 1)));

diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index 4eb776a055544a9e61f88989defa779ef58b5f92..aa1ab1648f8a117b52265e012f9a7c87571c9e79 100644 (file)
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -51,3 +51,10 @@
     (should-not (eq x y))
     (dotimes (i 4)
       (should (eql (aref x i) (aref y i))))))
+
+;; Bug#39207
+(ert-deftest aset-nbytes-change ()
+  (let ((s (make-string 1 ?a)))
+    (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e))
+      (aset s 0 c)
+      (should (equal s (make-string 1 c))))))