Clean up the clone tests, better error message on cloning the wrong things
[gitmo/Mouse.git] / t / 031-clone.t
CommitLineData
1a0f0802 1#!/usr/bin/env perl
7a59f4e8 2use strict;
3use warnings;
1a0f0802 4use Test::More tests => 6;
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
22 sub clone {
1a0f0802 23 my ($self, @args) = @_;
24 $self->meta->clone_object($self, @args);
7a59f4e8 25 }
1a0f0802 26};
27
28my $foo = Foo->new(bar => [ 1, 2, 3 ]);
29
30is($foo->foo, "foo", "attr 1",);
31is_deeply($foo->bar, [ 1 .. 3 ], "attr 2");
7a59f4e8 32
1a0f0802 33my $clone = $foo->clone(foo => "dancing");
7a59f4e8 34
1a0f0802 35is($clone->foo, "dancing", "overridden attr");
36is_deeply($clone->bar, [ 1 .. 3 ], "clone attr");
7a59f4e8 37
1a0f0802 38throws_ok {
39 Foo->meta->clone_object("constant");
40} qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/;
7a59f4e8 41
1a0f0802 42throws_ok {
43 Foo->meta->clone_object(Foo->meta)
44} qr/You must pass an instance of the metaclass \(Foo\), not \(Mo.se::Meta::Class=HASH\(\w+\)\)/;
7a59f4e8 45