use compiled type constraints. this change makes faster :)
[gitmo/Mouse.git] / 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");