diff src/fns.c @ 5241:d579d76f3dcc

Be more careful about side-effects from Lisp code, #'reduce src/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea@parhasard.net> * lisp.h (PARSE_KEYWORDS): Always accept a nil :allow-other-keys keyword argument, as described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup, and as necessary for Paul Dietz' tests for #'reduce. * fns.c (mapping_interaction_error): New. (Freduce): Call mapping_interaction_error when KEY or FUNCTION have modified a string SEQUENCE such that the byte length of the string has changed, or such that the current cursor pointer doesn't point to the beginning of a character. Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue writeup. When traversing a list, GCPRO the part of it we still have to traverse, to avoid any crashes if FUNCTION or KEY amputate it behind us and force a garbage collection. tests/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test a couple of things #'reduce was just made more careful about.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 24 Jul 2010 15:56:57 +0100
parents fbd1485af104
children b6a398dbb403
line wrap: on
line diff
--- a/src/fns.c	Tue Jul 13 10:20:22 2010 +0200
+++ b/src/fns.c	Sat Jul 24 15:56:57 2010 +0100
@@ -65,6 +65,12 @@
 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
 
+static DOESNT_RETURN
+mapping_interaction_error (Lisp_Object func, Lisp_Object object)
+{
+  invalid_state_2 ("object modified while traversing it", func, object);
+}
+
 static Lisp_Object
 mark_bit_vector (Lisp_Object UNUSED (obj))
 {
@@ -4995,21 +5001,31 @@
               starting++;
               startp = XSTRING_DATA (sequence);
               cursor = startp + cursor_offset;
+
+              if (byte_len != XSTRING_LENGTH (sequence)
+                  || !valid_ibyteptr_p (cursor))
+                {
+                  mapping_interaction_error (Qreduce, sequence);
+                }
+
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
             }
 
           while (cursor_offset < byte_len && starting < ending)
             {
-              if (cursor_offset > XSTRING_LENGTH (sequence))
+              accum = call2 (function, accum, 
+                             KEY (key, make_char (itext_ichar (cursor))));
+
+	      startp = XSTRING_DATA (sequence);
+	      cursor = startp + cursor_offset;
+
+              if (byte_len != XSTRING_LENGTH (sequence)
+                  || !valid_ibyteptr_p (cursor))
                 {
-                  invalid_state ("sequence modified during reduce", sequence);
+                  mapping_interaction_error (Qreduce, sequence);
                 }
 
-              startp = XSTRING_DATA (sequence);
-              cursor = startp + cursor_offset;
-              accum = call2 (function, accum,
-                             KEY (key, make_char (itext_ichar (cursor))));
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
               ++starting;
@@ -5018,7 +5034,7 @@
       else
         {
           Elemcount len = string_char_length (sequence);
-          Bytecount cursor_offset;
+          Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
           const Ibyte *cursor;
 
           ending = min (ending, len);
@@ -5035,6 +5051,13 @@
               ending--;
               if (ending > 0)
                 {
+		  cursor = XSTRING_DATA (sequence) + cursor_offset;
+
+                  if (!valid_ibyteptr_p (cursor))
+                    {
+                      mapping_interaction_error (Qreduce, sequence);
+                    }
+
                   DEC_IBYTEPTR (cursor);
                   cursor_offset = cursor - XSTRING_DATA (sequence);
                 }
@@ -5042,18 +5065,19 @@
 
           for (ii = ending - 1; ii >= starting; --ii)
             {
-              if (cursor_offset > XSTRING_LENGTH (sequence))
-                {
-                  invalid_state ("sequence modified during reduce", sequence);
-                }
-
-              cursor = XSTRING_DATA (sequence) + cursor_offset;
               accum = call2 (function, KEY (key,
                                             make_char (itext_ichar (cursor))),
                              accum);
-              if (ii > 1)
+              if (ii > 0)
                 {
                   cursor = XSTRING_DATA (sequence) + cursor_offset;
+
+                  if (byte_len != XSTRING_LENGTH (sequence)
+                      || !valid_ibyteptr_p (cursor))
+                    {
+                      mapping_interaction_error (Qreduce, sequence);
+                    }
+
                   DEC_IBYTEPTR (cursor);
                   cursor_offset = cursor - XSTRING_DATA (sequence);
                 }
@@ -5064,6 +5088,11 @@
     {
       if (NILP (from_end))
         {
+	  struct gcpro gcpro1;
+	  Lisp_Object tailed = Qnil;
+
+	  GCPRO1 (tailed);
+
           if (!UNBOUNDP (initial_value))
             {
               accum = initial_value;
@@ -5073,6 +5102,9 @@
               Elemcount counting = 0;
               EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
                 {
+		  /* KEY may amputate the list behind us; make sure what
+		     remains to be processed is still reachable.  */
+		  tailed = tail;
                   if (counting == starting)
                     {
                       accum = KEY (key, elt);
@@ -5089,6 +5121,10 @@
 
               EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
                 {
+		  /* KEY or FUNCTION may amputate the list behind us; make
+		     sure what remains to be processed is still
+		     reachable.  */
+		  tailed = tail;
                   if (counting >= starting)
                     {
                       if (counting < ending)
@@ -5103,6 +5139,8 @@
                   ++counting;
                 }
             }
+
+	  UNGCPRO;
         }
       else
         {