1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

Attempt to mutate residualized literal pair throws exception

* 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

View file

@ -424,6 +424,8 @@
VM_VALIDATE (x, SCM_CHARP, proc, char)
#define VM_VALIDATE_PAIR(x, proc) \
VM_VALIDATE (x, scm_is_pair, proc, pair)
#define VM_VALIDATE_MUTABLE_PAIR(x, proc) \
VM_VALIDATE (x, scm_is_mutable_pair, proc, mutable_pair)
#define VM_VALIDATE_STRING(obj, proc) \
VM_VALIDATE (obj, scm_is_string, proc, string)
#define VM_VALIDATE_STRUCT(obj, proc) \
@ -2359,7 +2361,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_12_12 (op, a, b);
x = SP_REF (a);
y = SP_REF (b);
VM_VALIDATE_PAIR (x, "set-car!");
VM_VALIDATE_MUTABLE_PAIR (x, "set-car!");
SCM_SETCAR (x, y);
NEXT (1);
}
@ -2375,7 +2377,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_12_12 (op, a, b);
x = SP_REF (a);
y = SP_REF (b);
VM_VALIDATE_PAIR (x, "set-car!");
VM_VALIDATE_MUTABLE_PAIR (x, "set-cdr!");
SCM_SETCDR (x, y);
NEXT (1);
}