Fix (mapcar F S) crash when F alters S’s length

* src/fns.c (mapcar1): Return number of elements computed,
which can be less than LENI if the function alters the list.
All callers changed.  (Bug#24118)

1 files changed, 30 insertions, 47 deletions

diff --git a/src/fns.c b/src/fns.c
index c318608e4ce..3895ada325d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2517,11 +2517,13 @@ usage: (nconc &rest LISTS)  */)
 }
 
 /* This is the guts of all mapping functions.
- Apply FN to each element of SEQ, one by one,
- storing the results into elements of VALS, a C vector of Lisp_Objects.
- LENI is the length of VALS, which should also be the length of SEQ.  */
+   Apply FN to each element of SEQ, one by one, storing the results
+   into elements of VALS, a C vector of Lisp_Objects.  LENI is the
+   length of VALS, which should also be the length of SEQ.  Return the
+   number of results; although this is normally LENI, it can be less
+   if SEQ is made shorter as a side effect of FN.  */
 
-static void
+static EMACS_INT
 mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
 {
   Lisp_Object tail, dummy;
@@ -2564,14 +2566,18 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
   else   /* Must be a list, since Flength did not get an error */
     {
       tail = seq;
-      for (i = 0; i < leni && CONSP (tail); i++)
+      for (i = 0; i < leni; i++)
         {
+          if (! CONSP (tail))
+            return i;
           dummy = call1 (fn, XCAR (tail));
           if (vals)
             vals[i] = dummy;
           tail = XCDR (tail);
         }
     }
+
+  return leni;
 }
 
 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
@@ -2581,34 +2587,26 @@ SEPARATOR results in spaces between the values returned by FUNCTION.
 SEQUENCE may be a list, a vector, a bool-vector, or a string.  */)
   (Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
 {
-  Lisp_Object len;
-  EMACS_INT leni;
-  EMACS_INT nargs;
-  ptrdiff_t i;
-  Lisp_Object *args;
-  Lisp_Object ret;
   USE_SAFE_ALLOCA;
-
-  len = Flength (sequence);
+  EMACS_INT leni = XFASTINT (Flength (sequence));
   if (CHAR_TABLE_P (sequence))
     wrong_type_argument (Qlistp, sequence);
-  leni = XINT (len);
-  nargs = leni + leni - 1;
-  if (nargs < 0) return empty_unibyte_string;
-
-  SAFE_ALLOCA_LISP (args, nargs);
-
-  mapcar1 (leni, args, function, sequence);
+  EMACS_INT args_alloc = 2 * leni - 1;
+  if (args_alloc < 0)
+    return empty_unibyte_string;
+  Lisp_Object *args;
+  SAFE_ALLOCA_LISP (args, args_alloc);
+  ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+  ptrdiff_t nargs = 2 * nmapped - 1;
 
-  for (i = leni - 1; i > 0; i--)
+  for (ptrdiff_t i = nmapped - 1; i > 0; i--)
     args[i + i] = args[i];
 
-  for (i = 1; i < nargs; i += 2)
+  for (ptrdiff_t i = 1; i < nargs; i += 2)
     args[i] = separator;
 
-  ret = Fconcat (nargs, args);
+  Lisp_Object ret = Fconcat (nargs, args);
   SAFE_FREE ();
-
   return ret;
 }
 
@@ -2618,24 +2616,15 @@ The result is a list just as long as SEQUENCE.
 SEQUENCE may be a list, a vector, a bool-vector, or a string.  */)
   (Lisp_Object function, Lisp_Object sequence)
 {
-  register Lisp_Object len;
-  register EMACS_INT leni;
-  register Lisp_Object *args;
-  Lisp_Object ret;
   USE_SAFE_ALLOCA;
-
-  len = Flength (sequence);
+  EMACS_INT leni = XFASTINT (Flength (sequence));
   if (CHAR_TABLE_P (sequence))
     wrong_type_argument (Qlistp, sequence);
-  leni = XFASTINT (len);
-
+  Lisp_Object *args;
   SAFE_ALLOCA_LISP (args, leni);
-
-  mapcar1 (leni, args, function, sequence);
-
-  ret = Flist (leni, args);
+  ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+  Lisp_Object ret = Flist (nmapped, args);
   SAFE_FREE ();
-
   return ret;
 }
 
@@ -2661,21 +2650,15 @@ the results by altering them (using `nconc').
 SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
      (Lisp_Object function, Lisp_Object sequence)
 {
-  register EMACS_INT leni;
-  register Lisp_Object *args;
-  Lisp_Object ret;
   USE_SAFE_ALLOCA;
-
+  EMACS_INT leni = XFASTINT (Flength (sequence));
   if (CHAR_TABLE_P (sequence))
     wrong_type_argument (Qlistp, sequence);
-
-  leni = XFASTINT (Flength (sequence));
+  Lisp_Object *args;
   SAFE_ALLOCA_LISP (args, leni);
-  mapcar1 (leni, args, function, sequence);
-  ret = Fnconc (leni, args);
-
+  ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
+  Lisp_Object ret = Fnconc (nmapped, args);
   SAFE_FREE ();
-
   return ret;
 }