7 use File::Spec::Functions;
9 use Test::More tests => 36;
16 use lib catdir($FindBin::Bin, 'lib');
18 # make sure the Class::MOP::Class->meta does the right thing
20 my $meta = Class::MOP::Class->meta();
21 isa_ok($meta, 'Class::MOP::Class');
23 my $new_meta = $meta->new_object('package' => 'Class::MOP::Class');
24 isa_ok($new_meta, 'Class::MOP::Class');
25 is($new_meta, $meta, '... it still creates the singleton');
27 my $cloned_meta = $meta->clone_object($meta);
28 isa_ok($cloned_meta, 'Class::MOP::Class');
29 is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it');
31 # make sure other metaclasses do the right thing
38 my $foo_meta = Foo->meta;
39 isa_ok($foo_meta, 'Class::MOP::Class');
41 is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton');
42 is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton');
44 # make sure subclassed of Class::MOP::Class do the right thing
46 my $my_meta = MyMetaClass->meta;
47 isa_ok($my_meta, 'Class::MOP::Class');
49 my $new_my_meta = $my_meta->new_object('package' => 'MyMetaClass');
50 isa_ok($new_my_meta, 'Class::MOP::Class');
51 is($new_my_meta, $my_meta, '... even subclasses still create the singleton');
53 my $cloned_my_meta = $meta->clone_object($my_meta);
54 isa_ok($cloned_my_meta, 'Class::MOP::Class');
55 is($cloned_my_meta, $my_meta, '... and subclasses creates the singleton even if you try to clone it');
57 is($my_meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)');
58 is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton (w/subclass)');
60 # now create a metaclass for real
62 my $bar_meta = $my_meta->new_object('package' => 'Bar');
63 isa_ok($bar_meta, 'Class::MOP::Class');
65 is($bar_meta->name, 'Bar', '... got the right name for the Bar metaclass');
66 is($bar_meta->version, undef, '... Bar does not exists, so it has no version');
68 $bar_meta->superclasses('Foo');
70 # check with MyMetaClass
74 use metaclass 'MyMetaClass';
77 my $baz_meta = Baz->meta;
78 isa_ok($baz_meta, 'Class::MOP::Class');
79 isa_ok($baz_meta, 'MyMetaClass');
81 is($my_meta->new_object('package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton');
82 is($my_meta->clone_object($baz_meta), $baz_meta, '... cloning got the right Baz->meta singleton');
84 $baz_meta->superclasses('Bar');
86 # now create a regular objects for real
88 my $foo = $foo_meta->new_object();
91 my $bar = $bar_meta->new_object();
95 my $baz = $baz_meta->new_object();
100 my $cloned_foo = $foo_meta->clone_object($foo);
101 isa_ok($cloned_foo, 'Foo');
103 isnt($cloned_foo, $foo, '... $cloned_foo is a new object different from $foo');
108 $foo_meta->clone_object($meta);
109 } '... this dies as expected';
117 FooBar->meta->add_attribute('test');
120 my $attr = FooBar->meta->get_attribute('test');
121 isa_ok($attr, 'Class::MOP::Attribute');
123 my $attr_clone = $attr->clone();
124 isa_ok($attr_clone, 'Class::MOP::Attribute');
126 isnt($attr, $attr_clone, '... we successfully cloned our attributes');
127 is($attr->associated_class,
128 $attr_clone->associated_class,
129 '... we successfully did not clone our associated metaclass');