diff options
| author | Andy Wingo <wingo@pobox.com> | 2014-04-27 11:02:35 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2014-04-27 11:02:35 +0200 |
| commit | 48ad85fb56bc022ac10f42cf07b5657d75b5b696 (patch) | |
| tree | 3523ccd6bfb489e6fcdc44d27b8d6d78dcee06d8 /libguile | |
| parent | fa1a30726dc28c58cb01594ae6df27e80d4c2f00 (diff) | |
Fix foreign slot initialization and access
* libguile/goops.c (scm_sys_initialize_object): Refactor initialization
so that we don't ref uninitialized slots before initializing them.
This allows foreign slots, whose initial value is 0, to be initialized
via #:init-form.
* module/oop/goops.scm (@slot-ref, @slot-set!): Remove definitions.
Change callers to use struct-ref and struct-set!. slot-ref and
slot-set! were only marginally more efficient and were much more
dangerous. This change allows the standard accessors to work on
foreign slots; that was not the case before, as the 'u' fields of the
struct were read as if they were 'p' slots.
* module/language/tree-il/compile-glil.scm (lambda): Remove support for
compiling @slot-ref/@slot-set!. These were private to GOOPS.
* test-suite/tests/goops.test ("active-slot"): Update to not expect a
ref before initialization.
("foreign slots"): Add tests.
Diffstat (limited to 'libguile')
| -rw-r--r-- | libguile/goops.c | 20 |
1 files changed, 8 insertions, 12 deletions
diff --git a/libguile/goops.c b/libguile/goops.c index 4a2e24d24..884b4b673 100644 --- 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 * 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); - SCM slot_value = SCM_PACK (0); + SCM slot_value = SCM_GOOPS_UNBOUND; 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, - SCM_PACK (0), + SCM_GOOPS_UNBOUND, 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 @@ -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)) - { - 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)); } } |