Commit | Line | Data |
34d04967 |
1 | use strict; |
2 | use warnings; |
3 | |
86a4d873 |
4 | use Test::More; |
559201bf |
5 | use Test::Exception; |
34d04967 |
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 | |
559201bf |
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 | $instance = Class::MOP::Class->create('Foo')->new_object; |
44 | my $meta = Class::MOP::Class->create_anon_class(superclasses => ['Foo']); |
45 | $meta->rebless_instance($instance); |
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"); |
51 | |
52 | undef $instance; |
53 | ok(!$meta, "anon class is collected once instances go away"); |
54 | } |
55 | |
56 | { |
57 | { |
58 | my $meta = Class::MOP::Class->create_anon_class; |
59 | { |
60 | my $submeta = Class::MOP::Class->create_anon_class( |
61 | superclasses => [$meta->name] |
62 | ); |
63 | $instance = $submeta->new_object; |
64 | } |
65 | { |
66 | my $submeta = Class::MOP::class_of($instance); |
67 | Scalar::Util::weaken($submeta); |
68 | ok($submeta, "anon class is kept alive by existing instances"); |
69 | |
70 | $meta->rebless_instance_back($instance); |
71 | ok(!$submeta, "reblessing away loses the metaclass"); |
72 | } |
73 | } |
74 | |
75 | my $meta = Class::MOP::class_of($instance); |
76 | Scalar::Util::weaken($meta); |
77 | ok($meta, "anon class is kept alive by existing instances"); |
78 | } |
79 | |
80 | { |
81 | my $submeta = Class::MOP::Class->create_anon_class( |
82 | superclasses => [Class::MOP::Class->create_anon_class->name], |
83 | ); |
84 | my @superclasses = $submeta->superclasses; |
559201bf |
85 | ok(Class::MOP::class_of($superclasses[0]), |
86 | "superclasses are kept alive by their subclasses"); |
559201bf |
87 | } |
88 | |
89 | { |
90 | my $meta_name; |
91 | { |
73dad89f |
92 | my $meta = Class::MOP::Class->create_anon_class( |
93 | superclasses => ['Class::MOP::Class'], |
94 | ); |
95 | $meta_name = $meta->name; |
96 | ok(Class::MOP::metaclass_is_weak($meta_name), |
97 | "default is for anon metaclasses to be weakened"); |
98 | } |
99 | ok(!Class::MOP::class_of($meta_name), |
100 | "and weak metaclasses go away when all refs do"); |
101 | { |
102 | my $meta = Class::MOP::Class->create_anon_class( |
559201bf |
103 | superclasses => ['Class::MOP::Class'], |
104 | weaken => 0, |
73dad89f |
105 | ); |
106 | $meta_name = $meta->name; |
107 | ok(!Class::MOP::metaclass_is_weak($meta_name), |
108 | "anon classes can be told not to weaken"); |
559201bf |
109 | } |
559201bf |
110 | ok(Class::MOP::class_of($meta_name), "metaclass still exists"); |
111 | { |
112 | my $bar_meta; |
113 | lives_ok { |
114 | $bar_meta = $meta_name->initialize('Bar'); |
115 | } "we can use the name on its own"; |
116 | isa_ok($bar_meta, $meta_name); |
117 | } |
118 | } |
34d04967 |
119 | |
18ca857d |
120 | { |
121 | my $meta = Class::MOP::Class->create( |
122 | 'Baz', |
123 | weaken => 1, |
124 | ); |
125 | $instance = $meta->new_object; |
126 | } |
127 | { |
128 | my $meta = Class::MOP::class_of($instance); |
129 | Scalar::Util::weaken($meta); |
130 | ok($meta, "weak class is kept alive by existing instances"); |
131 | |
132 | undef $instance; |
133 | ok(!$meta, "weak class is collected once instances go away"); |
134 | } |
135 | |
86a4d873 |
136 | done_testing; |