X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F006_new_and_clone_metaclasses.t;h=b64119dc2774fb90e7d3deeff6c148efecd9aeef;hb=95514cb4a1bc0120b516ee8a146c770e919432a3;hp=68916b05ed8d106720dbd44c7c132722f0d398aa;hpb=5659d76e5bb87873fa7c80efdf1cce8c40d40237;p=gitmo%2FClass-MOP.git diff --git a/t/006_new_and_clone_metaclasses.t b/t/006_new_and_clone_metaclasses.t index 68916b0..b64119d 100644 --- a/t/006_new_and_clone_metaclasses.t +++ b/t/006_new_and_clone_metaclasses.t @@ -3,25 +3,30 @@ use strict; use warnings; -use Test::More tests => 32; +use FindBin; +use File::Spec::Functions; + +use Test::More tests => 36; use Test::Exception; BEGIN { use_ok('Class::MOP'); } +use lib catdir($FindBin::Bin, 'lib'); + # make sure the Class::MOP::Class->meta does the right thing my $meta = Class::MOP::Class->meta(); isa_ok($meta, 'Class::MOP::Class'); -my $new_meta = $meta->new_object(':package' => 'Class::MOP::Class'); +my $new_meta = $meta->new_object('package' => 'Class::MOP::Class'); isa_ok($new_meta, 'Class::MOP::Class'); is($new_meta, $meta, '... it still creates the singleton'); my $cloned_meta = $meta->clone_object($meta); isa_ok($cloned_meta, 'Class::MOP::Class'); -is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it'); +is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it'); # make sure other metaclasses do the right thing @@ -33,20 +38,15 @@ is($cloned_meta, $meta, '... it creates the singleton even if you try to clone i my $foo_meta = Foo->meta; isa_ok($foo_meta, 'Class::MOP::Class'); -is($meta->new_object(':package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton'); +is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton'); is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton'); - -# make sure subclassed of Class::MOP::Class do the right thing -{ - package MyMetaClass; - use base 'Class::MOP::Class'; -} +# make sure subclassed of Class::MOP::Class do the right thing my $my_meta = MyMetaClass->meta; isa_ok($my_meta, 'Class::MOP::Class'); -my $new_my_meta = $my_meta->new_object(':package' => 'MyMetaClass'); +my $new_my_meta = $my_meta->new_object('package' => 'MyMetaClass'); isa_ok($new_my_meta, 'Class::MOP::Class'); is($new_my_meta, $my_meta, '... even subclasses still create the singleton'); @@ -54,12 +54,12 @@ my $cloned_my_meta = $meta->clone_object($my_meta); isa_ok($cloned_my_meta, 'Class::MOP::Class'); is($cloned_my_meta, $my_meta, '... and subclasses creates the singleton even if you try to clone it'); -is($my_meta->new_object(':package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)'); +is($my_meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)'); is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton (w/subclass)'); # now create a metaclass for real -my $bar_meta = $my_meta->new_object(':package' => 'Bar'); +my $bar_meta = $my_meta->new_object('package' => 'Bar'); isa_ok($bar_meta, 'Class::MOP::Class'); is($bar_meta->name, 'Bar', '... got the right name for the Bar metaclass'); @@ -67,7 +67,7 @@ is($bar_meta->version, undef, '... Bar does not exists, so it has no version'); $bar_meta->superclasses('Foo'); -# check with MyMetaClass +# check with MyMetaClass { package Baz; @@ -78,7 +78,7 @@ my $baz_meta = Baz->meta; isa_ok($baz_meta, 'Class::MOP::Class'); isa_ok($baz_meta, 'MyMetaClass'); -is($my_meta->new_object(':package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton'); +is($my_meta->new_object('package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton'); is($my_meta->clone_object($baz_meta), $baz_meta, '... cloning got the right Baz->meta singleton'); $baz_meta->superclasses('Bar'); @@ -106,5 +106,25 @@ isnt($cloned_foo, $foo, '... $cloned_foo is a new object different from $foo'); dies_ok { $foo_meta->clone_object($meta); -} '... this dies as expected'; +} '... this dies as expected'; + +# test stuff + +{ + package FooBar; + use metaclass; + + FooBar->meta->add_attribute('test'); +} + +my $attr = FooBar->meta->get_attribute('test'); +isa_ok($attr, 'Class::MOP::Attribute'); + +my $attr_clone = $attr->clone(); +isa_ok($attr_clone, 'Class::MOP::Attribute'); + +isnt($attr, $attr_clone, '... we successfully cloned our attributes'); +is($attr->associated_class, + $attr_clone->associated_class, + '... we successfully did not clone our associated metaclass');