t/031-clone.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 6;
   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     sub clone {
  23         my ($self, @args) = @_;
  24         $self->meta->clone_object($self, @args);
  25     }
  26 };
  27
  28 my $foo = Foo->new(bar => [ 1, 2, 3 ]);
  29
  30 is($foo->foo, "foo", "attr 1",);
  31 is_deeply($foo->bar, [ 1 .. 3 ], "attr 2");
  32
  33 my $clone = $foo->clone(foo => "dancing");
  34
  35 is($clone->foo, "dancing", "overridden attr");
  36 is_deeply($clone->bar, [ 1 .. 3 ], "clone attr");
  37
  38 throws_ok {
  39     Foo->meta->clone_object("constant");
  40 } qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/;
  41
  42 throws_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+\)\)/;
  45