Commit | Line | Data |
65748864 |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests=>17; |
5 | use Test::Exception; |
6 | } |
7 | |
8 | { |
9 | package Test::MooseX::Meta::TypeConstraint::Structured::Concept; |
10 | |
11 | use Moose; |
12 | use Moose::Util::TypeConstraints; |
13 | |
14 | sub _normalize_args { |
15 | if(defined $_[0] && ref $_[0] eq 'ARRAY') { |
16 | return @{$_[0]}; |
17 | } else { |
18 | confess 'Arguments not normal'; |
19 | } |
20 | } |
21 | |
22 | sub Pair { |
23 | my ($canonical_key, $value) = _normalize_args(shift); |
24 | return subtype |
25 | as "HashRef[$value]", |
26 | where { |
27 | my ($key, $extra) = keys %$_; |
28 | ($key eq $canonical_key) && !$extra; |
29 | }; |
30 | } |
31 | |
32 | sub Tuple { |
33 | my @args = _normalize_args(shift); |
34 | return subtype |
35 | as 'ArrayRef', |
36 | where { |
37 | my @incoming = @$_; |
38 | foreach my $idx (0..$#args) { |
39 | find_type_constraint($args[$idx])->check($incoming[$idx]) || |
40 | confess 'Trouble validating Tuple'; |
41 | } 1; |
42 | }; |
43 | } |
44 | |
45 | sub Dict { |
46 | my %keys_typeconstraints = _normalize_args(shift); |
47 | return subtype |
48 | as 'HashRef', |
49 | where { |
50 | my %incoming = %$_; |
51 | foreach my $key (keys %keys_typeconstraints) { |
52 | my $type_constraint = $keys_typeconstraints{$key}; |
53 | my $incoming = $incoming{$key} || confess "Missing $key"; |
54 | find_type_constraint($type_constraint)->check($incoming) |
55 | || confess "Trouble validating Dictionary"; |
56 | } 1; |
57 | }; |
58 | } |
59 | |
60 | has 'pair' => (is=>'rw', isa=>Pair[key=>'Str']); |
61 | has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str']); |
62 | has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']); |
63 | } |
64 | |
65 | ## Instantiate a new test object |
66 | |
67 | ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Concept->new |
68 | => 'Instantiated new Record test class.'; |
69 | |
70 | isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Concept' |
71 | => 'Created correct object type.'; |
72 | |
73 | ## Test the Pair type constraint |
74 | |
75 | lives_ok sub { |
76 | $record->pair({key=>'value'}); |
77 | } => 'Set pair attribute without error'; |
78 | |
79 | is $record->pair->{key}, 'value' |
80 | => 'correctly set the pair attribute'; |
81 | |
82 | throws_ok sub { |
83 | $record->pair({not_the_key=>'value'}) ; |
84 | }, qr/Validation failed/ |
85 | => 'Got Expected Error for bad key'; |
86 | |
87 | throws_ok sub { |
88 | $record->pair({key=>[1,2,3]}) ; |
89 | }, qr/Validation failed/ |
90 | => 'Got Expected Error for bad value'; |
91 | |
92 | ## Test the Tuple type constraint |
93 | |
94 | lives_ok sub { |
95 | $record->tuple([1,'hello']); |
96 | } => 'Set tuple attribute without error'; |
97 | |
98 | is $record->tuple->[0], 1 |
99 | => 'correct set the tuple attribute index 0'; |
100 | |
101 | is $record->tuple->[1], 'hello' |
102 | => 'correct set the tuple attribute index 1'; |
103 | |
104 | throws_ok sub { |
105 | $record->tuple('hello') ; |
106 | }, qr/Validation failed/ |
107 | => 'Got Expected Error when setting as a scalar'; |
108 | |
109 | throws_ok sub { |
110 | $record->tuple({key=>[1,2,3]}) ; |
111 | }, qr/Validation failed/ |
112 | => 'Got Expected Error for trying a hashref '; |
113 | |
114 | throws_ok sub { |
115 | $record->tuple(['asdasd',2]) ; |
116 | }, qr/Trouble validating Tuple/ |
117 | => 'Got Expected Error for violating constraints'; |
118 | |
119 | ## Test the Dictionary type constraint |
120 | |
121 | lives_ok sub { |
122 | $record->dict({name=>'frith', age=>23}); |
123 | } => 'Set dict attribute without error'; |
124 | |
125 | is $record->dict->{name}, 'frith' |
126 | => 'correct set the dict attribute name'; |
127 | |
128 | is $record->dict->{age}, 23 |
129 | => 'correct set the dict attribute age'; |
130 | |
131 | throws_ok sub { |
132 | $record->dict('hello') ; |
133 | }, qr/Validation failed/ |
134 | => 'Got Expected Error for bad key in dict'; |
135 | |
136 | throws_ok sub { |
137 | $record->dict({name=>[1,2,3], age=>'sdfsdfsd'}); |
138 | }, qr/Trouble validating Dictionary/ |
139 | => 'Got Expected Error for bad value in dict'; |
140 | |