| Commit | Line | Data |
|---|
| 67199842 |
1 | #!/usr/bin/perl |
| 2 | |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | |
| 98bbe659 |
6 | use Test::More tests => 25; |
| 67199842 |
7 | use Test::Exception; |
| 8 | |
| 9 | use Mouse::Meta::Role; |
| 10 | |
| 11 | { |
| 12 | package FooRole; |
| 13 | |
| 14 | our $VERSION = '0.01'; |
| 15 | |
| 16 | sub foo { 'FooRole::foo' } |
| 17 | } |
| 18 | |
| 19 | my $foo_role = Mouse::Meta::Role->initialize('FooRole'); |
| 20 | isa_ok($foo_role, 'Mouse::Meta::Role'); |
| 21 | #isa_ok($foo_role, 'Class::MOP::Module'); ## Mouse: doesn't use Class::MOP |
| 22 | |
| 23 | is($foo_role->name, 'FooRole', '... got the right name of FooRole'); |
| 24 | #is($foo_role->version, '0.01', '... got the right version of FooRole'); ## Mouse: ->version is cfrom Class::MOP |
| 25 | |
| 26 | # methods ... |
| 27 | |
| 28 | ok($foo_role->has_method('foo'), '... FooRole has the foo method'); |
| 29 | is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method'); |
| 30 | |
| 31 | isa_ok($foo_role->get_method('foo'), 'Mouse::Meta::Role::Method'); |
| 32 | |
| 33 | is_deeply( |
| 34 | [ $foo_role->get_method_list() ], |
| 35 | [ 'foo' ], |
| 36 | '... got the right method list'); |
| 37 | |
| 38 | # attributes ... |
| 39 | |
| 40 | is_deeply( |
| 41 | [ $foo_role->get_attribute_list() ], |
| 42 | [], |
| 43 | '... got the right attribute list'); |
| 44 | |
| 45 | ok(!$foo_role->has_attribute('bar'), '... FooRole does not have the bar attribute'); |
| 46 | |
| 47 | lives_ok { |
| 48 | $foo_role->add_attribute('bar' => (is => 'rw', isa => 'Foo')); |
| 49 | } '... added the bar attribute okay'; |
| 50 | |
| 51 | is_deeply( |
| 52 | [ $foo_role->get_attribute_list() ], |
| 53 | [ 'bar' ], |
| 54 | '... got the right attribute list'); |
| 55 | |
| 56 | ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute'); |
| 57 | |
| 58 | is_deeply( |
| 59 | $foo_role->get_attribute('bar'), |
| 60 | { is => 'rw', isa => 'Foo' }, |
| 61 | '... got the correct description of the bar attribute'); |
| 62 | |
| 63 | lives_ok { |
| 64 | $foo_role->add_attribute('baz' => (is => 'ro')); |
| 65 | } '... added the baz attribute okay'; |
| 66 | |
| 67 | is_deeply( |
| 68 | [ sort $foo_role->get_attribute_list() ], |
| 69 | [ 'bar', 'baz' ], |
| 70 | '... got the right attribute list'); |
| 71 | |
| 72 | ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute'); |
| 73 | |
| 74 | is_deeply( |
| 75 | $foo_role->get_attribute('baz'), |
| 76 | { is => 'ro' }, |
| 77 | '... got the correct description of the baz attribute'); |
| 78 | |
| 79 | lives_ok { |
| 80 | $foo_role->remove_attribute('bar'); |
| 81 | } '... removed the bar attribute okay'; |
| 82 | |
| 83 | is_deeply( |
| 84 | [ $foo_role->get_attribute_list() ], |
| 85 | [ 'baz' ], |
| 86 | '... got the right attribute list'); |
| 87 | |
| 88 | ok(!$foo_role->has_attribute('bar'), '... FooRole does not have the bar attribute'); |
| 89 | ok($foo_role->has_attribute('baz'), '... FooRole does still have the baz attribute'); |
| 90 | |
| 91 | # method modifiers |
| 92 | |
| 93 | ok(!$foo_role->has_before_method_modifiers('boo'), '... no boo:before modifier'); |
| 94 | |
| 95 | my $method = sub { "FooRole::boo:before" }; |
| 96 | lives_ok { |
| 97 | $foo_role->add_before_method_modifier('boo' => $method); |
| 98 | } '... added a method modifier okay'; |
| 99 | |
| 100 | ok($foo_role->has_before_method_modifiers('boo'), '... now we have a boo:before modifier'); |
| 101 | is(($foo_role->get_before_method_modifiers('boo'))[0], $method, '... got the right method back'); |
| 102 | |
| 103 | is_deeply( |
| 104 | [ $foo_role->get_method_modifier_list('before') ], |
| 105 | [ 'boo' ], |
| 106 | '... got the right list of before method modifiers'); |
projects / gitmo/Mouse.git / blame