don't let anon classes disappear while subclasses still exist

[gitmo/Class-MOP.git] / t / 048_anon_class_create_init.t

use strict;
use warnings;

use Test::More;
use Test::Exception;

use Class::MOP;

{
    package MyMeta;
    use base '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");
}

{
    $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;
    {
        $meta_name = Class::MOP::Class->create_anon_class(
            superclasses => ['Class::MOP::Class'],
            weaken => 0,
        )->name;
    }
    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);
    }
}

done_testing;