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     { local $TODO = "anon class ancestry isn't preserved yet";
  86     ok(Class::MOP::class_of($superclasses[0]),
  87        "superclasses are kept alive by their subclasses");
  88     }
  89 }
  90
  91 {
  92     my $meta_name;
  93     {
  94         $meta_name = Class::MOP::Class->create_anon_class(
  95             superclasses => ['Class::MOP::Class'],
  96             weaken => 0,
  97         )->name;
  98     }
  99     local $TODO = "non-weak anon classes not implemented yet";
 100     ok(Class::MOP::class_of($meta_name), "metaclass still exists");
 101     {
 102         my $bar_meta;
 103         lives_ok {
 104             $bar_meta = $meta_name->initialize('Bar');
 105         } "we can use the name on its own";
 106         isa_ok($bar_meta, $meta_name);
 107     }
 108 }
 109
 110 done_testing;