Commit | Line | Data |
1a0f0802 |
1 | #!/usr/bin/env perl |
7a59f4e8 |
2 | use strict; |
3 | use warnings; |
926290ac |
4 | use Test::More tests => 12; |
eab81545 |
5 | use Test::Exception; |
7a59f4e8 |
6 | |
926290ac |
7 | my %triggered; |
1a0f0802 |
8 | do { |
7a59f4e8 |
9 | package Foo; |
10 | use Mouse; |
11 | |
12 | has foo => ( |
13 | isa => "Str", |
14 | is => "rw", |
15 | default => "foo", |
16 | ); |
17 | |
18 | has bar => ( |
19 | isa => "ArrayRef", |
20 | is => "rw", |
21 | ); |
22 | |
4661ee61 |
23 | has baz => ( |
24 | is => 'rw', |
25 | init_arg => undef, |
26 | ); |
27 | |
28 | has quux => ( |
29 | is => 'rw', |
30 | init_arg => 'quuux', |
926290ac |
31 | trigger => sub{ |
32 | my($self, $value) = @_; |
33 | $triggered{$self} = $value; |
34 | }, |
4661ee61 |
35 | ); |
36 | |
7a59f4e8 |
37 | sub clone { |
1a0f0802 |
38 | my ($self, @args) = @_; |
39 | $self->meta->clone_object($self, @args); |
7a59f4e8 |
40 | } |
1a0f0802 |
41 | }; |
42 | |
4661ee61 |
43 | my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed"); |
1a0f0802 |
44 | |
45 | is($foo->foo, "foo", "attr 1",); |
4661ee61 |
46 | is($foo->quux, "indeed", "init_arg respected"); |
926290ac |
47 | |
48 | is $triggered{$foo}, "indeed"; |
49 | |
1a0f0802 |
50 | is_deeply($foo->bar, [ 1 .. 3 ], "attr 2"); |
4661ee61 |
51 | $foo->baz("foo"); |
7a59f4e8 |
52 | |
4661ee61 |
53 | my $clone = $foo->clone(foo => "dancing", baz => "bar", quux => "nope", quuux => "yes"); |
7a59f4e8 |
54 | |
926290ac |
55 | is $triggered{$foo}, "indeed"; |
56 | is $triggered{$clone}, "yes", 'clone_object() invokes triggers'; |
57 | |
1a0f0802 |
58 | is($clone->foo, "dancing", "overridden attr"); |
59 | is_deeply($clone->bar, [ 1 .. 3 ], "clone attr"); |
4661ee61 |
60 | is($clone->baz, "foo", "init_arg=undef means the attr is ignored"); |
61 | is($clone->quux, "yes", "clone uses init_arg and not attribute name"); |
7a59f4e8 |
62 | |
1a0f0802 |
63 | throws_ok { |
64 | Foo->meta->clone_object("constant"); |
65 | } qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/; |
7a59f4e8 |
66 | |
1a0f0802 |
67 | throws_ok { |
68 | Foo->meta->clone_object(Foo->meta) |
926290ac |
69 | } qr/You must pass an instance of the metaclass \(Foo\), not \(Mouse::Meta::Class=HASH\(\w+\)\)/; |
7a59f4e8 |
70 | |
e42bee44 |
71 | |