Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | |
7 | use Class::MOP; |
8 | |
9 | { |
10 | package MyMeta; |
11 | use base 'Class::MOP::Class'; |
12 | sub initialize { |
13 | my $class = shift; |
14 | my ( $package, %options ) = @_; |
15 | ::cmp_ok( $options{foo}, 'eq', 'this', |
16 | 'option passed to initialize() on create_anon_class()' ); |
17 | return $class->SUPER::initialize( @_ ); |
18 | } |
19 | |
20 | } |
21 | |
22 | { |
23 | my $anon = MyMeta->create_anon_class( foo => 'this' ); |
24 | isa_ok( $anon, 'MyMeta' ); |
25 | } |
26 | |
27 | my $instance; |
28 | |
29 | { |
30 | my $meta = Class::MOP::Class->create_anon_class; |
31 | $instance = $meta->new_object; |
32 | } |
33 | { |
34 | my $meta = Class::MOP::class_of($instance); |
35 | Scalar::Util::weaken($meta); |
36 | ok($meta, "anon class is kept alive by existing instances"); |
37 | |
38 | undef $instance; |
39 | ok(!$meta, "anon class is collected once instances go away"); |
40 | } |
41 | |
42 | { |
43 | my $meta = Class::MOP::Class->create_anon_class; |
44 | $meta->make_immutable; |
45 | $instance = $meta->name->new; |
46 | } |
47 | { |
48 | my $meta = Class::MOP::class_of($instance); |
49 | Scalar::Util::weaken($meta); |
50 | ok($meta, "anon class is kept alive by existing instances (immutable)"); |
51 | |
52 | undef $instance; |
53 | ok(!$meta, "anon class is collected once instances go away (immutable)"); |
54 | } |
55 | |
56 | { |
57 | $instance = Class::MOP::Class->create('Foo')->new_object; |
58 | my $meta = Class::MOP::Class->create_anon_class(superclasses => ['Foo']); |
59 | $meta->rebless_instance($instance); |
60 | } |
61 | { |
62 | my $meta = Class::MOP::class_of($instance); |
63 | Scalar::Util::weaken($meta); |
64 | ok($meta, "anon class is kept alive by existing instances"); |
65 | |
66 | undef $instance; |
67 | ok(!$meta, "anon class is collected once instances go away"); |
68 | } |
69 | |
70 | { |
71 | { |
72 | my $meta = Class::MOP::Class->create_anon_class; |
73 | { |
74 | my $submeta = Class::MOP::Class->create_anon_class( |
75 | superclasses => [$meta->name] |
76 | ); |
77 | $instance = $submeta->new_object; |
78 | } |
79 | { |
80 | my $submeta = Class::MOP::class_of($instance); |
81 | Scalar::Util::weaken($submeta); |
82 | ok($submeta, "anon class is kept alive by existing instances"); |
83 | |
84 | $meta->rebless_instance_back($instance); |
85 | ok(!$submeta, "reblessing away loses the metaclass"); |
86 | } |
87 | } |
88 | |
89 | my $meta = Class::MOP::class_of($instance); |
90 | Scalar::Util::weaken($meta); |
91 | ok($meta, "anon class is kept alive by existing instances"); |
92 | } |
93 | |
94 | { |
95 | my $submeta = Class::MOP::Class->create_anon_class( |
96 | superclasses => [Class::MOP::Class->create_anon_class->name], |
97 | ); |
98 | my @superclasses = $submeta->superclasses; |
99 | ok(Class::MOP::class_of($superclasses[0]), |
100 | "superclasses are kept alive by their subclasses"); |
101 | } |
102 | |
103 | { |
104 | my $meta_name; |
105 | { |
106 | my $meta = Class::MOP::Class->create_anon_class( |
107 | superclasses => ['Class::MOP::Class'], |
108 | ); |
109 | $meta_name = $meta->name; |
110 | ok(Class::MOP::metaclass_is_weak($meta_name), |
111 | "default is for anon metaclasses to be weakened"); |
112 | } |
113 | ok(!Class::MOP::class_of($meta_name), |
114 | "and weak metaclasses go away when all refs do"); |
115 | { |
116 | my $meta = Class::MOP::Class->create_anon_class( |
117 | superclasses => ['Class::MOP::Class'], |
118 | weaken => 0, |
119 | ); |
120 | $meta_name = $meta->name; |
121 | ok(!Class::MOP::metaclass_is_weak($meta_name), |
122 | "anon classes can be told not to weaken"); |
123 | } |
124 | ok(Class::MOP::class_of($meta_name), "metaclass still exists"); |
125 | { |
126 | my $bar_meta; |
127 | is( exception { |
128 | $bar_meta = $meta_name->initialize('Bar'); |
129 | }, undef, "we can use the name on its own" ); |
130 | isa_ok($bar_meta, $meta_name); |
131 | } |
132 | } |
133 | |
134 | { |
135 | my $meta = Class::MOP::Class->create( |
136 | 'Baz', |
137 | weaken => 1, |
138 | ); |
139 | $instance = $meta->new_object; |
140 | } |
141 | { |
142 | my $meta = Class::MOP::class_of($instance); |
143 | Scalar::Util::weaken($meta); |
144 | ok($meta, "weak class is kept alive by existing instances"); |
145 | |
146 | undef $instance; |
147 | ok(!$meta, "weak class is collected once instances go away"); |
148 | } |
149 | |
150 | done_testing; |