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         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(
 103             superclasses => ['Class::MOP::Class'],
 104             weaken => 0,
 105         );
 106         $meta_name = $meta->name;
 107         ok(!Class::MOP::metaclass_is_weak($meta_name),
 108            "anon classes can be told not to weaken");
 109     }
 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 }
 119
 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
 136 done_testing;