3:04 p.m.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289746449 0
# Node ID 4c4085177ca574759fe9206b6d3919be5f4409b4
# Parent 6468cf6f0b9df27b0a91fb87878a9cbb7af7c316
Fix some bugs in fns.c, discovered in passing while doing other work.
2010-11-14 Aidan Kehoe <kehoea(a)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.
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/ChangeLog
--- 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(a)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(a)parhasard.net>
* fns.c (Frandom): Correct the docstring here, the name of the
diff -r 6468cf6f0b9d -r 4c4085177ca5 src/fns.c
--- 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));
}
}
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches