Fix Makefile.PL to use Mouse::Spec
[gitmo/Mouse.git] / t / 100-meta-class.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 22;
5 use Test::Exception;
6 {
7     package Class;
8     use Mouse;
9     use Scalar::Util qw(blessed weaken); # import external functions
10
11     has pawn => (
12         is        => 'rw',
13         predicate => 'has_pawn',
14     );
15
16     use constant MY_CONST => 42;
17
18     sub stub;
19     sub stub_with_attr :method;
20
21     no Mouse;
22 }
23 {
24     package Child;
25     use Mouse;
26     use Carp qw(carp croak); # import extenral functions
27
28     extends 'Class';
29
30     has bishop => (
31         is => 'rw',
32     );
33
34     sub child_method{ }
35 }
36
37 my $meta = Class->meta;
38 isa_ok($meta, 'Mouse::Meta::Class');
39
40 is_deeply([$meta->superclasses], ['Mouse::Object'], "correctly inherting from Mouse::Object");
41
42 my $meta2 = Class->meta;
43 is($meta, $meta2, "same metaclass instance");
44
45 can_ok($meta, qw(
46     name meta
47     has_attribute get_attribute get_attribute_list get_all_attributes
48     has_method    get_method    get_method_list    get_all_methods
49 ));
50
51 ok($meta->has_attribute('pawn'));
52 my $attr = $meta->get_attribute('pawn');
53 isa_ok($attr, 'Mouse::Meta::Attribute');
54 is($attr->name, 'pawn', 'got the correct attribute');
55
56 my $list = [$meta->get_attribute_list];
57 is_deeply($list, [ 'pawn' ], "attribute list");
58
59 ok(!$meta->has_attribute('nonexistent_attribute'));
60
61 ok($meta->has_method('pawn'));
62 lives_and{
63     ok($meta->get_method('pawn'));
64     is($meta->get_method('pawn')->name, 'pawn');
65     is($meta->get_method('pawn')->package_name, 'Class');
66 };
67
68 is( join(' ', sort $meta->get_method_list),
69     join(' ', sort qw(meta pawn has_pawn MY_CONST stub stub_with_attr))
70 );
71
72 eval q{
73     package Class;
74     use Mouse;
75     no Mouse;
76 };
77
78 my $meta3 = Class->meta;
79 is($meta, $meta3, "same metaclass instance, even if use Mouse is performed again");
80
81 is($meta->name, 'Class', "name for the metaclass");
82
83
84 my $child_meta = Child->meta;
85 isa_ok($child_meta, 'Mouse::Meta::Class');
86
87 isnt($meta, $child_meta, "different metaclass instances for the two classes");
88
89 is_deeply([$child_meta->superclasses], ['Class'], "correct superclasses");
90
91
92 ok($child_meta->has_attribute('bishop'));
93 ok($child_meta->has_method('child_method'));
94
95
96 is( join(' ', sort $child_meta->get_method_list),
97     join(' ', sort qw(meta bishop child_method))
98 );