t/048_anon_class_create_init.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   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     $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;
  85     ok(Class::MOP::class_of($superclasses[0]),
  86        "superclasses are kept alive by their subclasses");
  87 }
  88
  89 {
  90     my $meta_name;
  91     {
  92         $meta_name = Class::MOP::Class->create_anon_class(
  93             superclasses => ['Class::MOP::Class'],
  94             weaken => 0,
  95         )->name;
  96     }
  97     ok(Class::MOP::class_of($meta_name), "metaclass still exists");
  98     {
  99         my $bar_meta;
 100         lives_ok {
 101             $bar_meta = $meta_name->initialize('Bar');
 102         } "we can use the name on its own";
 103         isa_ok($bar_meta, $meta_name);
 104     }
 105 }
 106
 107 done_testing;