t/001_cmop/090_meta_method.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6 use Class::MOP;
   7
   8 {
   9     can_ok('Class::MOP::Class', 'meta');
  10     isa_ok(Class::MOP::Class->meta->find_method_by_name('meta'),
  11            'Class::MOP::Method::Meta');
  12
  13     {
  14         package Baz;
  15         use metaclass;
  16     }
  17     can_ok('Baz', 'meta');
  18     isa_ok(Baz->meta->find_method_by_name('meta'),
  19            'Class::MOP::Method::Meta');
  20
  21     my $meta = Class::MOP::Class->create('Quux');
  22     can_ok('Quux', 'meta');
  23     isa_ok(Quux->meta->find_method_by_name('meta'),
  24            'Class::MOP::Method::Meta');
  25 }
  26
  27 {
  28     {
  29         package Blarg;
  30         use metaclass meta_name => 'blarg';
  31     }
  32     ok(!Blarg->can('meta'));
  33     can_ok('Blarg', 'blarg');
  34     isa_ok(Blarg->blarg->find_method_by_name('blarg'),
  35            'Class::MOP::Method::Meta');
  36
  37     my $meta = Class::MOP::Class->create('Blorg', meta_name => 'blorg');
  38     ok(!Blorg->can('meta'));
  39     can_ok('Blorg', 'blorg');
  40     isa_ok(Blorg->blorg->find_method_by_name('blorg'),
  41            'Class::MOP::Method::Meta');
  42 }
  43
  44 {
  45     {
  46         package Foo;
  47         use metaclass meta_name => undef;
  48     }
  49
  50     my $meta = Class::MOP::class_of('Foo');
  51     ok(!$meta->has_method('meta'), "no meta method was installed");
  52     $meta->add_method(meta => sub { die 'META' });
  53     is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" );
  54     is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" );
  55     is( exception { $meta->class_precedence_list }, undef, "can do meta-level stuff" );
  56 }
  57
  58 {
  59     my $meta = Class::MOP::Class->create('Bar', meta_name => undef);
  60     ok(!$meta->has_method('meta'), "no meta method was installed");
  61     $meta->add_method(meta => sub { die 'META' });
  62     is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" );
  63     is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" );
  64     is( exception { $meta->class_precedence_list }, undef, "can do meta-level stuff" );
  65 }
  66
  67 done_testing;