Add clone_instance() method to mop_instance_vtbl

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index a27024b..96dac22 100644 (file)
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -75,10 +75,10 @@ sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
 #    bless {}, $self->_class_name;
 #}
 
-sub clone_instance {
-    my ($self, $instance) = @_;
-    bless { %$instance }, $self->_class_name;
-}
+#sub clone_instance {
+#    my ($self, $instance) = @_;
+#    bless { %$instance }, $self->_class_name;
+#}
 
 # operations on meta instance
 

diff --git a/mop.h b/mop.h
index 45c50aa..d2c630e 100644 (file)
--- a/mop.h
+++ b/mop.h
@@ -99,6 +99,7 @@ AV* mop_class_get_all_attributes(pTHX_ SV* const metaclass);
 
 typedef struct {
     SV*  (*create_instance)(pTHX_ HV* const stash);
+    SV*  (*clone_instance) (pTHX_ SV* const instance);
     bool (*has_slot)       (pTHX_ SV* const mi, SV* const instance);
     SV*  (*get_slot)       (pTHX_ SV* const mi, SV* const instance);
     SV*  (*set_slot)       (pTHX_ SV* const mi, SV* const instance, SV* const value);
@@ -109,7 +110,7 @@ typedef struct {
 /* Class::MOP::Instance stuff */
 
 SV*  mop_instance_create     (pTHX_ HV* const stash);
-SV*  mop_instance_slot       (pTHX_ SV* const meta_instance, SV* const attr);
+SV*  mop_instance_clone      (pTHX_ SV* const instance);
 bool mop_instance_has_slot   (pTHX_ SV* const instance, SV* const slot);
 SV*  mop_instance_get_slot   (pTHX_ SV* const instance, SV* const slot);
 SV*  mop_instance_set_slot   (pTHX_ SV* const instance, SV* const slot, SV* const value);
@@ -127,6 +128,7 @@ const mop_instance_vtbl* mop_get_default_instance_vtbl(pTHX);
 #define MOP_mg_obj_refcounted_on(mg)    (void)((mg)->mg_flags |= MGf_REFCOUNTED);
 
 #define MOP_mg_create_instance(mg, stash) MOP_mg_vtbl(mg)->create_instance (aTHX_ (stash))
+#define MOP_mg_clone_instance(mg, o)      MOP_mg_vtbl(mg)->clone_instance  (aTHX_ (o))
 #define MOP_mg_has_slot(mg, o, slot)      MOP_mg_vtbl(mg)->has_slot        (aTHX_ (o), (slot))
 #define MOP_mg_get_slot(mg, o, slot)      MOP_mg_vtbl(mg)->get_slot        (aTHX_ (o), (slot))
 #define MOP_mg_set_slot(mg, o, slot, v)   MOP_mg_vtbl(mg)->set_slot        (aTHX_ (o), (slot), (v))

diff --git a/xs/Instance.xs b/xs/Instance.xs
index 665b438..4d095ef 100644 (file)
--- a/xs/Instance.xs
+++ b/xs/Instance.xs
@@ -12,6 +12,18 @@ mop_instance_create(pTHX_ HV* const stash) {
     return sv_bless( newRV_noinc((SV*)newHV()), stash );
 }
 
+SV*
+mop_instance_clone(pTHX_ SV* const instance) {
+    HV* proto;
+    assert(instance);
+
+    CHECK_INSTANCE(instance);
+    proto = newHVhv((HV*)SvRV(instance));
+    return sv_bless( newRV_noinc((SV*)proto), SvSTASH(SvRV(instance)) );
+}
+
+
+
 bool
 mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
     assert(instance);
@@ -66,6 +78,7 @@ mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
 
 static const mop_instance_vtbl mop_default_instance = {
     mop_instance_create,
+    mop_instance_clone,
     mop_instance_has_slot,
     mop_instance_get_slot,
     mop_instance_set_slot,
@@ -116,6 +129,14 @@ CODE:
 OUTPUT:
     RETVAL
 
+SV*
+clone_instance(SV* self, SV* instance)
+CODE:
+    PERL_UNUSED_VAR(self);
+    RETVAL = mop_instance_clone(aTHX_ instance);
+OUTPUT:
+    RETVAL
+
 bool
 is_slot_initialized(SV* self, SV* instance, SV* slot)
 CODE: