Skip Menu |
 

This queue is for tickets about the MooseX-Clone CPAN distribution.

Report information
The Basics
Id: 104055
Status: resolved
Priority: 0/
Queue: MooseX-Clone

People
Owner: ether [...] cpan.org
Requestors: BBYRD [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: 0.05
Fixed in: 0.06



Subject: Copy trait does not honor init_args when $proto didn't original have the attribute
Download (untitled) / with headers
text/plain 724b
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.
Download (untitled) / with headers
text/plain 290b
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.
Download (untitled) / with headers
text/plain 173b
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
Download RT104055.patch
text/x-diff 1.7k
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" ); {
Thanks, patch applied in version 0.06!


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.