diff options
Diffstat (limited to 't/cmop/anon_class_create_init.t')
-rw-r--r-- | t/cmop/anon_class_create_init.t | 150 |
1 files changed, 150 insertions, 0 deletions
diff --git a/t/cmop/anon_class_create_init.t b/t/cmop/anon_class_create_init.t new file mode 100644 index 0000000..a35a1eb --- /dev/null +++ b/t/cmop/anon_class_create_init.t @@ -0,0 +1,150 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Class::MOP; + +{ + package MyMeta; + use parent 'Class::MOP::Class'; + sub initialize { + my $class = shift; + my ( $package, %options ) = @_; + ::cmp_ok( $options{foo}, 'eq', 'this', + 'option passed to initialize() on create_anon_class()' ); + return $class->SUPER::initialize( @_ ); + } + +} + +{ + my $anon = MyMeta->create_anon_class( foo => 'this' ); + isa_ok( $anon, 'MyMeta' ); +} + +my $instance; + +{ + my $meta = Class::MOP::Class->create_anon_class; + $instance = $meta->new_object; +} +{ + my $meta = Class::MOP::class_of($instance); + Scalar::Util::weaken($meta); + ok($meta, "anon class is kept alive by existing instances"); + + undef $instance; + ok(!$meta, "anon class is collected once instances go away"); +} + +{ + my $meta = Class::MOP::Class->create_anon_class; + $meta->make_immutable; + $instance = $meta->name->new; +} +{ + my $meta = Class::MOP::class_of($instance); + Scalar::Util::weaken($meta); + ok($meta, "anon class is kept alive by existing instances (immutable)"); + + undef $instance; + ok(!$meta, "anon class is collected once instances go away (immutable)"); +} + +{ + $instance = Class::MOP::Class->create('Foo')->new_object; + my $meta = Class::MOP::Class->create_anon_class(superclasses => ['Foo']); + $meta->rebless_instance($instance); +} +{ + my $meta = Class::MOP::class_of($instance); + Scalar::Util::weaken($meta); + ok($meta, "anon class is kept alive by existing instances"); + + undef $instance; + ok(!$meta, "anon class is collected once instances go away"); +} + +{ + { + my $meta = Class::MOP::Class->create_anon_class; + { + my $submeta = Class::MOP::Class->create_anon_class( + superclasses => [$meta->name] + ); + $instance = $submeta->new_object; + } + { + my $submeta = Class::MOP::class_of($instance); + Scalar::Util::weaken($submeta); + ok($submeta, "anon class is kept alive by existing instances"); + + $meta->rebless_instance_back($instance); + ok(!$submeta, "reblessing away loses the metaclass"); + } + } + + my $meta = Class::MOP::class_of($instance); + Scalar::Util::weaken($meta); + ok($meta, "anon class is kept alive by existing instances"); +} + +{ + my $submeta = Class::MOP::Class->create_anon_class( + superclasses => [Class::MOP::Class->create_anon_class->name], + ); + my @superclasses = $submeta->superclasses; + ok(Class::MOP::class_of($superclasses[0]), + "superclasses are kept alive by their subclasses"); +} + +{ + my $meta_name; + { + my $meta = Class::MOP::Class->create_anon_class( + superclasses => ['Class::MOP::Class'], + ); + $meta_name = $meta->name; + ok(Class::MOP::metaclass_is_weak($meta_name), + "default is for anon metaclasses to be weakened"); + } + ok(!Class::MOP::class_of($meta_name), + "and weak metaclasses go away when all refs do"); + { + my $meta = Class::MOP::Class->create_anon_class( + superclasses => ['Class::MOP::Class'], + weaken => 0, + ); + $meta_name = $meta->name; + ok(!Class::MOP::metaclass_is_weak($meta_name), + "anon classes can be told not to weaken"); + } + ok(Class::MOP::class_of($meta_name), "metaclass still exists"); + { + my $bar_meta; + is( exception { + $bar_meta = $meta_name->initialize('Bar'); + }, undef, "we can use the name on its own" ); + isa_ok($bar_meta, $meta_name); + } +} + +{ + my $meta = Class::MOP::Class->create( + 'Baz', + weaken => 1, + ); + $instance = $meta->new_object; +} +{ + my $meta = Class::MOP::class_of($instance); + Scalar::Util::weaken($meta); + ok($meta, "weak class is kept alive by existing instances"); + + undef $instance; + ok(!$meta, "weak class is collected once instances go away"); +} + +done_testing; |