summaryrefslogtreecommitdiff
path: root/libguile/goops.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-07-07 12:45:30 +0200
committerAndy Wingo <wingo@pobox.com>2011-07-07 13:02:59 +0200
commitae88d9bcf622baa6745a91fafb9be2fb331ad6c0 (patch)
treedb70454c578eec9793ce38b4b8e5cb7303db2bc7 /libguile/goops.c
parent319dd08936ec2d14272f68c16f778c411ed4b505 (diff)
downloadguile-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.c15
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 */