t/049_metaclass_reinitialize.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6
   7 {
   8     package Foo;
   9     use metaclass;
  10     sub foo {}
  11     Foo->meta->add_attribute('bar');
  12 }
  13
  14 sub check_meta_sanity {
  15     my ($meta, $class) = @_;
  16     isa_ok($meta, 'Class::MOP::Class');
  17     is($meta->name, $class);
  18     ok($meta->has_method('foo'));
  19     isa_ok($meta->get_method('foo'), 'Class::MOP::Method');
  20     ok($meta->has_attribute('bar'));
  21     isa_ok($meta->get_attribute('bar'), 'Class::MOP::Attribute');
  22 }
  23
  24 can_ok('Foo', 'meta');
  25
  26 my $meta = Foo->meta;
  27 check_meta_sanity($meta, 'Foo');
  28
  29 lives_ok {
  30     $meta = $meta->reinitialize($meta->name);
  31 };
  32 check_meta_sanity($meta, 'Foo');
  33
  34 lives_ok {
  35     $meta = $meta->reinitialize($meta);
  36 };
  37 check_meta_sanity($meta, 'Foo');
  38
  39 throws_ok {
  40     $meta->reinitialize('');
  41 } qr/You must pass a package name or an existing Class::MOP::Package instance/;
  42
  43 throws_ok {
  44     $meta->reinitialize($meta->new_object);
  45 } qr/You must pass a package name or an existing Class::MOP::Package instance/;
  46
  47 {
  48     package Bar::Meta::Method;
  49     use base 'Class::MOP::Method';
  50     __PACKAGE__->meta->add_attribute('test', accessor => 'test');
  51 }
  52
  53 {
  54     package Bar::Meta::Attribute;
  55     use base 'Class::MOP::Attribute';
  56     __PACKAGE__->meta->add_attribute('tset', accessor => 'tset');
  57 }
  58
  59 {
  60     package Bar;
  61     use metaclass;
  62     Bar->meta->add_method('foo' => Bar::Meta::Method->wrap(sub {}, name => 'foo', package_name => 'Bar'));
  63     Bar->meta->add_attribute(Bar::Meta::Attribute->new('bar'));
  64 }
  65
  66 $meta = Bar->meta;
  67 check_meta_sanity($meta, 'Bar');
  68 isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
  69 isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
  70 lives_ok {
  71     $meta = $meta->reinitialize('Bar');
  72 };
  73 check_meta_sanity($meta, 'Bar');
  74 isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
  75 isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
  76
  77 Bar->meta->get_method('foo')->test('FOO');
  78 Bar->meta->get_attribute('bar')->tset('OOF');
  79
  80 is(Bar->meta->get_method('foo')->test, 'FOO');
  81 is(Bar->meta->get_attribute('bar')->tset, 'OOF');
  82 lives_ok {
  83     $meta = $meta->reinitialize('Bar');
  84 };
  85 is(Bar->meta->get_method('foo')->test, 'FOO');
  86 is(Bar->meta->get_attribute('bar')->tset, 'OOF');
  87
  88 {
  89     package Baz::Meta::Attribute;
  90     use base 'Class::MOP::Attribute';
  91 }
  92
  93 {
  94     package Baz::Meta::Method;
  95     use base 'Class::MOP::Method';
  96 }
  97
  98 {
  99     package Baz;
 100     use metaclass meta_name => undef;
 101
 102     sub foo {}
 103     Class::MOP::class_of('Baz')->add_attribute('bar');
 104 }
 105
 106 $meta = Class::MOP::class_of('Baz');
 107 check_meta_sanity($meta, 'Baz');
 108 ok(!$meta->get_method('foo')->isa('Baz::Meta::Method'));
 109 ok(!$meta->get_attribute('bar')->isa('Baz::Meta::Attribute'));
 110 lives_ok {
 111     $meta = $meta->reinitialize(
 112         'Baz',
 113         attribute_metaclass => 'Baz::Meta::Attribute',
 114         method_metaclass    => 'Baz::Meta::Method'
 115     );
 116 };
 117 check_meta_sanity($meta, 'Baz');
 118 isa_ok($meta->get_method('foo'), 'Baz::Meta::Method');
 119 isa_ok($meta->get_attribute('bar'), 'Baz::Meta::Attribute');
 120
 121 {
 122     package Quux;
 123     use metaclass
 124         attribute_metaclass => 'Bar::Meta::Attribute',
 125         method_metaclass    => 'Bar::Meta::Method';
 126
 127     sub foo {}
 128     Quux->meta->add_attribute('bar');
 129 }
 130
 131 $meta = Quux->meta;
 132 check_meta_sanity($meta, 'Quux');
 133 isa_ok(Quux->meta->get_method('foo'), 'Bar::Meta::Method');
 134 isa_ok(Quux->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
 135 throws_ok {
 136     $meta = $meta->reinitialize(
 137         'Quux',
 138         attribute_metaclass => 'Baz::Meta::Attribute',
 139         method_metaclass    => 'Baz::Meta::Method',
 140     );
 141 } qr/compatible/;
 142
 143 {
 144     package Quuux::Meta::Attribute;
 145     use base 'Class::MOP::Attribute';
 146
 147     sub install_accessors {}
 148 }
 149
 150 {
 151     package Quuux;
 152     use metaclass;
 153     sub foo {}
 154     Quuux->meta->add_attribute('bar', reader => 'bar');
 155 }
 156
 157 $meta = Quuux->meta;
 158 check_meta_sanity($meta, 'Quuux');
 159 ok($meta->has_method('bar'));
 160 lives_ok {
 161     $meta = $meta->reinitialize(
 162         'Quuux',
 163         attribute_metaclass => 'Quuux::Meta::Attribute',
 164     );
 165 };
 166 check_meta_sanity($meta, 'Quuux');
 167 ok(!$meta->has_method('bar'));
 168
 169 {
 170     package Blah::Meta::Method;
 171     use base 'Class::MOP::Method';
 172
 173     __PACKAGE__->meta->add_attribute('foo', reader => 'foo', default => 'TEST');
 174 }
 175
 176 {
 177     package Blah::Meta::Attribute;
 178     use base 'Class::MOP::Attribute';
 179
 180     __PACKAGE__->meta->add_attribute('oof', reader => 'oof', default => 'TSET');
 181 }
 182
 183 {
 184     package Blah;
 185     use metaclass no_meta => 1;
 186     sub foo {}
 187     Class::MOP::class_of('Blah')->add_attribute('bar');
 188 }
 189
 190 $meta = Class::MOP::class_of('Blah');
 191 check_meta_sanity($meta, 'Blah');
 192 lives_ok {
 193     $meta = Class::MOP::Class->reinitialize(
 194         'Blah',
 195         attribute_metaclass => 'Blah::Meta::Attribute',
 196         method_metaclass    => 'Blah::Meta::Method',
 197     );
 198 };
 199 check_meta_sanity($meta, 'Blah');
 200 can_ok($meta->get_method('foo'), 'foo');
 201 is($meta->get_method('foo')->foo, 'TEST');
 202 can_ok($meta->get_attribute('bar'), 'oof');
 203 is($meta->get_attribute('bar')->oof, 'TSET');
 204
 205 done_testing;