X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F031-clone.t;h=cc39e22b565b366dd305524cab3316431861c589;hb=b644ef5d28f6076859080482d8b44727c1410e1c;hp=fd9e5006e428edb3e03fbe64e70e2427e6976dcd;hpb=4661ee61ba5b1442593968e49c8240c2619fb744;p=gitmo%2FMouse.git diff --git a/t/031-clone.t b/t/031-clone.t index fd9e500..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 => 9; +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,5 +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+\)\)/; +