bug#70122: 29.3.50; transpose-regions can crash Emacs

["Braun Gábor" <braungb88@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 120 bytes --]

Hi,

Sorry, I've forgotten to attach the new version of the patch
in the previous email.

Best wishes,

	Gábor

[-- Attachment #2: 0001-transpose-regions-fix-wrong-lengths-and-case-of-equa.patch --]
[-- Type: text/x-patch, Size: 9185 bytes --]

From fd7f6b9c63f3989863dc789e76fc1dd85f0ab630 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?G=C3=A1bor=20Braun?= <gabor.braun@uni-duisburg-essen.de>
Date: Wed, 3 Apr 2024 20:03:40 +0200
Subject: [PATCH] transpose-regions: fix wrong lengths and case of equal
 length.

Case len1_byte == len2_byte:
  Adjust everything assuming len1 == len2:
  1. Adjust intervals even between the two regions,
     as positions may change.
  2. undo entries: make a simple replacement change as in the other
     branches instead of separately on the two regions.
     This is to work around
     set_text_properties_1 and
     graft_intervals_into_buffer
     recording text property changes in undo history
     (which is unwanted here).
  3. Adjust positions and position differences which rely
     on len1 == len2.

Replace len_mid with end1 - start2 where number of characters
is expected instead of number of bytes.
---
 src/editfns.c             | 35 ++++++++++-------
 test/src/editfns-tests.el | 79 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 100 insertions(+), 14 deletions(-)

diff --git a/src/editfns.c b/src/editfns.c
index 85f7739df07..dd174e8dfcd 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4661,18 +4661,18 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
 	  USE_SAFE_ALLOCA;
 
           modify_text (start1, end2);
-          record_change (start1, len1);
-          record_change (start2, len2);
+	  record_change (start1, (end2 - start1));
+
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
-          tmp_interval2 = copy_intervals (cur_intv, start2, len2);
+	  /* Intervals in-between need adjustment unless len1 == len2.
+	   */
+	  tmp_interval_mid = copy_intervals (cur_intv, end1,
+					     start2 - end1);
+	  tmp_interval2 = copy_intervals (cur_intv, start2, len2);
 
-	  tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0);
+	  tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
 	  if (tmp_interval3)
-	    set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3);
-
-	  tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0);
-	  if (tmp_interval3)
-	    set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3);
+	    set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
 
 	  temp = SAFE_ALLOCA (len1_byte);
 	  start1_addr = BYTE_POS_ADDR (start1_byte);
@@ -4682,8 +4682,11 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           memcpy (start2_addr, temp, len1_byte);
 	  SAFE_FREE ();
 
-          graft_intervals_into_buffer (tmp_interval1, start2,
+	  graft_intervals_into_buffer (tmp_interval1, end2 - len1,
                                        len1, current_buffer, 0);
+	  graft_intervals_into_buffer (tmp_interval_mid, start1 + len2,
+				       start2 - end1,
+				       current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval2, start1,
                                        len2, current_buffer, 0);
         }
@@ -4696,7 +4699,8 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           modify_text (start1, end2);
           record_change (start1, (end2 - start1));
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
-          tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);
+	  tmp_interval_mid = copy_intervals (cur_intv, end1,
+					     start2 - end1);
           tmp_interval2 = copy_intervals (cur_intv, start2, len2);
 
 	  tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
@@ -4716,7 +4720,8 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           graft_intervals_into_buffer (tmp_interval1, end2 - len1,
                                        len1, current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval_mid, start1 + len2,
-                                       len_mid, current_buffer, 0);
+				       start2 - end1,
+				       current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval2, start1,
                                        len2, current_buffer, 0);
         }
@@ -4729,7 +4734,8 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           modify_text (start1, end2);
 
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
-          tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);
+	  tmp_interval_mid = copy_intervals (cur_intv, end1,
+					     start2 - end1);
           tmp_interval2 = copy_intervals (cur_intv, start2, len2);
 
 	  tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
