t/001_mouse/063-meta-of-metaclasses.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More tests => 10;
   6
   7 {
   8     package OtherClass;
   9     sub method {}
  10
  11     package Class;
  12     use Mouse;
  13
  14     # this attribute definition is intended to load submodules
  15
  16     has foo => (
  17         is => 'rw',
  18         isa => 'OtherClass',
  19         handles => qr/./,
  20     );
  21
  22     __PACKAGE__->meta->make_immutable; # ensure metaclasses loaded
  23
  24     package Role;
  25     use Mouse::Role;
  26
  27     sub bar {}
  28 }
  29
  30 {
  31     my $metaclass = Class->meta;
  32
  33     can_ok($metaclass, 'meta');
  34
  35     can_ok($metaclass->constructor_class, 'meta');
  36     can_ok($metaclass->destructor_class, 'meta');
  37     can_ok($metaclass->attribute_metaclass, 'meta');
  38
  39     can_ok($metaclass->get_method('foo'),   'meta');
  40     can_ok($metaclass->get_attribute('foo'), 'meta');
  41     can_ok($metaclass->get_attribute('foo')->accessor_metaclass, 'meta');
  42     can_ok($metaclass->get_attribute('foo')->delegation_metaclass, 'meta');
  43 }
  44
  45 {
  46     my $metarole = Class->meta;
  47
  48     can_ok($metarole, 'meta');
  49
  50     can_ok($metarole->get_method('foo'),   'meta');
  51 }