Changes
[gitmo/Mouse.git] / t / 031-clone.t
CommitLineData
1a0f0802 1#!/usr/bin/env perl
7a59f4e8 2use strict;
3use warnings;
e42bee44 4use Test::More tests => 10;
1a0f0802 5use Test::Exception;
7a59f4e8 6
1a0f0802 7do {
7a59f4e8 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
4661ee61 22 has baz => (
23 is => 'rw',
24 init_arg => undef,
25 );
26
27 has quux => (
28 is => 'rw',
29 init_arg => 'quuux',
30 );
31
7a59f4e8 32 sub clone {
1a0f0802 33 my ($self, @args) = @_;
34 $self->meta->clone_object($self, @args);
7a59f4e8 35 }
1a0f0802 36};
37
4661ee61 38my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed");
1a0f0802 39
40is($foo->foo, "foo", "attr 1",);
4661ee61 41is($foo->quux, "indeed", "init_arg respected");
1a0f0802 42is_deeply($foo->bar, [ 1 .. 3 ], "attr 2");
4661ee61 43$foo->baz("foo");
7a59f4e8 44
4661ee61 45my $clone = $foo->clone(foo => "dancing", baz => "bar", quux => "nope", quuux => "yes");
7a59f4e8 46
1a0f0802 47is($clone->foo, "dancing", "overridden attr");
48is_deeply($clone->bar, [ 1 .. 3 ], "clone attr");
4661ee61 49is($clone->baz, "foo", "init_arg=undef means the attr is ignored");
50is($clone->quux, "yes", "clone uses init_arg and not attribute name");
7a59f4e8 51
1a0f0802 52throws_ok {
53 Foo->meta->clone_object("constant");
54} qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/;
7a59f4e8 55
1a0f0802 56throws_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+\)\)/;
7a59f4e8 59
e42bee44 60throws_ok {
61 Foo->meta->clone_instance("constant")
62} qr/You can only clone instances, \(constant\) is not a blessed instance/;
63