-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More;
+use Test::Exception;
use Class::MOP;
}
-my $anon = MyMeta->create_anon_class( foo => 'this' );
-isa_ok( $anon, 'MyMeta' );
+{
+ 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;
+ lives_ok {
+ $bar_meta = $meta_name->initialize('Bar');
+ } "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;