t/010_self_introspection.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 56;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     use_ok('Class::MOP::Class');
  12 }
  13
  14 my $meta = Class::MOP::Class->meta();
  15 isa_ok($meta, 'Class::MOP::Class');
  16
  17 foreach my $method_name (qw(
  18     meta
  19
  20     initialize create
  21
  22     name version
  23
  24     superclasses class_precedence_list
  25
  26     has_method get_method add_method remove_method
  27     get_method_list compute_all_applicable_methods find_all_methods_by_name
  28
  29     has_attribute get_attribute add_attribute remove_attribute
  30     get_attribute_list compute_all_applicable_attributes
  31     )) {
  32     ok($meta->has_method($method_name), '... Class::MOP::Class->has_method(' . $method_name . ')');
  33     {
  34         no strict 'refs';
  35         is($meta->get_method($method_name),
  36            \&{'Class::MOP::Class::' . $method_name},
  37            '... Class::MOP::Class->get_method(' . $method_name . ') == &Class::MOP::Class::' . $method_name);
  38     }
  39 }
  40
  41 foreach my $non_method_name (qw(
  42     confess
  43     blessed reftype
  44     subname
  45     svref_2object
  46     )) {
  47     ok(!$meta->has_method($non_method_name), '... NOT Class::MOP::Class->has_method(' . $non_method_name . ')');
  48 }
  49
  50 foreach my $attribute_name (
  51     '$:pkg', '%:attrs'
  52     ) {
  53     ok($meta->has_attribute($attribute_name), '... Class::MOP::Class->has_attribute(' . $attribute_name . ')');
  54     isa_ok($meta->get_attribute($attribute_name), 'Class::MOP::Attribute');
  55 }
  56
  57 is($meta->name, 'Class::MOP::Class', '... Class::MOP::Class->name');
  58 is($meta->version, $Class::MOP::Class::VERSION, '... Class::MOP::Class->version');
  59
  60 is_deeply(
  61     [ $meta->superclasses ],
  62     [],
  63     '... Class::MOP::Class->superclasses == []');
  64
  65 is_deeply(
  66     [ $meta->class_precedence_list ],
  67     [ 'Class::MOP::Class' ],
  68     '... Class::MOP::Class->class_precedence_list == []');
  69