From: gfx <gfuji@cpan.org>
Date: Sun, 11 Apr 2010 02:11:46 +0000 (+0900)
Subject: Fix clone_object() to ignore hehaviours without init args
X-Git-Tag: 0.53~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cb6a9721f6d1bf6aaba58920378aad6c03524639;p=gitmo%2FMouse.git

Fix clone_object() to ignore hehaviours without init args
---

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 80f7af7..3b0dc31 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -238,7 +238,7 @@ sub clone_object {
         || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)");
 
     my $cloned = bless { %$object }, ref $object;
-    $class->_initialize_object($cloned, $args);
+    $class->_initialize_object($cloned, $args, 1);
 
     return $cloned;
 }
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index c803aff..90f12b0 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -280,7 +280,7 @@ sub new_object {
 }
 
 sub _initialize_object{
-    my($self, $object, $args, $ignore_triggers) = @_;
+    my($self, $object, $args, $is_cloning) = @_;
 
     my @triggers_queue;
 
@@ -298,7 +298,7 @@ sub _initialize_object{
                 push @triggers_queue, [ $attribute->trigger, $object->{$slot} ];
             }
         }
-        else { # no init arg
+        elsif(!$is_cloning) { # no init arg, noop while cloning
             if ($attribute->has_default || $attribute->has_builder) {
                 if (!$attribute->is_lazy) {
                     my $default = $attribute->default;
@@ -319,7 +319,7 @@ sub _initialize_object{
         }
     }
 
-    if(!$ignore_triggers){
+    if(@triggers_queue){
         foreach my $trigger_and_value(@triggers_queue){
             my($trigger, $value) = @{$trigger_and_value};
             $trigger->($object, $value);
diff --git a/t/001_mouse/031-clone.t b/t/001_mouse/031-clone.t
index cc39e22..6d5a052 100644
--- a/t/001_mouse/031-clone.t
+++ b/t/001_mouse/031-clone.t
@@ -1,11 +1,11 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More;
 use Test::Exception;
 
 my %triggered;
-do {
+{
     package Foo;
     use Mouse;
 
@@ -38,7 +38,24 @@ do {
         my ($self, @args) = @_;
         $self->meta->clone_object($self, @args);
     }
-};
+}
+
+{
+    package Bar;
+    use Mouse;
+
+    has id => (
+        is  => 'ro',
+        isa => 'Str',
+
+        required => 1,
+    );
+
+    sub clone {
+        my ($self, @args) = @_;
+        $self->meta->clone_object($self, @args);
+    }
+}
 
 my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed");
 
@@ -60,6 +77,13 @@ is_deeply($clone->bar, [ 1 .. 3 ], "clone attr");
 is($clone->baz, "foo", "init_arg=undef means the attr is ignored");
 is($clone->quux, "yes", "clone uses init_arg and not attribute name");
 
+lives_and {
+    my $bar = Bar->new(id => 'xyz');
+    my $c   = $bar->clone;
+
+    is_deeply $bar, $c, "clone() with required attributes";
+};
+
 throws_ok {
     Foo->meta->clone_object("constant");
 } qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/;
@@ -68,4 +92,4 @@ throws_ok {
     Foo->meta->clone_object(Foo->meta)
 } qr/You must pass an instance of the metaclass \(Foo\), not \(Mouse::Meta::Class=HASH\(\w+\)\)/;
 
-
+done_testing;
diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 619844b..f27c52f 100644
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -291,7 +291,7 @@ mouse_report_unknown_args(pTHX_ SV* const meta, AV* const attrs, HV* const args)
 
 
 static void
-mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const ignore_triggers) {
+mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const is_cloning) {
     AV* const xc    = mouse_get_xc(aTHX_ meta);
     AV* const attrs = MOUSE_xc_attrall(xc);
     I32 len         = AvFILLp(attrs) + 1;
@@ -307,10 +307,6 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
         croak("You cannot use tied HASH reference as initializing arguments");
     }
 
-    if(!ignore_triggers){
-        triggers_queue = newAV_mortal();
-    }
-
     /* for each attribute */
     for(i = 0; i < len; i++){
         SV* const attr = MOUSE_av_at(attrs, i);
@@ -330,16 +326,19 @@ mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const
             if(SvROK(value) && flags & MOUSEf_ATTR_IS_WEAK_REF){
                 weaken_slot(object, slot);
             }
-            if(flags & MOUSEf_ATTR_HAS_TRIGGER && triggers_queue){
+            if(flags & MOUSEf_ATTR_HAS_TRIGGER){
                 AV* const pair = newAV();
                 av_push(pair, newSVsv( mcall0s(attr, "trigger") ));
                 av_push(pair, newSVsv(value));
 
+                if(!triggers_queue) {
+                    triggers_queue = newAV_mortal();
+                }
                 av_push(triggers_queue, (SV*)pair);
             }
             used++;
         }
-        else { /* no init arg */
+        else if(!is_cloning){ /* no init arg, noop while cloning */
             if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){
                 if(!(flags & MOUSEf_ATTR_IS_LAZY)){
                     mouse_xa_set_default(aTHX_ xa, object);
@@ -584,10 +583,10 @@ OUTPUT:
     RETVAL
 
 void
-_initialize_object(SV* meta, SV* object, HV* args, bool ignore_triggers = FALSE)
+_initialize_object(SV* meta, SV* object, HV* args, bool is_cloning = FALSE)
 CODE:
 {
-    mouse_class_initialize_object(aTHX_ meta, object, args, ignore_triggers);
+    mouse_class_initialize_object(aTHX_ meta, object, args, is_cloning);
 }
 
 MODULE = Mouse  PACKAGE = Mouse::Meta::Role