xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 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	cde1608596d0 002cb5224e4f

comparison

equal deleted inserted replaced

-:6468cf6f0b9d
+:4c4085177ca5
 if (0 != ss)
 {
 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)
 	      {
 		if (!(ii < ee))
 else if (VECTORP (sequence))
 {
 Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
 Elemcount half = length / 2;
 Lisp_Object swap = Qnil;
+CHECK_LISP_WRITEABLE (sequence);
 while (ii > half)
 	{
 	  swap = XVECTOR_DATA (sequence) [length - ii];
 	  XVECTOR_DATA (sequence) [length - ii]
 {
 Elemcount length = XSTRING_LENGTH (sequence);
 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);
 	  itext_copy_ichar (cursor, staging_end);
 	  INC_IBYTEPTR (cursor);
 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
 Elemcount length = bit_vector_length (bv), ii = length;
 Elemcount half = length / 2;
 int swap = 0;
+CHECK_LISP_WRITEABLE (sequence);
 while (ii > half)
 	{
 	  swap = bit_vector_bit (bv, length - ii);
 	  set_bit_vector_bit (bv, length - ii, bit_vector_bit (bv, ii - 1));
 	  set_bit_vector_bit (bv, ii - 1, swap);
 	 Lisp_Object function, int nsequences, Lisp_Object *sequences,
 	 Lisp_Object caller)
 {
 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);
 args = alloca_array (Lisp_Object, nsequences + 1);
 	  vals[i] = IGNORE_MULTIPLE_VALUES (Ffuncall (nsequences + 1, args));
 	}
 }
 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)
 	{
 	  sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
 	}
 	  if (lrecord_type_string == lisp_vals_type)
 	    {
 	      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)
 	{
 	  for (j = 0; j < nsequences; ++j)
 }
 }
 }
 	}
-if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
+if (lisp_vals_staging != NULL)
-	  lrecord_type_string == lisp_vals_type)
+	{
-	{
+CHECK_LISP_WRITEABLE (lisp_vals);
 	  replace_string_range (lisp_vals, Qzero, make_int (call_count),
 				lisp_vals_staging, cursor);
 	}
 }
 one of them is not a sequence. */
 static Elemcount
 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)
 {
 if (CONSP (sequences[i]))
 If so, return the value (possibly multiple) given by PREDICATE.
 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))
 {
 }
 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;
 }
 for (ii = ending - 1; ii >= starting; --ii)
 {
 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;
 }
 make_int (bit_vector_bit (bv,
 ii))),
 accum);
 }
 }
+UNGCPRO;
 }
 else if (STRINGP (sequence))
 {
+struct gcpro gcpro1;
+GCPRO1 (accum);
 if (NILP (from_end))
 {
 Bytecount byte_len = XSTRING_LENGTH (sequence);
 Bytecount cursor_offset = 0;
 const Ibyte *startp = XSTRING_DATA (sequence);
 if (!UNBOUNDP (initial_value))
 {
 accum = initial_value;
 }
-else if (ending - starting)
+else if (ending - starting && cursor_offset < byte_len)
 {
 accum = KEY (key, make_char (itext_ichar (cursor)));
 starting++;
 startp = XSTRING_DATA (sequence);
 cursor = startp + cursor_offset;
 mapping_interaction_error (Qreduce, sequence);
 }
 INC_IBYTEPTR (cursor);
 cursor_offset = cursor - startp;
+	      ii++;
 }
 while (cursor_offset < byte_len && ii < ending)
 {
 accum = CALL2 (function, accum,
 }
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
 }
 else
 {
 Elemcount len = string_char_length (sequence);
 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
 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);
 if (!UNBOUNDP (initial_value))
 DEC_IBYTEPTR (cursor);
 cursor_offset = cursor - XSTRING_DATA (sequence);
 }
 }
 }
+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))
 {
 accum = initial_value;
 }
 	  UNGCPRO;
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
 }
 else
 {
 Boolint need_accum = 0;
 }
 }
 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));
 }
 }
 else if (sequence1_listp)
 {
 starting2++;
 }
 if (NILP (sequence1))
 {
-check_sequence_range (sequence1, start1, end1,
+check_sequence_range (args[0], start1, end1,
 make_int (XINT (start1) + starting1));
 }
 }
 }
 else if (sequence2_listp)
 starting2++;
 }
 if (NILP (sequence2))
 {
-check_sequence_range (sequence2, start2, end2,
+check_sequence_range (args[1], start2, end2,
 make_int (XINT (start2) + starting2));
 }
 }
 }
 else

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5303:4c4085177ca5