GC-mark temporary key values created when sorting (bug#69709)

Bug reported and fix proposed by Aris Spathis.

* src/sort.c (merge_markmem): Mark heap-allocated temporary key values.
(tim_sort): Delay key function calls to after marking function has been
registered.
* test/src/fns-tests.el (fns-tests-sort-gc): New test.

(cherry picked from commit 3d3602055264ca3095b7f28ca7e27a6f2782649a)

diff --git a/src/sort.c b/src/sort.c
index 527d55503420f128a40a689700ac2dbeab95243a..808cd187dcf5f04905f4bf43a43945bb8e38a84e 100644 (file)
--- a/src/sort.c
+++ b/src/sort.c
@@ -532,6 +532,9 @@ merge_markmem (void *arg)
   merge_state *ms = arg;
   eassume (ms != NULL);
 
+  if (ms->allocated_keys != NULL)
+    mark_objects (ms->allocated_keys, ms->listlen);
+
   if (ms->reloc.size != NULL && *ms->reloc.size > 0)
     {
       Lisp_Object *src = (ms->reloc.src->values
@@ -1107,21 +1110,29 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
       if (length < MERGESTATE_TEMP_SIZE / 2)
        keys = &ms.temparray[length + 1];
       else
-       keys = allocated_keys = xmalloc (length * word_size);
-
-      for (ptrdiff_t i = 0; i < length; i++)
-       keys[i] = call1 (keyfunc, seq[i]);
+       {
+         /* Fill with valid Lisp values in case a GC occurs before all
+            keys have been computed.  */
+         verify (NIL_IS_ZERO);
+         keys = allocated_keys = xzalloc (length * word_size);
+       }
 
       lo.keys = keys;
       lo.values = seq;
     }
 
+  merge_init (&ms, length, allocated_keys, &lo, predicate);
+
+  /* Compute keys after merge_markmem has been registered by merge_init
+     (any call to keyfunc might trigger a GC).  */
+  if (!NILP (keyfunc))
+    for (ptrdiff_t i = 0; i < length; i++)
+      keys[i] = call1 (keyfunc, seq[i]);
+
   /* FIXME: This is where we would check the keys for interesting
      properties for more optimised comparison (such as all being fixnums
      etc).  */
 
-  merge_init (&ms, length, allocated_keys, &lo, predicate);
-
   /* March over the array once, left to right, finding natural runs,
      and extending short natural runs to minrun elements.  */
   const ptrdiff_t minrun = merge_compute_minrun (length);

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 4536816dc8925c683a891446eaf1003855c792a4..068daf893f13e062776f5f42c261aaad436df112 100644 (file)
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -418,6 +418,27 @@
                     (should-not (and (> size 0) (eq res seq)))
                     (should (equal seq input))))))))))))
 
+(ert-deftest fns-tests-sort-gc ()
+  ;; Make sure our temporary storage is traversed by the GC.
+  (let* ((n 1000)
+         (a (mapcar #'number-to-string (number-sequence 1 n)))
+         (i 0)
+         ;; Force frequent GCs in both the :key and :lessp functions.
+         (s (sort a
+                  :key (lambda (x)
+                         (setq i (1+ i))
+                         (when (> i 300)
+                           (garbage-collect)
+                           (setq i 0))
+                         (copy-sequence x))
+                  :lessp (lambda (a b)
+                           (setq i (1+ i))
+                           (when (> i 300)
+                             (garbage-collect)
+                             (setq i 0))
+                           (string< a b)))))
+    (should (equal (length s) (length a)))))
+
 (defvar w32-collate-ignore-punctuation)
 
 (ert-deftest fns-tests-collate-sort ()