diff options
author | Andy Wingo <wingo@pobox.com> | 2011-07-07 12:21:48 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-07-07 13:02:45 +0200 |
commit | 319dd08936ec2d14272f68c16f778c411ed4b505 (patch) | |
tree | ac3151333544cb24e9b90e1173179b5e247df3cc | |
parent | a8c10aa131eb5dd104f134d2ed66afe225fea8e6 (diff) | |
download | guile-319dd08936ec2d14272f68c16f778c411ed4b505.tar.gz |
fix invocation of duplicate handlers for merge-generics
* libguile/modules.c (resolve_duplicate_binding): Fix unbound -> #f
conversion for the imported bindings. Pass the existing entry in the
import obarray as the resolved var (7th arg), and properly pass #f as
the value (8th arg) if there is no such binding. Fixes
merge-generics; before, the <boolean> type test (indicating no
previous value) was not being triggered. This bug has been present
since 2007 at least, though it was not in 1.8.
* test-suite/tests/modules.test ("duplicate bindings"): Add a test that
the var and val are both #f. These types are used by GOOPS.
-rw-r--r-- | libguile/modules.c | 75 | ||||
-rw-r--r-- | test-suite/tests/modules.test | 4 |
2 files changed, 48 insertions, 31 deletions
diff --git a/libguile/modules.c b/libguile/modules.c index ca8875dab..6c3f2629e 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -294,39 +294,46 @@ resolve_duplicate_binding (SCM module, SCM sym, SCM iface1, SCM var1, SCM iface2, SCM var2) { + SCM args[8]; + SCM handlers; SCM result = SCM_BOOL_F; - if (!scm_is_eq (var1, var2)) + if (scm_is_eq (var1, var2)) + return var1; + + args[0] = module; + args[1] = sym; + args[2] = iface1; + args[3] = SCM_VARIABLE_REF (var1); + if (SCM_UNBNDP (args[3])) + args[3] = SCM_BOOL_F; + args[4] = iface2; + args[5] = SCM_VARIABLE_REF (var2); + if (SCM_UNBNDP (args[5])) + args[5] = SCM_BOOL_F; + args[6] = scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_BOOL_F); + args[7] = SCM_BOOL_F; + + handlers = SCM_MODULE_DUPLICATE_HANDLERS (module); + if (scm_is_false (handlers)) + handlers = default_duplicate_binding_handlers (); + + for (; scm_is_pair (handlers); handlers = SCM_CDR (handlers)) { - SCM val1, val2; - SCM handlers, h, handler_args; - - val1 = SCM_VARIABLE_REF (var1); - val2 = SCM_VARIABLE_REF (var2); - - val1 = scm_is_eq (val1, SCM_UNSPECIFIED) ? SCM_BOOL_F : val1; - val2 = scm_is_eq (val2, SCM_UNSPECIFIED) ? SCM_BOOL_F : val2; - - handlers = SCM_MODULE_DUPLICATE_HANDLERS (module); - if (scm_is_false (handlers)) - handlers = default_duplicate_binding_handlers (); - - handler_args = scm_list_n (module, sym, - iface1, val1, iface2, val2, - var1, val1, - SCM_UNDEFINED); - - for (h = handlers; - scm_is_pair (h) && scm_is_false (result); - h = SCM_CDR (h)) - { - result = scm_apply (SCM_CAR (h), handler_args, SCM_EOL); - } + if (scm_is_true (args[6])) + { + args[7] = SCM_VARIABLE_REF (args[6]); + if (SCM_UNBNDP (args[7])) + args[7] = SCM_BOOL_F; + } + + result = scm_call_n (SCM_CAR (handlers), args, 8); + + if (scm_is_true (result)) + return result; } - else - result = var1; - return result; + return SCM_BOOL_F; } /* No lock is needed for access to this variable, as there are no @@ -368,9 +375,15 @@ module_imported_variable (SCM module, SCM sym) { /* SYM is a duplicate binding (imported more than once) so we need to resolve it. */ - found_var = resolve_duplicate_binding (module, sym, - found_iface, found_var, - iface, var); + found_var = resolve_duplicate_binding (module, sym, + found_iface, found_var, + iface, var); + + /* Note that it could be that FOUND_VAR doesn't belong + either to FOUND_IFACE or to IFACE, if it was created + by merge-generics. The right thing to do there would + be to treat the import obarray as the iface, but the + import obarray isn't actually a module. Oh well. */ if (scm_is_eq (found_var, var)) found_iface = iface; } diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test index 5f34d9e70..79e3c98e9 100644 --- a/test-suite/tests/modules.test +++ b/test-suite/tests/modules.test @@ -290,6 +290,10 @@ (import2 (make-module)) (handler-invoked? #f) (handler (lambda (module name int1 val1 int2 val2 var val) + ;; We expect both VAR and VAL to be #f, as there + ;; is no previous binding for 'imported in M. + (if var (error "unexpected var" var)) + (if val (error "unexpected val" val)) (set! handler-invoked? #t) ;; Keep the first binding. (or var (module-local-variable int1 name))))) |