Commit | Line | Data |
2a7575a6 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a740253a |
6 | use Test::More tests => 36; |
2a7575a6 |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
11 | } |
12 | |
13 | # make sure the Class::MOP::Class->meta does the right thing |
14 | |
15 | my $meta = Class::MOP::Class->meta(); |
16 | isa_ok($meta, 'Class::MOP::Class'); |
17 | |
18 | my $new_meta = $meta->new_object(':package' => 'Class::MOP::Class'); |
19 | isa_ok($new_meta, 'Class::MOP::Class'); |
20 | is($new_meta, $meta, '... it still creates the singleton'); |
21 | |
22 | my $cloned_meta = $meta->clone_object($meta); |
23 | isa_ok($cloned_meta, 'Class::MOP::Class'); |
24 | is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it'); |
25 | |
26 | # make sure other metaclasses do the right thing |
27 | |
28 | { |
29 | package Foo; |
30 | use metaclass; |
31 | } |
32 | |
33 | my $foo_meta = Foo->meta; |
34 | isa_ok($foo_meta, 'Class::MOP::Class'); |
35 | |
36 | is($meta->new_object(':package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton'); |
37 | is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton'); |
38 | |
39 | # make sure subclassed of Class::MOP::Class do the right thing |
40 | |
41 | { |
42 | package MyMetaClass; |
43 | use base 'Class::MOP::Class'; |
44 | } |
45 | |
46 | my $my_meta = MyMetaClass->meta; |
47 | isa_ok($my_meta, 'Class::MOP::Class'); |
48 | |
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'); |
52 | |
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'); |
56 | |
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)'); |
59 | |
60 | # now create a metaclass for real |
61 | |
62 | my $bar_meta = $my_meta->new_object(':package' => 'Bar'); |
63 | isa_ok($bar_meta, 'Class::MOP::Class'); |
64 | |
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'); |
67 | |
68 | $bar_meta->superclasses('Foo'); |
69 | |
70 | # check with MyMetaClass |
71 | |
72 | { |
73 | package Baz; |
74 | use metaclass 'MyMetaClass'; |
75 | } |
76 | |
77 | my $baz_meta = Baz->meta; |
78 | isa_ok($baz_meta, 'Class::MOP::Class'); |
79 | isa_ok($baz_meta, 'MyMetaClass'); |
80 | |
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'); |
83 | |
526ba574 |
84 | $baz_meta->superclasses('Bar'); |
85 | |
2a7575a6 |
86 | # now create a regular objects for real |
87 | |
88 | my $foo = $foo_meta->new_object(); |
89 | isa_ok($foo, 'Foo'); |
90 | |
91 | my $bar = $bar_meta->new_object(); |
92 | isa_ok($bar, 'Bar'); |
93 | isa_ok($bar, 'Foo'); |
94 | |
5659d76e |
95 | my $baz = $baz_meta->new_object(); |
96 | isa_ok($baz, 'Baz'); |
97 | isa_ok($baz, 'Bar'); |
98 | isa_ok($baz, 'Foo'); |
99 | |
2a7575a6 |
100 | my $cloned_foo = $foo_meta->clone_object($foo); |
101 | isa_ok($cloned_foo, 'Foo'); |
102 | |
103 | isnt($cloned_foo, $foo, '... $cloned_foo is a new object different from $foo'); |
104 | |
105 | # check some errors |
106 | |
107 | dies_ok { |
108 | $foo_meta->clone_object($meta); |
109 | } '... this dies as expected'; |
110 | |
a740253a |
111 | # test stuff |
112 | |
113 | { |
114 | package FooBar; |
115 | use metaclass; |
116 | |
117 | FooBar->meta->add_attribute('test'); |
118 | } |
119 | |
120 | my $attr = FooBar->meta->get_attribute('test'); |
121 | isa_ok($attr, 'Class::MOP::Attribute'); |
122 | |
123 | my $attr_clone = $attr->clone(); |
124 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
125 | |
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'); |
130 | |