diff options
author | Andy Wingo <wingo@pobox.com> | 2011-07-07 12:45:30 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-07-07 13:02:59 +0200 |
commit | ae88d9bcf622baa6745a91fafb9be2fb331ad6c0 (patch) | |
tree | db70454c578eec9793ce38b4b8e5cb7303db2bc7 /libguile/goops.c | |
parent | 319dd08936ec2d14272f68c16f778c411ed4b505 (diff) | |
download | guile-ae88d9bcf622baa6745a91fafb9be2fb331ad6c0.tar.gz |
fix CPL of <extended-generic-with-setter> and <extended-accessor>
* libguile/goops.c (fix_cpl): Fix bug in placement of debug assertion.
(create_standard_classes): Put <extended-generic> before
<generic-with-setter> in <extended-generic-with-setter>'s direct
supers, so that the slot allocation is a superset of
<generic-with-setter>, which results in the `setter' being allocated
in the same place.
Likewise fix <extended-accessor> to place <extended-generic> before
<generic-with-setter>, not just <generic>.
Diffstat (limited to 'libguile/goops.c')
-rw-r--r-- | libguile/goops.c | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/libguile/goops.c b/libguile/goops.c index dfe26c30d..c2eb88ffe 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -2280,15 +2280,21 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0, * ******************************************************************************/ +/* Munge the CPL of C in place such that BEFORE appears before AFTER, + assuming that currently the reverse is true. Recalculate slots and + associated getters-n-setters. */ static void fix_cpl (SCM c, SCM before, SCM after) { SCM cpl = SCM_SLOT (c, scm_si_cpl); SCM ls = scm_c_memq (after, cpl); - SCM tail = scm_delq1_x (before, SCM_CDR (ls)); + SCM tail; + if (scm_is_false (ls)) /* if this condition occurs, fix_cpl should not be applied this way */ abort (); + + tail = scm_delq1_x (before, SCM_CDR (ls)); SCM_SETCAR (ls, before); SCM_SETCDR (ls, scm_cons (after, tail)); { @@ -2414,8 +2420,8 @@ create_standard_classes (void) make_stdcls (&scm_class_extended_generic_with_setter, "<extended-generic-with-setter>", scm_class_applicable_struct_class, - scm_list_2 (scm_class_generic_with_setter, - scm_class_extended_generic), + scm_list_2 (scm_class_extended_generic, + scm_class_generic_with_setter), SCM_EOL); SCM_SET_CLASS_FLAGS (scm_class_extended_generic_with_setter, SCM_CLASSF_PURE_GENERIC); @@ -2424,8 +2430,9 @@ create_standard_classes (void) scm_list_2 (scm_class_accessor, scm_class_extended_generic_with_setter), SCM_EOL); + /* <extended-generic> is misplaced. */ fix_cpl (scm_class_extended_accessor, - scm_class_extended_generic, scm_class_generic); + scm_class_extended_generic, scm_class_generic_with_setter); SCM_SET_CLASS_FLAGS (scm_class_extended_accessor, SCM_CLASSF_PURE_GENERIC); /* Primitive types classes */ |