use compiled type constraints. this change makes faster :)
[gitmo/Mouse.git] / t / 031-clone.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 10;
5 use Test::Exception;
6
7 do {
8     package Foo;
9     use Mouse;
10
11     has foo => (
12         isa => "Str",
13         is  => "rw",
14         default => "foo",
15     );
16
17     has bar => (
18         isa => "ArrayRef",
19         is  => "rw",
20     );
21
22     has baz => (
23         is => 'rw',
24         init_arg => undef,
25     );
26
27     has quux => (
28         is => 'rw',
29         init_arg => 'quuux',
30     );
31
32     sub clone {
33         my ($self, @args) = @_;
34         $self->meta->clone_object($self, @args);
35     }
36 };
37
38 my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed");
39
40 is($foo->foo, "foo", "attr 1",);
41 is($foo->quux, "indeed", "init_arg respected");
42 is_deeply($foo->bar, [ 1 .. 3 ], "attr 2");
43 $foo->baz("foo");
44
45 my $clone = $foo->clone(foo => "dancing", baz => "bar", quux => "nope", quuux => "yes");
46
47 is($clone->foo, "dancing", "overridden attr");
48 is_deeply($clone->bar, [ 1 .. 3 ], "clone attr");
49 is($clone->baz, "foo", "init_arg=undef means the attr is ignored");
50 is($clone->quux, "yes", "clone uses init_arg and not attribute name");
51
52 throws_ok {
53     Foo->meta->clone_object("constant");
54 } qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/;
55
56 throws_ok {
57     Foo->meta->clone_object(Foo->meta)
58 } qr/You must pass an instance of the metaclass \(Foo\), not \(Mo.se::Meta::Class=HASH\(\w+\)\)/;
59
60 throws_ok {
61     Foo->meta->clone_instance("constant")
62 } qr/You can only clone instances, \(constant\) is not a blessed instance/;
63