r50881 - in /branches/upstream/libmoosex-clone-perl/current: Changes MANIFEST META.yml SIGNATURE lib/MooseX/Clone.pm lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm t/01_basic.t t/02_auto_deref.t t/basic.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Jan 13 19:47:10 UTC 2010
Author: jawnsy-guest
Date: Wed Jan 13 19:47:05 2010
New Revision: 50881
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=50881
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-clone-perl (0.05)
Added:
branches/upstream/libmoosex-clone-perl/current/t/01_basic.t
branches/upstream/libmoosex-clone-perl/current/t/02_auto_deref.t
Removed:
branches/upstream/libmoosex-clone-perl/current/t/basic.t
Modified:
branches/upstream/libmoosex-clone-perl/current/Changes
branches/upstream/libmoosex-clone-perl/current/MANIFEST
branches/upstream/libmoosex-clone-perl/current/META.yml
branches/upstream/libmoosex-clone-perl/current/SIGNATURE
branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone.pm
branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm
branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm
Modified: branches/upstream/libmoosex-clone-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/Changes?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/Changes (original)
+++ branches/upstream/libmoosex-clone-perl/current/Changes Wed Jan 13 19:47:05 2010
@@ -1,3 +1,7 @@
+0.05
+ - Fix cloning for attrs when init_arg is passed under Clone trait
+ - auto_deref related fixes (Evan Carroll)
+
0.04
- update code to call get_all_attributes instead of compute_all_applicable_attributes
- more tests
Modified: branches/upstream/libmoosex-clone-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/MANIFEST?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-clone-perl/current/MANIFEST Wed Jan 13 19:47:05 2010
@@ -9,6 +9,7 @@
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
-t/basic.t
+t/01_basic.t
+t/02_auto_deref.t
META.yml Module meta-data (added by MakeMaker)
SIGNATURE Public-key signature (added by MakeMaker)
Modified: branches/upstream/libmoosex-clone-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/META.yml?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-clone-perl/current/META.yml Wed Jan 13 19:47:05 2010
@@ -1,11 +1,13 @@
--- #YAML:1.0
name: MooseX-Clone
-version: 0.04
+version: 0.05
abstract: ~
author: []
license: unknown
distribution_type: module
configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
ExtUtils::MakeMaker: 0
requires:
Data::Visitor: 0.24
@@ -17,7 +19,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/libmoosex-clone-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/SIGNATURE?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/SIGNATURE (original)
+++ branches/upstream/libmoosex-clone-perl/current/SIGNATURE Wed Jan 13 19:47:05 2010
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.55.
+signed via the Module::Signature module, version 0.61.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -14,23 +14,24 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 b36f3898dd9358e3e5b76b62e58d6a8d32247812 Changes
-SHA1 7a31a27495af5eae99be90988845c48bf6029858 MANIFEST
+SHA1 233d63545de8f2c778f145e0bfe27fe1d76fdd68 Changes
+SHA1 e9684f5d7fff2575dd1f8a45d6db3965a29b7e76 MANIFEST
SHA1 190e9058eb9c6446a1a3f3ddf15b082f1ecde152 MANIFEST.SKIP
-SHA1 0a9a49d66956c876ace1c8ff28af274119862c91 META.yml
+SHA1 ef1412820bfe9d3c8ae4d42744b99d25e816cf14 META.yml
SHA1 c2d2e660d73bc6dc4f78da56245cb9fb25647193 Makefile.PL
-SHA1 cda3f1decabbbdab02965c393e16aa59f8384354 lib/MooseX/Clone.pm
-SHA1 c62288b14873bcf3c0f28430b796bda209da9e96 lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm
+SHA1 b7cef6bdf11a249feaacfc20855bb64b04e1fda9 lib/MooseX/Clone.pm
+SHA1 18bc51be816c7d0e2259b4516e5230945e12ec74 lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm
SHA1 e91991fef9bc32c3ec9062f4584b27f248534cee lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Base.pm
-SHA1 1f32bf8a2e43675f8e1e74c2962f2491e2aeac52 lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm
+SHA1 2032a4a9ade9579d1649fd1568e61157ba15be04 lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm
SHA1 4a2a6440466154abd02b09b72e7759d3d724ab84 lib/MooseX/Clone/Meta/Attribute/Trait/Copy.pm
SHA1 8d4bd7f05e74d25115c1558f6ef5f97ffe8ce0ab lib/MooseX/Clone/Meta/Attribute/Trait/NoClone.pm
SHA1 d4a8de859dccee4a2f90f02e3af857562f765133 lib/MooseX/Clone/Meta/Attribute/Trait/StorableClone.pm
-SHA1 96c97f40ff26f572bccbb05bd7b2ddde9b908214 t/basic.t
+SHA1 96c97f40ff26f572bccbb05bd7b2ddde9b908214 t/01_basic.t
+SHA1 f7deeef5e8d2c41e6090644e59ef69f9afad5a72 t/02_auto_deref.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.7 (Darwin)
+Version: GnuPG/MacGPG2 v2.0.12 (Darwin)
-iD8DBQFJ7LGyVCwRwOvSdBgRAmK4AJ0SUuwN4874Df9a1xpTlV64hhZ/rACfVjn4
-kmnIcG/IqB7F9YRfVpuVPqw=
-=9OFe
+iEYEARECAAYFAktODDIACgkQVCwRwOvSdBgC8ACdHAWMj7Z/Ju8KXmo1svDjkiY3
+ZY4AnRwXhW+yXSWPHzzyY2FNO+4/EcME
+=0S8Q
-----END PGP SIGNATURE-----
Modified: branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone.pm?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone.pm (original)
+++ branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone.pm Wed Jan 13 19:47:05 2010
@@ -3,7 +3,7 @@
package MooseX::Clone;
use Moose::Role;
-our $VERSION = "0.04";
+our $VERSION = "0.05";
use Hash::Util::FieldHash::Compat qw(idhash);
Modified: branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm (original)
+++ branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone.pm Wed Jan 13 19:47:05 2010
@@ -7,7 +7,7 @@
use namespace::clean -except => 'meta';
-with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Std);
+with qw(MooseX::Clone::Meta::Attribute::Trait::Clone::Base);
sub Moose::Meta::Attribute::Custom::Trait::Clone::register_implementation { __PACKAGE__ }
@@ -41,19 +41,38 @@
);
}
+sub clone_value {
+ my ( $self, $target, $proto, @args ) = @_;
+
+ if ( $self->has_value($proto) ) {
+ my $clone = $self->clone_value_data( scalar($self->get_value($proto)), @args );
+
+ $self->set_value( $target, $clone );
+ } else {
+ my %args = @args;
+
+ if ( exists $args{init_arg} ) {
+ $self->set_value( $target, $args{init_arg} );
+ }
+ }
+}
+
sub clone_value_data {
my ( $self, $value, @args ) = @_;
if ( blessed($value) ) {
- $self->clone_object_value($value, @args);
+ return $self->clone_object_value($value, @args);
} else {
- unless ( $self->clone_only_objects ) {
- $self->clone_any_value($value, @args);
+ my %args = @args;
+
+ if ( exists $args{init_arg} ) {
+ return $args{init_arg};
} else {
- my %args = @args;
- return exists $args{init_arg}
- ? $args{init_arg} # taken as a literal value
- : $value;
+ unless ( $self->clone_only_objects ) {
+ return $self->clone_any_value($value, @args);
+ } else {
+ return $value;
+ }
}
}
}
@@ -85,7 +104,7 @@
}
sub clone_any_value {
- my ( $self, $value, @args ) = @_;
+ my ( $self, $value, %args ) = @_;
$self->clone_visitor->visit($value);
}
Modified: branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm?rev=50881&op=diff
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm (original)
+++ branches/upstream/libmoosex-clone-perl/current/lib/MooseX/Clone/Meta/Attribute/Trait/Clone/Std.pm Wed Jan 13 19:47:05 2010
@@ -8,13 +8,17 @@
requires qw(clone_value_data);
sub clone_value {
- my ( $self, $target, $proto, @args ) = @_;
+ my ( $self, $target, $proto, %args ) = @_;
- return unless $self->has_value($proto);
+ if ( exists $args{init_arg} ) {
+ $self->set_value( $target, $args{init_arg} );
+ } else {
+ return unless $self->has_value($proto);
- my $clone = $self->clone_value_data( $self->get_value($proto), @args );
+ my $clone = $self->clone_value_data( scalar($self->get_value($proto)), %args );
- $self->set_value( $target, $clone );
+ $self->set_value( $target, $clone );
+ }
}
__PACKAGE__
Added: branches/upstream/libmoosex-clone-perl/current/t/01_basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/t/01_basic.t?rev=50881&op=file
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/t/01_basic.t (added)
+++ branches/upstream/libmoosex-clone-perl/current/t/01_basic.t Wed Jan 13 19:47:05 2010
@@ -1,0 +1,122 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Scalar::Util qw(refaddr);
+
+{
+ package Bar;
+ use Moose;
+
+ with qw(MooseX::Clone);
+
+ has foo => (
+ traits => [qw(Clone)],
+ isa => "Foo|HashRef",
+ is => "rw",
+ default => sub { Foo->new },
+ );
+
+ has same => (
+ isa => "Foo",
+ is => "rw",
+ default => sub { Foo->new },
+ );
+
+ has floo => (
+ traits => [qw(NoClone)],
+ isa => "Int",
+ is => "rw",
+ );
+
+ has flar => (
+ traits => [qw(Copy)],
+ isa => "HashRef",
+ is => "rw",
+ );
+
+ has blorg => (
+ traits => [qw(StorableClone)],
+ is => "rw",
+ );
+
+ package Foo;
+ use Moose;
+
+ has copy_number => (
+ isa => "Int",
+ is => "ro",
+ default => 0,
+ );
+
+ has some_attr => ( is => "rw", default => "def" );
+
+ sub clone {
+ my ( $self, %params ) = @_;
+
+ $self->meta->clone_object( $self, %params, copy_number => $self->copy_number + 1 );
+ }
+}
+
+
+my $bar = Bar->new( floo => 3 );
+
+isa_ok( $bar, "Bar" );
+isa_ok( $bar->foo, "Foo" );
+isa_ok( $bar->same, "Foo" );
+
+is( $bar->floo, 3, "explicit init_arg" );
+
+is( $bar->foo->copy_number, 0, "first copy" );
+is( $bar->same->copy_number, 0, "first copy" );
+
+is( $bar->foo->some_attr, 'def', "default value for other attr" );
+
+my $copy = $bar->clone;
+
+isnt( refaddr($bar), refaddr($copy), "copy" );
+
+is( $copy->floo, undef, "NoClone" );
+
+is( $copy->foo->copy_number, 1, "copy number incremented" );
+is( $copy->same->copy_number, 0, "not incremented for uncloned attr" );
+
+is( $copy->foo->some_attr, 'def', "default value for other attr" );
+
+isnt( refaddr($bar->foo), refaddr($copy->foo), "copy" );
+is( refaddr($bar->same), refaddr($copy->same), "copy" );
+
+is( $copy->clone( foo => { some_attr => "laaa" } )->foo->some_attr, "laaa", "Value carried over to recursive call to clone" );
+
+{
+ my $hash = { foo => Foo->new };
+ my $hash_copy = Bar->new( foo => $hash )->clone->foo;
+
+ isnt( refaddr($hash), refaddr($hash_copy), "hash copied" );
+ is_deeply( [ sort keys %$hash ], [ sort keys %$hash_copy ], "hash keys exist in clone" );
+ isa_ok($hash_copy->{foo}, "Foo");
+ isnt( refaddr($hash->{foo}), refaddr($hash_copy->{foo}), "foo inside hash cloned too" );
+ is( $hash_copy->{foo}->copy_number, 1, "copy number" );
+}
+
+{
+ my $hash = { foo => Foo->new, bar => [] };
+ my $hash_copy = Bar->new( flar => $hash )->clone->flar;
+
+ isnt( refaddr($hash), refaddr($hash_copy), "hash copied" );
+ is_deeply( [ sort keys %$hash ], [ sort keys %$hash_copy ], "hash keys exist in clone" );
+ isa_ok($hash_copy->{foo}, "Foo");
+ is( refaddr($hash->{foo}), refaddr($hash_copy->{foo}), "foo inside hash not cloned" );
+ is( refaddr($hash->{bar}), refaddr($hash_copy->{bar}), "array inside hash not cloned" );
+}
+
+{
+ my $foo = Foo->new;
+ my $foo_copy = Bar->new( blorg => $foo )->clone->blorg;
+
+ isnt( refaddr($foo), refaddr($foo_copy), "foo copied" );
+ is( $foo_copy->copy_number, $foo->copy_number, "but not using ->clone");
+}
Added: branches/upstream/libmoosex-clone-perl/current/t/02_auto_deref.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-clone-perl/current/t/02_auto_deref.t?rev=50881&op=file
==============================================================================
--- branches/upstream/libmoosex-clone-perl/current/t/02_auto_deref.t (added)
+++ branches/upstream/libmoosex-clone-perl/current/t/02_auto_deref.t Wed Jan 13 19:47:05 2010
@@ -1,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+{
+
+ package Foo;
+ use Moose;
+ with 'MooseX::Clone';
+
+ has 'arr_ref' => (
+ isa => 'ArrayRef',
+ is => 'ro',
+ default => sub { [qw/foo bar baz/] },
+ traits => [qw/Clone/]
+ );
+
+ package Bar;
+ use Moose;
+ with 'MooseX::Clone';
+
+ has 'arr_ref' => (
+ isa => 'ArrayRef',
+ is => 'ro',
+ auto_deref => 1,
+ default => sub { [qw/foo bar baz/] },
+ traits => [qw/Clone/]
+ );
+
+ package Baz;
+ use Moose;
+ with 'MooseX::Clone';
+
+ has 'arr_ref' => (
+ isa => 'ArrayRef',
+ is => 'ro',
+ auto_deref => 1,
+ default => sub { [qw/foo bar/] },
+ traits => [qw/Clone/]
+ );
+}
+
+eval { Foo->new->clone };
+ok( !$@, 'cloning simple obj with a ArrayRef' );
+
+my $clone = eval { Bar->new->clone };
+ok( !$@, 'cloning simple obj with a ArrayRef (3 elements) and auto_deref' );
+ok( $clone, "got a clone" );
+is_deeply( eval { [ $clone->arr_ref ] }, [qw(foo bar baz)], "value cloned properly" );
+
+eval { Bar->new->clone };
+ok( !$@, 'cloning simple obj with a ArrayRef (2 elements) and auto_deref' );
More information about the Pkg-perl-cvs-commits
mailing list