mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

Attempt to mutate residualized literal pair throws exception

Browse source 
* libguile/validate.h (SCM_VALIDATE_MUTABLE_PAIR):
* libguile/pairs.h (scm_is_mutable_pair): New internal definitions.
* libguile/pairs.c (scm_set_car_x, scm_set_cdr_x): Validate mutable
  pairs.
* libguile/alist.c (scm_assq_set_x, scm_assv_set_x, scm_assoc_set_x):
* libguile/list.c (scm_reverse_x, scm_list_set_x, scm_list_cdr_set_x):
* libguile/srcprop.c (scm_make_srcprops):
* libguile/srfi-1.c (scm_srfi1_append_reverse_x)
  (scm_srfi1_delete_duplicates_x):
* libguile/symbols.c (scm_symbol_fset_x, scm_symbol_pset_x):
* libguile/sort.c (scm_merge_list_x): Use scm_set_car_x / scm_set_cdr_x
  instead of the macros, so as to check for mutable pairs.
  (SCM_VALIDATE_MUTABLE_LIST): New internal helper macro.
  (scm_sort_x, scm_stable_sort_x, scm_sort_list_x): Use
  SCM_VALIDATE_MUTABLE_LIST.
* libguile/vm-engine.c (VM_VALIDATE_MUTABLE_PAIR): New definition.
  (set-car!, set-cdr!): Use VM_VALIDATE_MUTABLE_PAIR.  Fix error message
  for set-cdr!.
This commit is contained in:
Andy Wingo 2017-04-17 11:26:17 +02:00
parent d7778b3d6a
commit 6e573a0885
11 changed files with 63 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/sort.c
View file

@ -306,22 +306,22 @@ scm_merge_list_x (SCM alist, SCM blist,
SCM_TICK;
if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
SCM_SETCDR (last, blist);
scm_set_cdr_x (last, blist);
blist = SCM_CDR (blist);
blen--;
}
else
{
SCM_SETCDR (last, alist);
scm_set_cdr_x (last, alist);
alist = SCM_CDR (alist);
alen--;
}
last = SCM_CDR (last);
}
if ((alen > 0) && (blen == 0))
SCM_SETCDR (last, alist);
scm_set_cdr_x (last, alist);
else if ((alen == 0) && (blen > 0))
SCM_SETCDR (last, blist);
scm_set_cdr_x (last, blist);
}
return build;
} /* scm_merge_list_x */
@ -398,6 +398,14 @@ scm_merge_list_step (SCM * seq, SCM less, long n)
} /* scm_merge_list_step */
#define SCM_VALIDATE_MUTABLE_LIST(pos, lst) \
do { \
SCM walk; \
for (walk = lst; !scm_is_null_or_nil (walk); walk = SCM_CDR (walk)) \
SCM_VALIDATE_MUTABLE_PAIR (pos, walk); \
} while (0)
SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
(SCM items, SCM less),
"Sort the sequence @var{items}, which may be a list or a\n"
@ -414,6 +422,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
if (scm_is_pair (items))
{
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
SCM_VALIDATE_MUTABLE_LIST (1, items);
return scm_merge_list_step (&items, less, len);
}
else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
@ -533,6 +542,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
if (scm_is_pair (items))
{
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
SCM_VALIDATE_MUTABLE_LIST (1, items);
return scm_merge_list_step (&items, less, len);
}
else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
@ -596,6 +606,8 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
long len;
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
SCM_VALIDATE_MUTABLE_LIST (1, items);
return scm_merge_list_step (&items, less, len);
}
#undef FUNC_NAME