Commit | Line | Data |
2a7575a6 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
95514cb4 |
6 | use FindBin; |
7 | use File::Spec::Functions; |
8 | |
a740253a |
9 | use Test::More tests => 36; |
2a7575a6 |
10 | use Test::Exception; |
11 | |
12 | BEGIN { |
13 | use_ok('Class::MOP'); |
14 | } |
15 | |
95514cb4 |
16 | use lib catdir($FindBin::Bin, 'lib'); |
17 | |
2a7575a6 |
18 | # make sure the Class::MOP::Class->meta does the right thing |
19 | |
20 | my $meta = Class::MOP::Class->meta(); |
21 | isa_ok($meta, 'Class::MOP::Class'); |
22 | |
c23184fc |
23 | my $new_meta = $meta->new_object('package' => 'Class::MOP::Class'); |
2a7575a6 |
24 | isa_ok($new_meta, 'Class::MOP::Class'); |
25 | is($new_meta, $meta, '... it still creates the singleton'); |
26 | |
27 | my $cloned_meta = $meta->clone_object($meta); |
28 | isa_ok($cloned_meta, 'Class::MOP::Class'); |
95514cb4 |
29 | is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it'); |
2a7575a6 |
30 | |
31 | # make sure other metaclasses do the right thing |
32 | |
33 | { |
34 | package Foo; |
35 | use metaclass; |
36 | } |
37 | |
38 | my $foo_meta = Foo->meta; |
39 | isa_ok($foo_meta, 'Class::MOP::Class'); |
40 | |
c23184fc |
41 | is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton'); |
2a7575a6 |
42 | is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton'); |
2a7575a6 |
43 | |
95514cb4 |
44 | # make sure subclassed of Class::MOP::Class do the right thing |
2a7575a6 |
45 | |
46 | my $my_meta = MyMetaClass->meta; |
47 | isa_ok($my_meta, 'Class::MOP::Class'); |
48 | |
c23184fc |
49 | my $new_my_meta = $my_meta->new_object('package' => 'MyMetaClass'); |
2a7575a6 |
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 | |
c23184fc |
57 | is($my_meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)'); |
2a7575a6 |
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 | |
c23184fc |
62 | my $bar_meta = $my_meta->new_object('package' => 'Bar'); |
2a7575a6 |
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 | |
95514cb4 |
70 | # check with MyMetaClass |
2a7575a6 |
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 | |
c23184fc |
81 | is($my_meta->new_object('package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton'); |
2a7575a6 |
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); |
95514cb4 |
109 | } '... this dies as expected'; |
2a7575a6 |
110 | |
a740253a |
111 | # test stuff |
112 | |
113 | { |
114 | package FooBar; |
115 | use metaclass; |
95514cb4 |
116 | |
a740253a |
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'); |
95514cb4 |
127 | is($attr->associated_class, |
128 | $attr_clone->associated_class, |
a740253a |
129 | '... we successfully did not clone our associated metaclass'); |
130 | |