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

respect slot allocation, e.g. for <read-only-slot>

Browse source 
* libguile/goops.c (get_slot_value, set_slot_value): In the struct
	allocation case, don't poke the slots array directly -- we should
	go through struct-ref/struct-set! code so that we get the
	permissions and allocation ('u' versus 'p') correct.
This commit is contained in:
Andy Wingo 2008-04-10 01:23:06 +02:00 • committed by Ludovic Courtès
parent 08365ce400
commit 54ee7cdfce
2 changed files with 16 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/ChangeLog
View file

@ -1,3 +1,10 @@
2008-04-10 Andy Wingo <wingo@pobox.com>
* libguile/goops.c (get_slot_value, set_slot_value): In the struct
allocation case, don't poke the slots array directly -- we should
go through struct-ref/struct-set! code so that we get the
permissions and allocation ('u' versus 'p') correct.
2008-04-03 Ludovic Courtès <ludo@gnu.org> 2008-04-03 Ludovic Courtès <ludo@gnu.org>
* inline.h (SCM_C_EXTERN_INLINE): New macro, addresses the * inline.h (SCM_C_EXTERN_INLINE): New macro, addresses the

11
libguile/goops.c
View file

@ -1260,6 +1260,7 @@ slot_definition_using_name (SCM class, SCM slot_name)
static SCM static SCM
get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
#define FUNC_NAME "%get-slot-value"
{ {
SCM access = SCM_CDDR (slotdef); SCM access = SCM_CDDR (slotdef);
/* Two cases here: /* Two cases here:
@ -1270,7 +1271,9 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
* we can just assume fixnums here. * we can just assume fixnums here.
*/ */
if (SCM_I_INUMP (access)) if (SCM_I_INUMP (access))
return SCM_SLOT (obj, SCM_I_INUM (access)); /* Don't poke at the slots directly, because scm_struct_ref handles the
access bits for us. */
return scm_struct_ref (obj, access);
else else
{ {
/* We must evaluate (apply (car access) (list obj)) /* We must evaluate (apply (car access) (list obj))
@ -1287,6 +1290,7 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
return scm_eval_body (SCM_CLOSURE_BODY (code), env); return scm_eval_body (SCM_CLOSURE_BODY (code), env);
} }
} }
#undef FUNC_NAME
static SCM static SCM
get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
@ -1300,6 +1304,7 @@ get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
static SCM static SCM
set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
#define FUNC_NAME "%set-slot-value"
{ {
SCM access = SCM_CDDR (slotdef); SCM access = SCM_CDDR (slotdef);
/* Two cases here: /* Two cases here:
@ -1310,7 +1315,8 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
* we can just assume fixnums here. * we can just assume fixnums here.
*/ */
if (SCM_I_INUMP (access)) if (SCM_I_INUMP (access))
SCM_SET_SLOT (obj, SCM_I_INUM (access), value); /* obey permissions bits via going through struct-set! */
scm_struct_set_x (obj, access, value);
else else
{ {
/* We must evaluate (apply (cadr l) (list obj value)) /* We must evaluate (apply (cadr l) (list obj value))
@ -1331,6 +1337,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME
static SCM static SCM
set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value) set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value)