@@ -4749,7 +4755,8 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           graft_intervals_into_buffer (tmp_interval1, end2 - len1,
                                        len1, current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval_mid, start1 + len2,
-                                       len_mid, current_buffer, 0);
+				       start2 - end1,
+				       current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval2, start1,
                                        len2, current_buffer, 0);
         }
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index b3b7da65ad3..7c3e3837c8c 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -132,6 +132,85 @@ propertize/error-even-number-of-args
   "Number of args for `propertize' must be odd."
   (should-error (propertize "foo" 'bar) :type 'wrong-number-of-arguments))
 
+;; Tests for `transpose-region'
+
+(ert-deftest transpose-regions-text-properties-2 ()
+  "Test `transpose-regions' thoroughly with text properties."
+  (let* ((string1pre (propertize "a\x2013" :test 1))
+         (middle (propertize "c\x00e9h" :test 0))
+         (string2 (propertize "\x25cf\x25cb" :test 2))
+         (bytes1 (string-bytes string1pre))
+         (bytes2 (string-bytes string2)))
+    ;; (cl-assert (< bytes1 bytes2))
+    (dotimes (i (+ 3 (- bytes2 bytes1)))
+      (let ((string1 (concat string1pre
+                             (propertize (make-string i ?X)
+                                         :test t))))
+        (with-temp-buffer
+          (insert string1 middle string2)
+          (buffer-enable-undo)
+          (transpose-regions
+           1 (1+ (length string1))
+           (- (point) (length string2)) (point))
+          (should (equal-including-properties
+                   (buffer-string)
+                   (concat string2 middle string1)))
+          (undo-boundary)
+          (let ((this-command #'undo)
+                (last-command #'ert)) ; anything but undo
+            (undo))
+          (should (equal-including-properties
+                   (buffer-string)
+                   (concat string1 middle string2))))))))
+
+(ert-deftest transpose-regions-text-properties ()
+  "Test `transpose-regions' with text properties.
+This test is known to crash Emacs 28.2, 29.2, 29.3."
+  (with-temp-buffer
+    (insert (propertize "a" 'face 'font-lock-variable-name-face))
+    (insert ":\n")
+    (insert (propertize "b" 'face 'font-lock-variable-name-face))
+    (insert ": \x2113\x2080\n")
+    (insert (propertize "v" 'face 'font-lock-variable-name-face))
+    (insert ": scaling\n")
+    ;; Move last line to the beginning
+    (transpose-regions 1 1 10 21)
+    (should (equal-including-properties
+             (buffer-string)
+             (concat
+              (propertize "v" 'face 'font-lock-variable-name-face)
+              ": scaling\n"
+              (propertize "a" 'face 'font-lock-variable-name-face)
+              ":\n"
+              (propertize "b" 'face 'font-lock-variable-name-face)
+              ": \x2113\x2080\n")))))
+
+(ert-deftest transpose-regions-equal-size ()
+  "Test `transpose-regions' on regions equal-size regions.
+Both the number of characters and bytes are equal of the transposed
+regions."
+  (let* ((string1 (propertize "a\x2013\ bc" :test 1))
+         (middle (propertize "RŐT" :test 0))
+         (string2 (propertize "f\x2013nd" :test 2)))
+    (cl-assert (= (length string1) (length string2)))
+    (cl-assert (= (string-bytes string1) (string-bytes string2)))
+    (with-temp-buffer
+      (insert string1 middle string2)
+      (buffer-enable-undo)
+      (transpose-regions
+       1 (1+ (length string1))
+       (- (point) (length string2)) (point))
+      (should (equal-including-properties
+               (buffer-string)
+               (concat string2 middle string1)))
+      (undo-boundary)
+      (let ((this-command #'undo)
+            (last-command #'ert)) ; anything but undo
+        (undo))
+      (should (equal-including-properties
+               (buffer-string)
+               (concat string1 middle string2))))))
+
 ;; Tests for bug#5131.
 (defun transpose-test-reverse-word (start end)
   "Reverse characters in a word by transposing pairs of characters."
-- 
2.39.2