From: Shawn M Moore Date: Fri, 27 Jun 2008 04:16:41 +0000 (+0000) Subject: Clean up the clone tests, better error message on cloning the wrong things X-Git-Tag: 0.19~269 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a0f0802dbe504e1b31f9227a86f32ccda74de61;p=gitmo%2FMouse.git Clean up the clone tests, better error message on cloning the wrong things --- diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 8ecb828..96da88f 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -89,7 +89,7 @@ sub clone_object { my $instance = shift; (blessed($instance) && $instance->isa($class->name)) - || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")"; + || confess "You must pass an instance of the metaclass (" . $class->name . "), not ($instance)"; $class->clone_instance($instance, @_); } diff --git a/t/031-clone.t b/t/031-clone.t index 44b9ce0..1f5cc50 100644 --- a/t/031-clone.t +++ b/t/031-clone.t @@ -1,11 +1,10 @@ -#!/usr/bin/perl - +#!/usr/bin/env perl use strict; use warnings; +use Test::More tests => 6; +use Test::Exception; -use Test::More 'no_plan'; - -{ +do { package Foo; use Mouse; @@ -21,18 +20,26 @@ use Test::More 'no_plan'; ); sub clone { - my ( $self, @args ) = @_; - $self->meta->clone_object( $self, @args ); + my ($self, @args) = @_; + $self->meta->clone_object($self, @args); } -} +}; + +my $foo = Foo->new(bar => [ 1, 2, 3 ]); + +is($foo->foo, "foo", "attr 1",); +is_deeply($foo->bar, [ 1 .. 3 ], "attr 2"); -my $foo = Foo->new( bar => [ 1, 2, 3 ] ); +my $clone = $foo->clone(foo => "dancing"); -is( $foo->foo, "foo", "attr 1", ); -is_deeply( $foo->bar, [ 1 .. 3 ], "attr 2" ); +is($clone->foo, "dancing", "overridden attr"); +is_deeply($clone->bar, [ 1 .. 3 ], "clone attr"); -my $clone = $foo->clone( foo => "dancing" ); +throws_ok { + Foo->meta->clone_object("constant"); +} qr/You must pass an instance of the metaclass \(Foo\), not \(constant\)/; -is( $clone->foo, "dancing", "overridden attr" ); -is_deeply( $clone->bar, [ 1 .. 3 ], "clone attr" ); +throws_ok { + Foo->meta->clone_object(Foo->meta) +} qr/You must pass an instance of the metaclass \(Foo\), not \(Mo.se::Meta::Class=HASH\(\w+\)\)/;