mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

deprecated primitive-properties don't get handles from weak hash tables

Browse source 
* libguile/deprecated.c (scm_primitive_property_ref)
  (scm_primitive_property_set_x): Avoid getting handles to elements in a
  weak hash table, as that's not going to work very well.
This commit is contained in:
Andy Wingo 2011-05-01 20:32:28 +02:00
parent d1c4720ca3
commit 4466db75da
1 changed files with 16 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

35
libguile/deprecated.c
View file

@ -2425,17 +2425,17 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
"property value.") "property value.")
#define FUNC_NAME s_scm_primitive_property_ref #define FUNC_NAME s_scm_primitive_property_ref
{ {
SCM h; SCM alist;
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`primitive-property-ref' is deprecated. Use object properties."); ("`primitive-property-ref' is deprecated. Use object properties.");
SCM_VALIDATE_CONS (SCM_ARG1, prop); SCM_VALIDATE_CONS (SCM_ARG1, prop);
h = scm_hashq_get_handle (properties_whash, obj); alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
if (scm_is_true (h)) if (scm_is_pair (alist))
{ {
SCM assoc = scm_assq (prop, SCM_CDR (h)); SCM assoc = scm_assq (prop, alist);
if (scm_is_true (assoc)) if (scm_is_true (assoc))
return SCM_CDR (assoc); return SCM_CDR (assoc);
} }
@ -2445,9 +2445,8 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
else else
{ {
SCM val = scm_call_2 (SCM_CAR (prop), prop, obj); SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
if (scm_is_false (h)) scm_hashq_set_x (properties_whash, obj,
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL); scm_acons (prop, val, alist));
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
return val; return val;
} }
} }
@ -2459,21 +2458,19 @@ SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
"Set the property @var{prop} of @var{obj} to @var{val}.") "Set the property @var{prop} of @var{obj} to @var{val}.")
#define FUNC_NAME s_scm_primitive_property_set_x #define FUNC_NAME s_scm_primitive_property_set_x
{ {
SCM h, assoc; SCM alist, assoc;
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`primitive-property-set!' is deprecated. Use object properties."); ("`primitive-property-set!' is deprecated. Use object properties.");
SCM_VALIDATE_CONS (SCM_ARG1, prop); SCM_VALIDATE_CONS (SCM_ARG1, prop);
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL); alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
assoc = scm_assq (prop, SCM_CDR (h)); assoc = scm_assq (prop, alist);
if (SCM_NIMP (assoc)) if (scm_is_pair (assoc))
SCM_SETCDR (assoc, val); SCM_SETCDR (assoc, val);
else else
{ scm_hashq_set_x (properties_whash, obj,
assoc = scm_acons (prop, val, SCM_CDR (h)); scm_acons (prop, val, alist));
SCM_SETCDR (h, assoc);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2484,15 +2481,15 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
"Remove any value associated with @var{prop} and @var{obj}.") "Remove any value associated with @var{prop} and @var{obj}.")
#define FUNC_NAME s_scm_primitive_property_del_x #define FUNC_NAME s_scm_primitive_property_del_x
{ {
SCM h; SCM alist;
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`primitive-property-del!' is deprecated. Use object properties."); ("`primitive-property-del!' is deprecated. Use object properties.");
SCM_VALIDATE_CONS (SCM_ARG1, prop); SCM_VALIDATE_CONS (SCM_ARG1, prop);
h = scm_hashq_get_handle (properties_whash, obj); alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
if (scm_is_true (h)) if (scm_is_pair (alist))
SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop)); scm_hashq_set_x (properties_whash, obj, scm_assq_remove_x (alist, prop));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME