Commit | Line | Data |
65748864 |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
bc64165b |
4 | use Test::More tests=>12; |
65748864 |
5 | use Test::Exception; |
6 | } |
7 | |
8 | { |
bc64165b |
9 | package Test::MooseX::Meta::TypeConstraint::Structured; |
65748864 |
10 | |
11 | use Moose; |
12 | use Moose::Util::TypeConstraints; |
13 | use MooseX::Meta::TypeConstraint::Structured; |
c3abf064 |
14 | |
15 | subtype 'MyString', |
16 | as 'Str', |
17 | where { $_=~m/abc/}; |
65748864 |
18 | |
19 | sub Tuple { |
bc64165b |
20 | my @args = @{shift @_}; |
65748864 |
21 | return MooseX::Meta::TypeConstraint::Structured->new( |
22 | name => 'Tuple', |
23 | parent => find_type_constraint('ArrayRef'), |
24 | package_defined_in => __PACKAGE__, |
bc64165b |
25 | signature => [map {find_type_constraint($_)} @args], |
26 | ); |
27 | } |
28 | |
29 | sub Dict { |
30 | my %args = @{shift @_}; |
31 | return MooseX::Meta::TypeConstraint::Structured->new( |
32 | name => 'Tuple', |
33 | parent => find_type_constraint('HashRef'), |
34 | package_defined_in => __PACKAGE__, |
35 | signature => {map { $_ => find_type_constraint($args{$_})} keys %args}, |
65748864 |
36 | ); |
37 | } |
c3abf064 |
38 | |
39 | has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']); |
bc64165b |
40 | has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']); |
65748864 |
41 | } |
42 | |
43 | ## Instantiate a new test object |
44 | |
bc64165b |
45 | ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new |
65748864 |
46 | => 'Instantiated new Record test class.'; |
47 | |
bc64165b |
48 | isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured' |
65748864 |
49 | => 'Created correct object type.'; |
50 | |
bc64165b |
51 | ## Test Tuple type constraint |
52 | |
65748864 |
53 | lives_ok sub { |
c3abf064 |
54 | $record->tuple([1,'hello', 'test.abc.test']); |
65748864 |
55 | } => 'Set tuple attribute without error'; |
56 | |
57 | is $record->tuple->[0], 1 |
58 | => 'correct set the tuple attribute index 0'; |
59 | |
60 | is $record->tuple->[1], 'hello' |
61 | => 'correct set the tuple attribute index 1'; |
62 | |
c3abf064 |
63 | is $record->tuple->[2], 'test.abc.test' |
64 | => 'correct set the tuple attribute index 2'; |
65 | |
66 | throws_ok sub { |
67 | $record->tuple([1,'hello', 'test.xxx.test']); |
68 | }, qr/Validation failed for 'MyString'/ |
69 | => 'Properly failed for bad value in custom type constraint'; |
70 | |
65748864 |
71 | throws_ok sub { |
c3abf064 |
72 | $record->tuple(['asdasd',2, 'test.abc.test']); |
65748864 |
73 | }, qr/Validation failed for 'Int'/ |
74 | => 'Got Expected Error for violating constraints'; |
75 | |
bc64165b |
76 | ## Test the Dictionary type constraint |
77 | |
78 | lives_ok sub { |
79 | $record->dict({name=>'frith', age=>23}); |
80 | } => 'Set dict attribute without error'; |
81 | |
82 | is $record->dict->{name}, 'frith' |
83 | => 'correct set the dict attribute name'; |
84 | |
85 | is $record->dict->{age}, 23 |
86 | => 'correct set the dict attribute age'; |
87 | |
88 | throws_ok sub { |
89 | $record->dict({name=>[1,2,3], age=>'sdfsdfsd'}); |
90 | }, qr/Validation failed for 'Str'/ |
91 | => 'Got Expected Error for bad value in dict'; |