HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Accessor methods only apply to subclasses with their slot
[bpt/guile.git]
/
libguile
/
goops.c
diff --git
a/libguile/goops.c
b/libguile/goops.c
index
f4b2b34
..
9fd61b5
100644
(file)
--- a/
libguile/goops.c
+++ b/
libguile/goops.c
@@
-1,4
+1,4
@@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
,2014,2015
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@
-659,7
+659,7
@@
SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots))
{
SCM slot_name = SCM_CAR (slots);
get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots))
{
SCM slot_name = SCM_CAR (slots);
- SCM slot_value = SCM_
PACK (0)
;
+ SCM slot_value = SCM_
GOOPS_UNBOUND
;
if (!scm_is_null (SCM_CDR (slot_name)))
{
if (!scm_is_null (SCM_CDR (slot_name)))
{
@@
-683,12
+683,12
@@
SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
slot_value = scm_i_get_keyword (tmp,
initargs,
n_initargs,
slot_value = scm_i_get_keyword (tmp,
initargs,
n_initargs,
- SCM_
PACK (0)
,
+ SCM_
GOOPS_UNBOUND
,
FUNC_NAME);
}
}
FUNC_NAME);
}
}
- if (
SCM_UNPACK
(slot_value))
+ if (
!SCM_GOOPS_UNBOUNDP
(slot_value))
/* set slot to provided value */
set_slot_value (class, obj, SCM_CAR (get_n_set), slot_value);
else
/* set slot to provided value */
set_slot_value (class, obj, SCM_CAR (get_n_set), slot_value);
else
@@
-696,14
+696,10
@@
SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
/* set slot to its :init-form if it exists */
tmp = SCM_CADAR (get_n_set);
if (scm_is_true (tmp))
/* set slot to its :init-form if it exists */
tmp = SCM_CADAR (get_n_set);
if (scm_is_true (tmp))
- {
- slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
- if (SCM_GOOPS_UNBOUNDP (slot_value))
- set_slot_value (class,
- obj,
- SCM_CAR (get_n_set),
- scm_call_0 (tmp));
- }
+ set_slot_value (class,
+ obj,
+ SCM_CAR (get_n_set),
+ scm_call_0 (tmp));
}
}
}
}
@@
-982,7
+978,7
@@
create_basic_classes (void)
/**** <class> ****/
SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT);
SCM name = scm_from_latin1_symbol ("<class>");
/**** <class> ****/
SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT);
SCM name = scm_from_latin1_symbol ("<class>");
- scm_class_class = scm_
make_vtable_vtable (cs, SCM_INUM0, SCM_EOL
);
+ scm_class_class = scm_
i_make_vtable_vtable (cs
);
SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID
| SCM_CLASSF_METACLASS));
SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID
| SCM_CLASSF_METACLASS));
@@
-1763,15
+1759,22
@@
scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
}
return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
}
-SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
+static SCM delayed_compile_var;
+
+static void
+init_delayed_compile_var (void)
+{
+ delayed_compile_var
+ = scm_c_private_lookup ("oop goops dispatch", "delayed-compile");
+}
+
static SCM
make_dispatch_procedure (SCM gf)
{
static SCM
make_dispatch_procedure (SCM gf)
{
- static SCM var = SCM_BOOL_F;
- if (scm_is_false (var))
- var = scm_module_variable (scm_c_resolve_module ("oop goops dispatch"),
- sym_delayed_compile);
- return scm_call_1 (SCM_VARIABLE_REF (var), gf);
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_delayed_compile_var);
+
+ return scm_call_1 (scm_variable_ref (delayed_compile_var), gf);
}
static void
}
static void
@@
-2050,6
+2053,11
@@
sort_applicable_methods (SCM method_list, long size, SCM const *targs)
return scm_vector_to_list (vector);
}
return scm_vector_to_list (vector);
}
+static int
+is_accessor_method (SCM method) {
+ return SCM_IS_A_P (method, scm_class_accessor_method);
+}
+
SCM
scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
{
SCM
scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
{
@@
-2085,6
+2093,10
@@
scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l))
{
fl = SPEC_OF (SCM_CAR (l));
for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l))
{
fl = SPEC_OF (SCM_CAR (l));
+ /* Only accept accessors which match exactly in first arg. */
+ if ((scm_is_null (fl) || types[0] != SCM_CAR (fl))
+ && is_accessor_method (SCM_CAR (l)))
+ continue;
for (i = 0; ; i++, fl = SCM_CDR (fl))
{
if (SCM_INSTANCEP (fl)
for (i = 0; ; i++, fl = SCM_CDR (fl))
{
if (SCM_INSTANCEP (fl)