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