Make clone_object() into PurePerl

[gitmo/Mouse.git] / xs-src / Mouse.xs

diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 5c7e623..8033635 100644 (file)
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -338,13 +338,15 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
             }
             used++;
         }
-        else if(!is_cloning){ /* no init arg, noop while cloning */
+        else { /* no init arg */
             if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){
-                if(!(flags & MOUSEf_ATTR_IS_LAZY)){
+                /* skip if the object has the slot (it occurs on cloning/reblessing) */
+                if(!(flags & MOUSEf_ATTR_IS_LAZY) && !has_slot(object, slot)){
                     mouse_xa_set_default(aTHX_ xa, object);
                 }
             }
-            else if(flags & MOUSEf_ATTR_IS_REQUIRED) {
+            /* don't check while cloning (or reblesseing) */
+            else if(!is_cloning && flags & MOUSEf_ATTR_IS_REQUIRED) {
                 mouse_throw_error(attr, NULL, "Attribute (%"SVf") is required", slot);
             }
         }
@@ -578,10 +580,31 @@ CODE:
 
     RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
     mouse_class_initialize_object(aTHX_ meta, RETVAL, args, FALSE);
+    mouse_buildall(aTHX_ xc, RETVAL, sv_2mortal(newRV_inc((SV*)args))); /* BUILDALL */
 }
 OUTPUT:
     RETVAL
 
+SV*
+clone_object(SV* meta, SV* object, ...)
+CODE:
+{
+    AV* const xc   = mouse_get_xc(aTHX_ meta);
+    HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax + 1, items - 1);
+
+    if(!mouse_is_an_instance_of(aTHX_ MOUSE_xc_stash(xc), object)) {
+        mouse_throw_error(meta, object,
+            "You must pass an instance of the metaclass (%"SVf"), not (%"SVf")",
+            mcall0(meta, mouse_name), object);
+    }
+
+    RETVAL = mouse_instance_clone(aTHX_ object);
+    mouse_class_initialize_object(aTHX_ meta, RETVAL, args, TRUE);
+}
+OUTPUT:
+    RETVAL
+
+
 void
 _initialize_object(SV* meta, SV* object, HV* args, bool is_cloning = FALSE)
 CODE:
@@ -671,8 +694,7 @@ CODE:
     /* new_object */
     RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
     mouse_class_initialize_object(aTHX_ meta, RETVAL, (HV*)SvRV(args), FALSE);
-
-    mouse_buildall(aTHX_ xc, RETVAL, args);
+    mouse_buildall(aTHX_ xc, RETVAL, args); /* BUILDALL */
 }
 OUTPUT:
     RETVAL