t/019_anon_class_keep_alive.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 11;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11 }
  12
  13 my $anon_class_name;
  14 my $anon_meta_name;
  15 {
  16   package Foo;
  17   use strict;
  18   use warnings;
  19   use metaclass;
  20
  21   sub make_anon_instance{
  22     my $self = shift;
  23     my $class = ref $self || $self;
  24
  25     my $anon_class = Class::MOP::Class->create_anon_class(superclasses => [$class]);
  26     $anon_class_name = $anon_class->name;
  27     $anon_meta_name = $anon_class->blessed;
  28     $anon_class->add_attribute( $_, reader => $_ ) for qw/bar baz/;
  29
  30     my $obj = $anon_class->new_object(bar => 'a', baz => 'b');
  31     #$obj->{___keep_metaclass_alive___} = $anon_class;
  32     return $obj;
  33   }
  34
  35   sub foo{ 'foo' }
  36
  37   1;
  38 }
  39
  40 my $instance = Foo->make_anon_instance;
  41
  42 isa_ok($instance, $anon_class_name);
  43 isa_ok($instance->meta, $anon_meta_name);
  44 isa_ok($instance, 'Foo', '... Anonymous instance isa Foo');
  45
  46 ok($instance->can('foo'), '... Anonymous instance can foo');
  47 ok($instance->meta->find_method_by_name('foo'), '... Anonymous instance has method foo');
  48
  49 ok($instance->meta->has_attribute('bar'), '... Anonymous instance still has attribute bar');
  50 ok($instance->meta->has_attribute('baz'), '... Anonymous instance still has attribute baz');
  51 is($instance->bar, 'a', '... Anonymous instance still has correct bar value');
  52 is($instance->baz, 'b', '... Anonymous instance still has correct baz value');
  53
  54 is_deeply([$instance->meta->class_precedence_list],
  55           [$anon_class_name, 'Foo'],
  56           '... Anonymous instance has class precedence list',
  57          );