Commit | Line | Data |
b0ea39ef |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 10; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | } |
12 | |
13 | { |
14 | package Foo::Meta::Attribute; |
15 | use strict; |
16 | use warnings; |
17 | |
18 | use base 'Moose::Meta::Attribute'; |
19 | |
20 | sub new { |
21 | my $class = shift; |
22 | $class->SUPER::new(@_, (is => 'rw', isa => 'Foo')); |
23 | } |
24 | |
25 | package Foo; |
26 | use strict; |
27 | use warnings; |
28 | use Moose; |
29 | |
30 | has 'foo' => (metaclass => 'Foo::Meta::Attribute'); |
31 | } |
32 | |
33 | my $foo = Foo->new; |
34 | isa_ok($foo, 'Foo'); |
35 | |
36 | my $foo_attr = Foo->meta->get_attribute('foo'); |
37 | isa_ok($foo_attr, 'Foo::Meta::Attribute'); |
38 | isa_ok($foo_attr, 'Moose::Meta::Attribute'); |
39 | |
40 | is($foo_attr->name, 'foo', '... got the right name for our meta-attribute'); |
41 | ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us'); |
42 | |
43 | ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us'); |
44 | |
45 | my $foo_attr_type_constraint = $foo_attr->type_constraint; |
46 | isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint'); |
47 | |
48 | is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); |
49 | is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); |