changeset 5303:4c4085177ca5

Fix some bugs in fns.c, discovered in passing while doing other work. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fnreverse): Check that non-list sequences are writable from Lisp before modifying them. (There's an argument that we should do this for list sequences too, but for the moment other code (e.g. #'setcar) doesn't.) (mapcarX): Initialise lisp_vals_staging, lisp_vals_type explicitly, for the sake of compile warnings. Check if lisp_vals_staging is non-NULL when deciding whether to replace a string's range. (Fsome): Cross-reference to #'find-if in the doc string for this function. (Freduce): GCPRO accum in this function, when a key argument is specicified it can be silently garbage-collected. When deciding whether to iterate across a string, check whether the cursor exceeds the byte len; while iterating, increment an integer counter. Don't ABORT() if check_sequence_range() returns when handed a suspicious sequence; it is legal to supply the length of SEQUENCE as the :end keyword value, and this will provoke our suspicions, legitimately enough. (Problems with this function revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.) (Freplace): Check list sequence lengths using the arguments, not the conses we're currently looking at, thank you Paul Dietz.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 14 Nov 2010 14:54:09 +0000
parents 6468cf6f0b9d
children 6784adb405ad
files src/ChangeLog src/fns.c
diffstat 2 files changed, 68 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sun Nov 14 14:13:06 2010 +0000
+++ b/src/ChangeLog	Sun Nov 14 14:54:09 2010 +0000
@@ -1,3 +1,28 @@
+2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Fnreverse):
+	Check that non-list sequences are writable from Lisp before
+	modifying them. (There's an argument that we should do this for
+	list sequences too, but for the moment other code (e.g. #'setcar)
+	doesn't.)
+	(mapcarX): Initialise lisp_vals_staging, lisp_vals_type
+	explicitly, for the sake of compile warnings. Check if
+	lisp_vals_staging is non-NULL when deciding whether to replace a
+	string's range.
+	(Fsome): Cross-reference to #'find-if in the doc string for this
+	function.
+	(Freduce): GCPRO accum in this function, when a key argument is
+	specicified it can be silently garbage-collected.  When deciding
+	whether to iterate across a string, check whether the cursor
+	exceeds the byte len; while iterating, increment an integer
+	counter.  Don't ABORT() if check_sequence_range() returns when
+	handed a suspicious sequence; it is legal to supply the length of
+	SEQUENCE as the :end keyword value, and this will provoke our
+	suspicions, legitimately enough. (Problems with this function
+	revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
+	(Freplace): Check list sequence lengths using the arguments, not
+	the conses we're currently looking at, thank you Paul Dietz.
+
 2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* fns.c (Frandom): Correct the docstring here, the name of the
--- a/src/fns.c	Sun Nov 14 14:13:06 2010 +0000
+++ b/src/fns.c	Sun Nov 14 14:54:09 2010 +0000
@@ -1108,11 +1108,12 @@
           sequence = Fnthcdr (make_int (ss), sequence);
         }
 
+      ii = ss + 1;
+
       if (ss < ee && !NILP (sequence))
         {
 	  result = result_tail = Fcons (Fcar (sequence), Qnil);
 	  sequence = Fcdr (sequence);
-	  ii = ss + 1;
 
 	  {
 	    EXTERNAL_LIST_LOOP_2 (elt, sequence)
@@ -2128,6 +2129,7 @@
       Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
       Elemcount half = length / 2;
       Lisp_Object swap = Qnil;
+      CHECK_LISP_WRITEABLE (sequence);
 
       while (ii > half)
 	{
@@ -2144,6 +2146,7 @@
       Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
       Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
 
+      CHECK_LISP_WRITEABLE (sequence);
       while (cursor < endp)
 	{
 	  staging_end -= itext_ichar_len (cursor);
@@ -2165,6 +2168,7 @@
       Elemcount half = length / 2;
       int swap = 0;
 
+      CHECK_LISP_WRITEABLE (sequence);
       while (ii > half)
 	{
 	  swap = bit_vector_bit (bv, length - ii);
@@ -4450,7 +4454,7 @@
 {
   Lisp_Object called, *args;
   struct gcpro gcpro1, gcpro2;
-  Ibyte *lisp_vals_staging, *cursor;
+  Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
   int i, j;
 
   assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
@@ -4497,7 +4501,7 @@
     }
   else
     {
-      enum lrecord_type lisp_vals_type;
+      enum lrecord_type lisp_vals_type = lrecord_type_symbol;
       Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
       for (j = 0; j < nsequences; ++j)
 	{
@@ -4516,6 +4520,10 @@
 	      lisp_vals_staging = cursor
 		= alloca_ibytes (call_count * MAX_ICHAR_LEN);
 	    }
+          else if (ARRAYP (lisp_vals))
+            {
+              CHECK_LISP_WRITEABLE (lisp_vals);
+            }
         }
 
       for (i = 0; i < call_count; ++i)
@@ -4641,9 +4649,9 @@
             }
 	}
 
-      if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
-	  lrecord_type_string == lisp_vals_type)
+      if (lisp_vals_staging != NULL)
 	{
+          CHECK_LISP_WRITEABLE (lisp_vals);
 	  replace_string_range (lisp_vals, Qzero, make_int (call_count),
 				lisp_vals_staging, cursor);
 	}
@@ -4659,7 +4667,7 @@
 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
 {
   Elemcount len = EMACS_INT_MAX;
-  Lisp_Object length;
+  Lisp_Object length = Qnil;
   int i;
 
   for (i = 0; i < nsequences; ++i)
@@ -4953,6 +4961,10 @@
 With optional SEQUENCES, call PREDICATE each time with as many arguments as
 there are SEQUENCES (plus one for the element from SEQUENCE).
 
+See also `find-if', which returns the corresponding element of SEQUENCE,
+rather than the value given by PREDICATE, and accepts bounding index
+keywords.
+
 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
 */
        (int nargs, Lisp_Object *args))
@@ -5205,11 +5217,14 @@
   if (VECTORP (sequence))
     {
       Lisp_Vector *vv = XVECTOR (sequence);
+      struct gcpro gcpro1;
 
       check_sequence_range (sequence, start, end, make_int (vv->size));
 
       ending = min (ending, vv->size);
 
+      GCPRO1 (accum);
+
       if (!UNBOUNDP (initial_value))
         {
           accum = initial_value;
@@ -5242,15 +5257,19 @@
               accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
             }
         }
+
+      UNGCPRO;
     }
   else if (BIT_VECTORP (sequence))
     {
       Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+      struct gcpro gcpro1;
 
       check_sequence_range (sequence, start, end, make_int (bv->size));
-
       ending = min (ending, bv->size);
 
+      GCPRO1 (accum);
+
       if (!UNBOUNDP (initial_value))
         {
           accum = initial_value;
@@ -5287,9 +5306,16 @@
                              accum);
             }
         }
+
+      UNGCPRO;
+
     }
   else if (STRINGP (sequence))
     {
+      struct gcpro gcpro1;
+
+      GCPRO1 (accum);
+
       if (NILP (from_end))
         {
           Bytecount byte_len = XSTRING_LENGTH (sequence);
@@ -5307,7 +5333,7 @@
             {
               accum = initial_value;
             }
-          else if (ending - starting)
+          else if (ending - starting && cursor_offset < byte_len)
             {
               accum = KEY (key, make_char (itext_ichar (cursor)));
               starting++;
@@ -5322,6 +5348,7 @@
 
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
+	      ii++;
             }
 
           while (cursor_offset < byte_len && ii < ending)
@@ -5346,7 +5373,6 @@
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
         }
       else
@@ -5356,7 +5382,6 @@
           const Ibyte *cursor;
 
 	  check_sequence_range (sequence, start, end, make_int (len));
-
           ending = min (ending, len);
           cursor = string_char_addr (sequence, ending - 1);
           cursor_offset = cursor - XSTRING_DATA (sequence);
@@ -5403,15 +5428,17 @@
                 }
             }
         }
+
+      UNGCPRO;
     }
   else if (LISTP (sequence))
     {
       if (NILP (from_end))
         {
-	  struct gcpro gcpro1;
+	  struct gcpro gcpro1, gcpro2;
 	  Lisp_Object tailed = Qnil;
 
-	  GCPRO1 (tailed);
+	  GCPRO2 (tailed, accum);
 
           if (!UNBOUNDP (initial_value))
             {
@@ -5464,7 +5491,6 @@
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
         }
       else
@@ -5930,12 +5956,12 @@
 
       if (NILP (sequence1))
         {
-          check_sequence_range (sequence1, start1, end1,
+          check_sequence_range (args[0], start1, end1,
                                 make_int (XINT (start1) + shortest_len));
         }
       else if (NILP (sequence2))
         {
-          check_sequence_range (sequence2, start2, end2,
+          check_sequence_range (args[1], start2, end2,
                                 make_int (XINT (start2) + shortest_len));
         }
     }
@@ -5998,7 +6024,7 @@
 
           if (NILP (sequence1))
             {
-              check_sequence_range (sequence1, start1, end1,
+              check_sequence_range (args[0], start1, end1,
                                     make_int (XINT (start1) + starting1));
             }
         }
@@ -6055,7 +6081,7 @@
 
           if (NILP (sequence2))
             {
-              check_sequence_range (sequence2, start2, end2,
+              check_sequence_range (args[1], start2, end2,
                                     make_int (XINT (start2) + starting2));
             }
         }