Re: [PATCH] fix for Crash in mapcar1
>>>> "Hrv" == Hrvoje Niksic
<hniksic(a)iskon.hr> writes:
Hrv> Martin Buchholz <martin(a)xemacs.org> writes:
Jan> Why not do that? We can also do away with the caller calling
Jan> Flength when the results are not needed. Then we would only
Jan> loop over the list once and in addition the size of the list we
Jan> can loop over is not limited by the stack size limit.
>
> It's not obvious to me which implementation is faster.
Hrv> But yours introduces additional stack-allocation in the `mapc' case.
You guys sure are a tough bunch to please!
Here is Patch version 4, with these new and improved features:
- test cases added to test suite.
- test case functions have docstrings and cool comments.
- much more verbose ChangeLog entries
- use EXTERNAL_LIST_LOOP as suggested by Hrvoje
src/ChangeLog:
1999-12-17 Martin Buchholz <martin(a)xemacs.org>
* fns.c (mapcar1): Fix ***THREE*** obscure crashes in one function!
- Two of those involve evil mapping functions that destructively
modify a list being mapped over.
- Any garbage collection when mapping over a string could cause a
crash (typically in mapconcat).
tests/ChangeLog:
1999-12-17 Martin Buchholz <martin(a)xemacs.org>
* automated/lisp-tests.el: Add tests for mapcar1() crashes.
Index: src/fns.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/fns.c,v
retrieving revision 1.30.2.23
diff -u -w -r1.30.2.23 fns.c
--- fns.c 1999/10/24 03:48:39 1.30.2.23
+++ fns.c 1999/12/17 23:43:31
＠＠ -3068,14 +3068,54 ＠＠
if (LISTP (seq))
{
+ /* A devious `fn' could either:
+ - insert garbage into the list in front of us, causing XCDR to crash
+ - amputate the list behind us using (setcdr), causing the remaining
+ elts to lose their GCPRO status.
+
+ if (vals != 0) we avoid this by copying the elts into the
+ `vals' array. By a stroke of luck, `vals' is exactly large
+ enough to hold the elts left to be traversed as well as the
+ results computed so far.
+
+ if (vals == 0) we don't have any free space available and
+ don't want to eat up any more stack with alloca().
+ So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */
+
+ if (vals)
+ {
+ Lisp_Object *val = vals;
+ Lisp_Object elt;
+
+ LIST_LOOP_2 (elt, seq)
+ *val++ = elt;
+
+ gcpro1.nvars = leni;
+
for (i = 0; i < leni; i++)
{
- args[1] = XCAR (seq);
- seq = XCDR (seq);
- result = Ffuncall (2, args);
- if (vals) vals[gcpro1.nvars++] = result;
+ args[1] = vals[i];
+ vals[i] = Ffuncall (2, args);
}
}
+ else
+ {
+ Lisp_Object elt, tail;
+ struct gcpro ngcpro1;
+
+ NGCPRO1 (tail);
+
+ {
+ EXTERNAL_LIST_LOOP_3 (elt, seq, tail)
+ {
+ args[1] = elt;
+ Ffuncall (2, args);
+ }
+ }
+
+ NUNGCPRO;
+ }
+ }
else if (VECTORP (seq))
{
Lisp_Object *objs = XVECTOR_DATA (seq);
＠＠ -3088,8 +3128,14 ＠＠
}
else if (STRINGP (seq))
{
- Bufbyte *p = XSTRING_DATA (seq);
- for (i = 0; i < leni; i++)
+ /* The string data of `seq' might be relocated during GC. */
+ Bytecount slen = XSTRING_LENGTH (seq);
+ Bufbyte *p = alloca_array (Bufbyte, slen);
+ Bufbyte *end = p + slen;
+
+ memcpy (p, XSTRING_DATA (seq), slen);
+
+ while (p < end)
{
args[1] = make_char (charptr_emchar (p));
INC_CHARPTR (p);
Index: tests/automated/lisp-tests.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/tests/automated/Attic/lisp-tests.el,v
retrieving revision 1.1.2.7
diff -u -w -r1.1.2.7 lisp-tests.el
--- lisp-tests.el 1999/09/17 19:30:36 1.1.2.7
+++ lisp-tests.el 1999/12/17 23:43:31
＠＠ -755,6 +755,29 ＠＠
(Assert (equal (mapconcat #'identity '("1" "2" "3")
"|") "1|2|3"))
(Assert (equal (mapconcat #'identity ["1" "2" "3"]
"|") "1|2|3"))
+;; The following 2 functions used to crash XEmacs via mapcar1().
+;; We don't test the actual values of the mapcar, since they're undefined.
+(Assert
+ (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
+ (mapcar
+ (lambda (y)
+ "Devious evil mapping function"
+ (when (eq (car y) 2) ; go out onto a limb
+ (setcdr x nil) ; cut it off behind us
+ (garbage-collect)) ; are we riding a magic broomstick?
+ (car y)) ; sorry, hard landing
+ x)))
+
+(Assert
+ (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
+ (mapcar
+ (lambda (y)
+ "Devious evil mapping function"
+ (when (eq (car y) 1)
+ (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
+ (car y))
+ x)))
+
;;-----------------------------------------------------
;; Test vector functions
;;-----------------------------------------------------