t/090_meta_method.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   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 Foo;
  30         use metaclass no_meta => 1;
  31     }
  32
  33     my $meta = Class::MOP::class_of('Foo');
  34     ok(!$meta->has_method('meta'), "no meta method was installed");
  35     $meta->add_method(meta => sub { die 'META' });
  36     lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
  37     lives_ok { $meta->make_immutable } "can do meta-level stuff";
  38     lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
  39 }
  40
  41 {
  42     my $meta = Class::MOP::Class->create('Bar', no_meta => 1);
  43     ok(!$meta->has_method('meta'), "no meta method was installed");
  44     $meta->add_method(meta => sub { die 'META' });
  45     lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
  46     lives_ok { $meta->make_immutable } "can do meta-level stuff";
  47     lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
  48 }
  49
  50 done_testing;