t/100-meta-class.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 15;
   5
   6 do {
   7     package Class;
   8     use Mouse;
   9
  10     has pawn => (
  11         is        => 'rw',
  12         predicate => 'has_pawn',
  13     );
  14
  15     no Mouse;
  16 };
  17
  18 my $meta = Class->meta;
  19 isa_ok($meta, 'Mouse::Meta::Class');
  20
  21 is_deeply([$meta->superclasses], ['Mouse::Object'], "correctly inherting from Mouse::Object");
  22
  23 my $meta2 = Class->meta;
  24 is($meta, $meta2, "same metaclass instance");
  25
  26 can_ok($meta, 'name', 'get_attribute_map', 'get_attribute_list');
  27
  28 ok($meta->has_attribute('pawn'));
  29 my $attr = $meta->get_attribute('pawn');
  30 isa_ok($attr, 'Mouse::Meta::Attribute');
  31 is($attr->name, 'pawn', 'got the correct attribute');
  32
  33 my $map = $meta->get_attribute_map;
  34 is_deeply($map, { pawn => $attr }, "attribute map");
  35
  36 my $list = [$meta->get_attribute_list];
  37 is_deeply($list, [ 'pawn' ], "attribute list");
  38
  39 ok(!$meta->has_attribute('nonexistent_attribute'));
  40
  41 eval "
  42     package Class;
  43     use Mouse;
  44     no Mouse;
  45 ";
  46
  47 my $meta3 = Class->meta;
  48 is($meta, $meta3, "same metaclass instance, even if use Mouse is performed again");
  49
  50 is($meta->name, 'Class', "name for the metaclass");
  51
  52 do {
  53     package Child;
  54     use Mouse;
  55     extends 'Class';
  56 };
  57
  58 my $child_meta = Child->meta;
  59 isa_ok($child_meta, 'Mouse::Meta::Class');
  60
  61 isnt($meta, $child_meta, "different metaclass instances for the two classes");
  62
  63 is_deeply([$child_meta->superclasses], ['Class'], "correct superclasses");