Commit | Line | Data |
2a7575a6 |
1 | use strict; |
2 | use warnings; |
3 | |
95514cb4 |
4 | use FindBin; |
5 | use File::Spec::Functions; |
6 | |
86a4d873 |
7 | use Test::More; |
871e9eb5 |
8 | use Test::Fatal; |
2a7575a6 |
9 | |
efd3d14c |
10 | use Class::MOP; |
2a7575a6 |
11 | |
95514cb4 |
12 | use lib catdir($FindBin::Bin, 'lib'); |
13 | |
2a7575a6 |
14 | # make sure the Class::MOP::Class->meta does the right thing |
15 | |
16 | my $meta = Class::MOP::Class->meta(); |
17 | isa_ok($meta, 'Class::MOP::Class'); |
18 | |
c23184fc |
19 | my $new_meta = $meta->new_object('package' => 'Class::MOP::Class'); |
2a7575a6 |
20 | isa_ok($new_meta, 'Class::MOP::Class'); |
21 | is($new_meta, $meta, '... it still creates the singleton'); |
22 | |
23 | my $cloned_meta = $meta->clone_object($meta); |
24 | isa_ok($cloned_meta, 'Class::MOP::Class'); |
95514cb4 |
25 | is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it'); |
2a7575a6 |
26 | |
27 | # make sure other metaclasses do the right thing |
28 | |
29 | { |
30 | package Foo; |
31 | use metaclass; |
32 | } |
33 | |
34 | my $foo_meta = Foo->meta; |
35 | isa_ok($foo_meta, 'Class::MOP::Class'); |
36 | |
c23184fc |
37 | is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton'); |
2a7575a6 |
38 | is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton'); |
2a7575a6 |
39 | |
95514cb4 |
40 | # make sure subclassed of Class::MOP::Class do the right thing |
2a7575a6 |
41 | |
42 | my $my_meta = MyMetaClass->meta; |
43 | isa_ok($my_meta, 'Class::MOP::Class'); |
44 | |
c23184fc |
45 | my $new_my_meta = $my_meta->new_object('package' => 'MyMetaClass'); |
2a7575a6 |
46 | isa_ok($new_my_meta, 'Class::MOP::Class'); |
47 | is($new_my_meta, $my_meta, '... even subclasses still create the singleton'); |
48 | |
49 | my $cloned_my_meta = $meta->clone_object($my_meta); |
50 | isa_ok($cloned_my_meta, 'Class::MOP::Class'); |
51 | is($cloned_my_meta, $my_meta, '... and subclasses creates the singleton even if you try to clone it'); |
52 | |
c23184fc |
53 | is($my_meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)'); |
2a7575a6 |
54 | is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton (w/subclass)'); |
55 | |
56 | # now create a metaclass for real |
57 | |
c23184fc |
58 | my $bar_meta = $my_meta->new_object('package' => 'Bar'); |
2a7575a6 |
59 | isa_ok($bar_meta, 'Class::MOP::Class'); |
60 | |
61 | is($bar_meta->name, 'Bar', '... got the right name for the Bar metaclass'); |
62 | is($bar_meta->version, undef, '... Bar does not exists, so it has no version'); |
63 | |
64 | $bar_meta->superclasses('Foo'); |
65 | |
95514cb4 |
66 | # check with MyMetaClass |
2a7575a6 |
67 | |
68 | { |
69 | package Baz; |
70 | use metaclass 'MyMetaClass'; |
71 | } |
72 | |
73 | my $baz_meta = Baz->meta; |
74 | isa_ok($baz_meta, 'Class::MOP::Class'); |
75 | isa_ok($baz_meta, 'MyMetaClass'); |
76 | |
c23184fc |
77 | is($my_meta->new_object('package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton'); |
2a7575a6 |
78 | is($my_meta->clone_object($baz_meta), $baz_meta, '... cloning got the right Baz->meta singleton'); |
79 | |
526ba574 |
80 | $baz_meta->superclasses('Bar'); |
81 | |
2a7575a6 |
82 | # now create a regular objects for real |
83 | |
84 | my $foo = $foo_meta->new_object(); |
85 | isa_ok($foo, 'Foo'); |
86 | |
87 | my $bar = $bar_meta->new_object(); |
88 | isa_ok($bar, 'Bar'); |
89 | isa_ok($bar, 'Foo'); |
90 | |
5659d76e |
91 | my $baz = $baz_meta->new_object(); |
92 | isa_ok($baz, 'Baz'); |
93 | isa_ok($baz, 'Bar'); |
94 | isa_ok($baz, 'Foo'); |
95 | |
2a7575a6 |
96 | my $cloned_foo = $foo_meta->clone_object($foo); |
97 | isa_ok($cloned_foo, 'Foo'); |
98 | |
99 | isnt($cloned_foo, $foo, '... $cloned_foo is a new object different from $foo'); |
100 | |
101 | # check some errors |
102 | |
871e9eb5 |
103 | isnt( exception { |
2a7575a6 |
104 | $foo_meta->clone_object($meta); |
871e9eb5 |
105 | }, undef, '... this dies as expected' ); |
2a7575a6 |
106 | |
a740253a |
107 | # test stuff |
108 | |
109 | { |
110 | package FooBar; |
111 | use metaclass; |
95514cb4 |
112 | |
a740253a |
113 | FooBar->meta->add_attribute('test'); |
114 | } |
115 | |
116 | my $attr = FooBar->meta->get_attribute('test'); |
117 | isa_ok($attr, 'Class::MOP::Attribute'); |
118 | |
119 | my $attr_clone = $attr->clone(); |
120 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
121 | |
122 | isnt($attr, $attr_clone, '... we successfully cloned our attributes'); |
95514cb4 |
123 | is($attr->associated_class, |
124 | $attr_clone->associated_class, |
a740253a |
125 | '... we successfully did not clone our associated metaclass'); |
126 | |
86a4d873 |
127 | done_testing; |