Mercurial > hg > xemacs-beta
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 {