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

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

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

Hi Eli,

> Thanks, but could you please show the minimal change required to 
fix
> just the particular problem with this scenario

I've attached a new self-contained patch based on yours,
thank you for coming up with it.

In my opinion, one of the problems is really as you said
that len_mid (length in bytes)
is uses where length of characters is expected.
The patch contains an additional such case,
and replaces (start1 + len1) in your patch with the equivalent
but shorter end1.

The other problem is that the branch len1_byte == len2_byte
assumes len1 == len2 in several places:
undo records, positions after the transposition,
and the least obvious one is that even intervals between the 
region seem to need adjustment of positions.
(I don't know enough of intervals to understand it, but had failed 
tests with text properties at wrong places.)

Anyway, I've just added len1 == len2 as a condition to that branch
with comments where I think the assumption is used.
I've also added a new test for this case.

> The patch
> below passes both your test and the already-existing tests in
> test/src/editfns-tests.el.

For me after applying your patch, the tests crashed.
The crash message was hidden in the end of the output:

   passed  21/24  transpose-nonascii-regions-test-1 (0.000067 sec)
   passed  22/24  transpose-nonascii-regions-test-2 (0.000068 sec)
   passed  23/24  transpose-regions-text-properties (0.000074 sec)
Undo
Undo
make[1]: *** [Makefile:181: src/editfns-tests.log] segmentation 
fault
make[1]: Leaving directory "/home/gabor/src/build/emacs-29.3/test"
make: *** [Makefile:247: src/editfns-tests] Error 2


With the tests I intended to test all the branches in the code
where the regions don't touch each other, catching mistakes
where the wrong length is used.
I hoped that byte length is not system dependent,
it seems I have been mistaken, and the tests still need
improvement to be thorough on all systems.

So what differences exist or byte length?

Best wishes,

	Gábor

[-- Attachment #2: 0001-transpose-regions-fix-wrong-lengths-add-missing-cond.patch --]
[-- Type: text/x-patch, Size: 8365 bytes --]

From 5a0cf2542388104cde444b2130d994ee36ce5392 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; add missing condition.

Case len1_byte == len2_byte:
  The code assumes len1 == len2 at several places, see comments.
  As a fix, add that condition to the case.
  (This case is not strictly necessary, as the other
  cases cover it, so restricting the case should be no problem.)

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

diff --git a/src/editfns.c b/src/editfns.c
index 85f7739df07..65570a84472 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4655,12 +4655,13 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
     {
       len_mid = start2_byte - (start1_byte + len1_byte);
 
-      if (len1_byte == len2_byte)
+      if (len1_byte == len2_byte && len1 == len2)
 	/* Regions are same size, though, how nice.  */
         {
 	  USE_SAFE_ALLOCA;
 
           modify_text (start1, end2);
+	  /* The undo records are only correct for len1 == len2. */
           record_change (start1, len1);
           record_change (start2, len2);
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
@@ -4682,10 +4683,14 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5,
           memcpy (start2_addr, temp, len1_byte);
 	  SAFE_FREE ();
 
+	  /* In the following line start2 is only correct for
+	     len1 == len2.  Otherwise it should be end2 - len1. */
           graft_intervals_into_buffer (tmp_interval1, start2,
                                        len1, current_buffer, 0);
           graft_intervals_into_buffer (tmp_interval2, start1,
                                        len2, current_buffer, 0);
+	  /* The intervals between end1 and start2 need no adjustment
+	     only because len1 == len2. */
         }
 
       else if (len1_byte < len2_byte)	/* Second region larger than first */
@@ -4696,7 +4701,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 +4722,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 +4736,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 +4757,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