Bug #104055 for MooseX-Clone: Copy trait does not honor init_args when $proto didn't original have the attribute

Tue Apr 28 15:57:33 2015 BBYRD [...] cpan.org - Ticket created

Subject:

Copy trait does not honor init_args when $proto didn't original have the attribute

Example: package Thing; use Moose; with 'MooseX::Clone'; has foo => ( is => 'rw', traits => ['Copy'], lazy_build => 1 ); package main; my $obj = Thing->new(); # foo was never defined my $copy = $obj->clone( foo => [ 1,2,3 ] ); warn "has_foo: ".$copy->has_foo; # returns false; this is bad $obj = Thing->new( foo => [4,5,6] ); # foo was never defined $copy = $obj->clone( foo => [ 1,2,3 ] ); warn "has_foo: ".$copy->has_foo; # returns true; this is expected warn "foo[0]: ".$copy->foo->[0]; ####################################### This behavior goes against the Clone trait, StorableClone trait, and default behavior of MooseX::Clone. The ::Copy::clone_value method is returning too soon after checking has_value.

Mon May 04 20:23:51 2015 ether [...] cpan.org - Correspondence added

On 2015-04-28 12:57:33, BBYRD wrote: ... Show quoted text

> This behavior goes against the Clone trait, StorableClone trait, and > default behavior of MooseX::Clone. The ::Copy::clone_value method is > returning too soon after checking has_value.

I'm afraid I don't know this code at all. Patches welcome.

Mon May 04 20:23:52 2015 The RT System itself - Status changed from 'new' to 'open'

Fri May 15 18:04:20 2015 BBYRD [...] cpan.org - Correspondence added

On Mon May 04 20:23:51 2015, ETHER wrote: Show quoted text

> > I'm afraid I don't know this code at all. Patches welcome.

Patch attached, including changes to the test to detect the issue.

Subject:

RT104055.patch

diff -rbu MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm MooseX-Clone-0.05_patch/lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm --- MooseX-Clone-0.05/lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm 2009-04-11 11:53:03.000000000 -0400 +++ MooseX-Clone-0.05_patch/lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm 2015-05-08 11:21:36.637167181 -0400 @@ -14,9 +14,13 @@ sub clone_value { my ( $self, $target, $proto, %args ) = @_; + if (exists $args{init_arg}) { + return $self->set_value( $target, $args{init_arg} ); + } + return unless $self->has_value($proto); - my $clone = exists $args{init_arg} ? $args{init_arg} : $self->_copy_ref($self->get_value($proto)); + my $clone = $self->_copy_ref($self->get_value($proto)); $self->set_value( $target, $clone ); } diff -rbu MooseX-Clone-0.05/t/01_basic.t MooseX-Clone-0.05_patch/t/01_basic.t --- MooseX-Clone-0.05/t/01_basic.t 2009-04-27 08:40:39.000000000 -0400 +++ MooseX-Clone-0.05_patch/t/01_basic.t 2015-05-08 11:12:04.347616964 -0400 @@ -36,6 +36,7 @@ traits => [qw(Copy)], isa => "HashRef", is => "rw", + predicate => 'has_flar', ); has blorg => ( @@ -75,7 +76,7 @@ is( $bar->foo->some_attr, 'def', "default value for other attr" ); -my $copy = $bar->clone; +my $copy = $bar->clone( flar => { blog => [1,2,3] } ); isnt( refaddr($bar), refaddr($copy), "copy" ); @@ -89,6 +90,8 @@ isnt( refaddr($bar->foo), refaddr($copy->foo), "copy" ); is( refaddr($bar->same), refaddr($copy->same), "copy" ); +ok( $copy->has_flar, "flar was inserted" ); + is( $copy->clone( foo => { some_attr => "laaa" } )->foo->some_attr, "laaa", "Value carried over to recursive call to clone" ); {

Fri May 15 18:55:31 2015 ether [...] cpan.org - Taken

Sat May 23 18:35:09 2015 ether [...] cpan.org - Correspondence added

Thanks, patch applied in version 0.06!

Sat May 23 18:35:19 2015 ether [...] cpan.org - Status changed from 'open' to 'resolved'

Sat May 23 21:54:17 2015 ether [...] cpan.org - Fixed in 0.06 added