X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F031-clone.t;h=cc39e22b565b366dd305524cab3316431861c589;hb=8cf51b82d94aad02f81dc853be874e9a49a82c31;hp=9d7454fd26bc81bd917c68733b6b4c2f1880e4d0;hpb=eab815459cfd4be951f1f44cd656e76169f7a1d6;p=gitmo%2FMouse.git diff --git a/t/031-clone.t b/t/031-clone.t index 9d7454f..cc39e22 100644 --- a/t/031-clone.t +++ b/t/031-clone.t @@ -1,9 +1,10 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 12; use Test::Exception; +my %triggered; do { package Foo; use Mouse; @@ -27,6 +28,10 @@ do { has quux => ( is => 'rw', init_arg => 'quuux', + trigger => sub{ + my($self, $value) = @_; + $triggered{$self} = $value; + }, ); sub clone { @@ -39,11 +44,17 @@ my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed"); is($foo->foo, "foo", "attr 1",); is($foo->quux, "indeed", "init_arg respected"); + +is $triggered{$foo}, "indeed"; + is_deeply($foo->bar, [ 1 .. 3 ], "attr 2"); $foo->baz("foo"); my $clone = $foo->clone(foo => "dancing", baz => "bar", quux => "nope", quuux => "yes"); +is $triggered{$foo}, "indeed"; +is $triggered{$clone}, "yes", 'clone_object() invokes triggers'; + is($clone->foo, "dancing", "overridden attr"); is_deeply($clone->bar, [ 1 .. 3 ], "clone attr"); is($clone->baz, "foo", "init_arg=undef means the attr is ignored"); @@ -55,9 +66,6 @@ throws_ok { throws_ok { Foo->meta->clone_object(Foo->meta) -} qr/You must pass an instance of the metaclass \(Foo\), not \(Mo.se::Meta::Class=HASH\(\w+\)\)/; +} qr/You must pass an instance of the metaclass \(Foo\), not \(Mouse::Meta::Class=HASH\(\w+\)\)/; -throws_ok { - Foo->meta->clone_instance("constant") -} qr/You can only clone instances, \(constant\) is not a blessed instance/;