Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5241:d579d76f3dcc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
5240:fca0cf0971de 5241:d579d76f3dcc
62 62
63 Lisp_Object Vpath_separator; 63 Lisp_Object Vpath_separator;
64 64
65 static int internal_old_equal (Lisp_Object, Lisp_Object, int); 65 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
66 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); 66 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
67
68 static DOESNT_RETURN
69 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
70 {
71 invalid_state_2 ("object modified while traversing it", func, object);
72 }
67 73
68 static Lisp_Object 74 static Lisp_Object
69 mark_bit_vector (Lisp_Object UNUSED (obj)) 75 mark_bit_vector (Lisp_Object UNUSED (obj))
70 { 76 {
71 return Qnil; 77 return Qnil;
4993 { 4999 {
4994 accum = KEY (key, make_char (itext_ichar (cursor))); 5000 accum = KEY (key, make_char (itext_ichar (cursor)));
4995 starting++; 5001 starting++;
4996 startp = XSTRING_DATA (sequence); 5002 startp = XSTRING_DATA (sequence);
4997 cursor = startp + cursor_offset; 5003 cursor = startp + cursor_offset;
5004
5005 if (byte_len != XSTRING_LENGTH (sequence)
5006 || !valid_ibyteptr_p (cursor))
5007 {
5008 mapping_interaction_error (Qreduce, sequence);
5009 }
5010
4998 INC_IBYTEPTR (cursor); 5011 INC_IBYTEPTR (cursor);
4999 cursor_offset = cursor - startp; 5012 cursor_offset = cursor - startp;
5000 } 5013 }
5001 5014
5002 while (cursor_offset < byte_len && starting < ending) 5015 while (cursor_offset < byte_len && starting < ending)
5003 { 5016 {
5004 if (cursor_offset > XSTRING_LENGTH (sequence)) 5017 accum = call2 (function, accum,
5018 KEY (key, make_char (itext_ichar (cursor))));
5019
5020 startp = XSTRING_DATA (sequence);
5021 cursor = startp + cursor_offset;
5022
5023 if (byte_len != XSTRING_LENGTH (sequence)
5024 || !valid_ibyteptr_p (cursor))
5005 { 5025 {
5006 invalid_state ("sequence modified during reduce", sequence); 5026 mapping_interaction_error (Qreduce, sequence);
5007 } 5027 }
5008 5028
5009 startp = XSTRING_DATA (sequence);
5010 cursor = startp + cursor_offset;
5011 accum = call2 (function, accum,
5012 KEY (key, make_char (itext_ichar (cursor))));
5013 INC_IBYTEPTR (cursor); 5029 INC_IBYTEPTR (cursor);
5014 cursor_offset = cursor - startp; 5030 cursor_offset = cursor - startp;
5015 ++starting; 5031 ++starting;
5016 } 5032 }
5017 } 5033 }
5018 else 5034 else
5019 { 5035 {
5020 Elemcount len = string_char_length (sequence); 5036 Elemcount len = string_char_length (sequence);
5021 Bytecount cursor_offset; 5037 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
5022 const Ibyte *cursor; 5038 const Ibyte *cursor;
5023 5039
5024 ending = min (ending, len); 5040 ending = min (ending, len);
5025 cursor = string_char_addr (sequence, ending - 1); 5041 cursor = string_char_addr (sequence, ending - 1);
5026 cursor_offset = cursor - XSTRING_DATA (sequence); 5042 cursor_offset = cursor - XSTRING_DATA (sequence);
5033 { 5049 {
5034 accum = KEY (key, make_char (itext_ichar (cursor))); 5050 accum = KEY (key, make_char (itext_ichar (cursor)));
5035 ending--; 5051 ending--;
5036 if (ending > 0) 5052 if (ending > 0)
5037 { 5053 {
5054 cursor = XSTRING_DATA (sequence) + cursor_offset;
5055
5056 if (!valid_ibyteptr_p (cursor))
5057 {
5058 mapping_interaction_error (Qreduce, sequence);
5059 }
5060
5038 DEC_IBYTEPTR (cursor); 5061 DEC_IBYTEPTR (cursor);
5039 cursor_offset = cursor - XSTRING_DATA (sequence); 5062 cursor_offset = cursor - XSTRING_DATA (sequence);
5040 } 5063 }
5041 } 5064 }
5042 5065
5043 for (ii = ending - 1; ii >= starting; --ii) 5066 for (ii = ending - 1; ii >= starting; --ii)
5044 { 5067 {
5045 if (cursor_offset > XSTRING_LENGTH (sequence))
5046 {
5047 invalid_state ("sequence modified during reduce", sequence);
5048 }
5049
5050 cursor = XSTRING_DATA (sequence) + cursor_offset;
5051 accum = call2 (function, KEY (key, 5068 accum = call2 (function, KEY (key,
5052 make_char (itext_ichar (cursor))), 5069 make_char (itext_ichar (cursor))),
5053 accum); 5070 accum);
5054 if (ii > 1) 5071 if (ii > 0)
5055 { 5072 {
5056 cursor = XSTRING_DATA (sequence) + cursor_offset; 5073 cursor = XSTRING_DATA (sequence) + cursor_offset;
5074
5075 if (byte_len != XSTRING_LENGTH (sequence)
5076 || !valid_ibyteptr_p (cursor))
5077 {
5078 mapping_interaction_error (Qreduce, sequence);
5079 }
5080
5057 DEC_IBYTEPTR (cursor); 5081 DEC_IBYTEPTR (cursor);
5058 cursor_offset = cursor - XSTRING_DATA (sequence); 5082 cursor_offset = cursor - XSTRING_DATA (sequence);
5059 } 5083 }
5060 } 5084 }
5061 } 5085 }
5062 } 5086 }
5063 else if (LISTP (sequence)) 5087 else if (LISTP (sequence))
5064 { 5088 {
5065 if (NILP (from_end)) 5089 if (NILP (from_end))
5066 { 5090 {
5091 struct gcpro gcpro1;
5092 Lisp_Object tailed = Qnil;
5093
5094 GCPRO1 (tailed);
5095
5067 if (!UNBOUNDP (initial_value)) 5096 if (!UNBOUNDP (initial_value))
5068 { 5097 {
5069 accum = initial_value; 5098 accum = initial_value;
5070 } 5099 }
5071 else if (ending - starting && starting < ending) 5100 else if (ending - starting && starting < ending)
5072 { 5101 {
5073 Elemcount counting = 0; 5102 Elemcount counting = 0;
5074 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) 5103 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
5075 { 5104 {
5105 /* KEY may amputate the list behind us; make sure what
5106 remains to be processed is still reachable. */
5107 tailed = tail;
5076 if (counting == starting) 5108 if (counting == starting)
5077 { 5109 {
5078 accum = KEY (key, elt); 5110 accum = KEY (key, elt);
5079 starting++; 5111 starting++;
5080 break; 5112 break;
5087 { 5119 {
5088 Elemcount counting = 0; 5120 Elemcount counting = 0;
5089 5121
5090 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) 5122 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
5091 { 5123 {
5124 /* KEY or FUNCTION may amputate the list behind us; make
5125 sure what remains to be processed is still
5126 reachable. */
5127 tailed = tail;
5092 if (counting >= starting) 5128 if (counting >= starting)
5093 { 5129 {
5094 if (counting < ending) 5130 if (counting < ending)
5095 { 5131 {
5096 accum = call2 (function, accum, KEY (key, elt)); 5132 accum = call2 (function, accum, KEY (key, elt));
5101 } 5137 }
5102 } 5138 }
5103 ++counting; 5139 ++counting;
5104 } 5140 }
5105 } 5141 }
5142
5143 UNGCPRO;
5106 } 5144 }
5107 else 5145 else
5108 { 5146 {
5109 Boolint need_accum = 0; 5147 Boolint need_accum = 0;
5110 Lisp_Object *subsequence = NULL; 5148 Lisp_Object *subsequence = NULL;